[mcclim-cvs] CVS mcclim/Goatee
afuchs
afuchs at common-lisp.net
Wed Mar 1 21:51:54 UTC 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))
More information about the Mcclim-cvs
mailing list