[mcclim-cvs] CVS mcclim/Goatee - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

1 Mar 2006

Update of /project/mcclim/cvsroot/mcclim/Goatee
In directory clnet:/tmp/cvs-serv10392
Modified Files:
    clim-area.lisp 
Log Message:
Add a bounding-rectangle* method for screen-line that takes a visible
cursor at eol into account.

--- /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp	2005/02/22 14:00:18	1.31
+++ /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp	2006/03/01 21:51:54	1.32
@@ -196,8 +196,8 @@
    		    &key (start 0)
    		    (end (length (current-contents line))))
   (text-size (area-stream area) (current-contents line)
-	     :start start
-	     :end end))
+                               :start start
+                               :end end))
(defmethod initialize-instance :after
     ((obj screen-line) &key (current-contents nil current-contents-p))
@@ -214,6 +214,18 @@
        (values x1 y1 x2 (+ y1 (ascent obj) (descent obj))))
       (setf (baseline obj) (+ y1 (ascent obj))))))
+(defmethod bounding-rectangle* ((record screen-line))
+  (let ((cursor (cursor record)))
+    (multiple-value-bind (x1 y1 x2 y2) (call-next-method)
+      (values x1 y1
+              (if cursor
+                  (with-slots (climi::x climi::width) cursor
+                     (max x2 (+ climi::x climi::width)))
+                  x2)
+              (if cursor
+                  (max y2 (+ y1 (climi::cursor-height cursor)))
+                  y2)))))
+
 (defmethod climi::map-over-output-records-1 (function (record screen-line)
    			      function-args)
   (declare (ignore function function-args))

    