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

Modified Files: medium.lisp Log Message: Fix clipping bug. The device region is the final determiner of our clipping rectangle. This is computed from both the medium clipping region and the sheet (native) region. When the device region changes, update the clipping region the next time we sync the gcontext, so that it does not continue to clip to the size of the old window.

--- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/21 01:26:43 1.86 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/25 07:36:39 1.87 @@ -37,7 +37,7 @@ (defclass clx-medium (basic-medium) ((gc :initform nil) (picture :initform nil) - (clipping-region-dirty :initform t) + (last-medium-device-region :initform nil) (clipping-region-tmp :initform (vector 0 0 0 0) :documentation "This object is reused to avoid consing in the most common case when configuring the clipping region.") @@ -134,12 +134,6 @@ ;; to clx :] we stick with :unsorted until that can be sorted out (setf (xlib:gcontext-clip-mask gc :unsorted) rect-seq)))))))

-(defmethod (setf medium-clipping-region) :after (region (medium clx-medium)) - (declare (ignore region)) - (with-slots (#|gc|# clipping-region-dirty) medium - (setf clipping-region-dirty t) - #+NIL (when gc (%set-gc-clipping-region medium gc)))) -  (defgeneric medium-gcontext (medium ink))

@@ -157,7 +151,7 @@ (let* ((port (port medium)) (mirror (port-lookup-mirror port (medium-sheet medium))) (line-style (medium-line-style medium))) - (with-slots (gc clipping-region-dirty) medium + (with-slots (gc last-medium-device-region) medium (unless gc (setq gc (xlib:create-gcontext :drawable mirror)) ;; this is kind of false, since the :unit should be taken @@ -177,9 +171,9 @@ (let ((fn (text-style-to-X-font port (medium-text-style medium)))) (when (typep fn 'xlib:font) (setf (xlib:gcontext-font gc) fn))) - (when clipping-region-dirty - (%set-gc-clipping-region medium gc) - (setf clipping-region-dirty nil)) + (unless (eq last-medium-device-region (medium-device-region medium)) + (setf last-medium-device-region (medium-device-region medium)) + (%set-gc-clipping-region medium gc)) gc)))

(defmethod medium-gcontext ((medium clx-medium) (ink (eql +transparent-ink+)))