[mcclim-cvs] CVS mcclim

[crhodes]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp:/tmp/cvs-serv14210

Modified Files:
	incremental-redisplay.lisp 
Log Message:
Some more reduction of .gold.ac.uk mcclim diff
... minor edits to incremental-redisplay.lisp -- the major functional 
change has been absorbed into application code, using a specialization 
of INCREMENTAL-REDISPLAY for an application-defined subclass of 
STANDARD-UPDATING-OUTPUT-RECORD.


--- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp	2005/08/18 03:17:21	1.52
+++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp	2006/02/06 14:33:53	1.53
@@ -305,7 +305,7 @@
     (let ((res +nowhere+))
       (loop for (r) in erase-overlapping do (setf res (region-union res r)))
       (loop for (r) in move-overlapping do (setf res (region-union res r)))
-      (replay history stream res)) ))
+      (replay history stream res))))
 
 (defclass updating-stream-state (complete-medium-state)
   ((cursor-x :accessor cursor-x :initarg :cursor-x :initform 0)
@@ -521,10 +521,11 @@
   (with-output-recording-options (stream :record t :draw nil)
     (map-over-updating-output
      #'(lambda (r)
-	 (setf (old-children r) (sub-record r))
-	 (setf (output-record-dirty r) :updating)
-	 (setf (rectangle-edges* (old-bounds r))
-	       (rectangle-edges* (sub-record r))))
+         (let ((sub-record (sub-record r)))
+           (setf (old-children r) sub-record)
+           (setf (output-record-dirty r) :updating)
+           (setf (rectangle-edges* (old-bounds r))
+                 (rectangle-edges* sub-record))))
      record
      nil)
     (finish-output stream)
@@ -548,8 +549,9 @@
     ((record standard-updating-output-record) stream displayer)
   (multiple-value-bind (x y)
       (output-record-position record)
-    (when (sub-record record)
-      (delete-output-record (sub-record record) record))
+    (let ((sub-record (sub-record record)))
+      (when sub-record
+        (delete-output-record sub-record record)))
     ;; Don't add this record repeatedly to a parent updating-output-record.
     (unless (eq (output-record-parent record)
 		(stream-current-output-record stream))
@@ -721,7 +723,7 @@
 
 (declaim (inline hash-coords))
 (defun hash-coords (x1 y1 x2 y2)
-  (declare (type real x1 y1 x2 y2))	;XXX Someday this should be float
+  (declare (type coordinate x1 y1 x2 y2))
   (let ((hash-val 0))
       (declare (type fixnum hash-val))
       (labels ((rot4 (val)
@@ -916,8 +918,6 @@
 	    (t
 	     ;; It doesn't need to be updated, but it does go into the
 	     ;; parent's sequence of records
-	     (when *trace-updating-output*
-	       (format *trace-output* "clean ~S~%" record))
              ;;
              (multiple-value-bind (cx cy) (stream-cursor-position stream)
                (multiple-value-bind (sx sy) (output-record-start-cursor-position record)
@@ -925,8 +925,15 @@
                        (dy (- cy sy)))
                    (unless (zerop dy)
                      (move-output-record record dx dy) )
-                   (let ((tag (cond ((= dx dy 0) :clean)
-                                    (t :moved))))
+                   (let ((tag (cond
+				((= dx dy 0)
+				 (when *trace-updating-output*
+				   (format *trace-output* "clean ~S~%" record))
+				 :clean)
+				(t
+				 (when *trace-updating-output*
+				   (format *trace-output* "moved ~S~%" record))
+				 :moved))))
                      (setf (output-record-dirty record) tag)
                      (setf (output-record-parent record) nil)
                      (map-over-updating-output #'(lambda (r)