[mcclim-cvs] CVS mcclim

[ahefner]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv7304

Modified Files:
	recording.lisp presentation-defs.lisp 
Log Message:
Introduce a new function, highlight-output-record-tree, so that records
can control how highlighting recurses into their children.

Revise definition of null output records to include any record whose
upper-left and lower-right coordinates are equal. This is necessary when
an empty record is transformed (such as by with-room-for-graphics).



--- /project/mcclim/cvsroot/mcclim/recording.lisp	2006/11/22 06:26:48	1.129
+++ /project/mcclim/cvsroot/mcclim/recording.lisp	2007/02/05 03:06:14	1.130
@@ -504,13 +504,26 @@
     (multiple-value-bind (x1 y1 x2 y2)
         (output-record-hit-detection-rectangle* record)
       (ecase state
-        (:highlight	 
+        (:highlight
          (draw-rectangle* (sheet-medium stream) x1 y1 (1- x2) (1- y2)
                           :filled nil :ink +foreground-ink+)) ; XXX +FLIPPING-INK+? 
         (:unhighlight
 	 ;; FIXME: repaint the hit detection rectangle. It could be bigger than
-	 ;;; the bounding rectangle.
-	 (repaint-sheet stream record))))))
+	 ;; the bounding rectangle.         
+	 (repaint-sheet stream record)
+         
+         ;; Using queue-repaint should be faster in apps (such as clouseau) that
+         ;; highlight/unhighlight many bounding rectangles at once. The event 
+         ;; code should merge these into a single larger repaint. Unfortunately,
+         ;; since an enqueued repaint does not occur immediately, and highlight
+         ;; rectangles are not recorded, newer highlighting gets wiped out
+         ;; shortly after being drawn. So, we aren't ready for this yet.
+         #+NIL
+	 (queue-repaint stream (make-instance 'window-repaint-event
+					      :sheet stream
+					      :region (transform-region
+						       (sheet-native-transformation stream)
+						       record))))))))
 
 ;;; XXX Should this only be defined on recording streams?
 (defmethod highlight-output-record ((record output-record) stream state)
@@ -676,8 +689,8 @@
 ;;; not affect bounding rectangles.  -- Hefner
 (defun null-bounding-rectangle-p (bbox)
   (with-bounding-rectangle* (x1 y1 x2 y2) bbox
-     (and (zerop x1) (zerop y1)
-          (zerop x2) (zerop y2))))
+     (and (= x1 x2)
+          (= y1 y2))))
 
 ;;; 16.2.3. Output Record Change Notification Protocol
 (defmethod recompute-extent-for-new-child
@@ -770,7 +783,7 @@
       ;; If record is currently empty, use the child's bbox directly. Else..
       ;; Does the new rectangle of the child contain the original rectangle?
       ;; If so, we can use min/max to grow record's current rectangle.
-      ;; If not, the child has shrunk, and we need to fully recompute.                              
+      ;; If not, the child has shrunk, and we need to fully recompute.
       (multiple-value-bind (nx1 ny1 nx2 ny2) 
           (cond
             ;; The child has been deleted; who knows what the
--- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp	2007/01/14 19:59:07	1.69
+++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp	2007/02/05 03:06:14	1.70
@@ -1206,21 +1206,28 @@
 					   stream
 					   state)))
 
+(defgeneric highlight-output-record-tree (record stream state))
+
+(defmethod highlight-output-record-tree (record stream state)
+  (declare (ignore record stream state))
+  (values))
+
+(defmethod highlight-output-record-tree ((record compound-output-record) stream state)
+  (map-over-output-records
+   (lambda (record)
+     (highlight-output-record-tree record stream state))
+   record))
+
+(defmethod highlight-output-record-tree ((record displayed-output-record) stream state)
+  (highlight-output-record record stream state))
+
 (define-default-presentation-method highlight-presentation
     (type record stream state)
   (declare (ignore type))
   (if (or (eq (presentation-single-box record) t)
 	  (eq (presentation-single-box record) :highlighting))
-      (highlight-output-record-rectangle record stream state)
-      (labels ((highlighter (record)
-		 (typecase record
-		   (displayed-output-record
-		    (highlight-output-record record stream state))
-		   (compound-output-record
-		    (map-over-output-records #'highlighter record))
-		   (t nil))))
-	(highlighter record))))
-
+      (highlight-output-record record stream state)
+      (highlight-output-record-tree record stream state)))
 
 (define-default-presentation-method present
     (object type stream (view textual-view) &key acceptably for-context-type)