[mcclim-cvs] CVS mcclim/Backends/CLX

[ahefner]

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX
In directory clnet:/tmp/cvs-serv6318

Modified Files:
	medium.lisp 
Log Message:
Fix +transparent-ink+ on the CLX backend in a questionable manner.


--- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp	2007/07/19 06:35:42	1.81
+++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp	2007/07/19 06:55:39	1.82
@@ -173,6 +173,11 @@
 		(setf (xlib:gcontext-clip-mask gc :unsorted) rect-seq)))))
       gc)))
 
+(defmethod medium-gcontext ((medium clx-medium) (ink (eql +transparent-ink+)))
+  (let ((drawable (port-lookup-mirror (port medium) (medium-sheet medium))))
+    (with-slots (gc) medium
+      (or gc (setf gc (xlib:create-gcontext :drawable drawable))))))
+
 (defmethod medium-gcontext ((medium clx-medium) (ink (eql +foreground-ink+)))
   (medium-gcontext medium (medium-foreground medium)))
 
@@ -589,8 +594,9 @@
 	     (ink        (medium-ink ,medium))
 	     (gc         (medium-gcontext ,medium ink)))
 	line-style ink
-	(unwind-protect
-	     (progn , at body)
+	(unwind-protect             
+	     (unless (eql ink +transparent-ink+)
+               (progn , at body))
 	  #+ignore(xlib:free-gcontext gc))))))