[mcclim-cvs] CVS mcclim

[afuchs]

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

Modified Files:
	incremental-redisplay.lisp 
Log Message:
argh. revert the last constant-factors fold.

gather-was and gather-is are fundamentally different. file under
lessons learned.


--- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp	2006/04/20 22:43:47	1.56
+++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp	2006/04/20 22:53:15	1.57
@@ -778,24 +778,38 @@
                         (if (some #'(lambda (x) (output-record-equal record x)) q)
                             (push record stay)
                             (push record come)))))))
-      ;; Collect what was there and what's still there
-      (labels ((gather-was-and-is (record)
+      ;; Collect what was there
+      (labels ((gather-was (record)
                  (cond ((displayed-output-record-p record)
                         (collect-1-was record))
                        ((updating-output-record-p record)
                         (cond ((eq :clean (output-record-dirty record))
-                               (collect-1-was record)
+                               (collect-1-was record))
+                              ((eq :moved (output-record-dirty record))
+                               (collect-1-was (slot-value record 'old-bounds)))
+                              (t
+                               (map-over-output-records-overlapping-region #'gather-was
+                                                                           (old-children record)
+                                                                           everywhere))))
+                       (t
+                        (map-over-output-records-overlapping-region #'gather-was record everywhere)))))
+        (gather-was record))
+      ;; Collect what still is there
+      (labels ((gather-is (record)
+                 (cond ((displayed-output-record-p record)
+                        (collect-1-is record))
+                       ((updating-output-record-p record)
+                        (cond ((eq :clean (output-record-dirty record))
                                (collect-1-is record))
                               ((eq :moved (output-record-dirty record))
-                               (collect-1-was (slot-value record 'old-bounds))
                                (collect-1-is record))
                               (t
-                               (map-over-output-records-overlapping-region #'gather-was-and-is
-                                                                           (old-children record)
+                               (map-over-output-records-overlapping-region #'gather-is
+                                                                           (sub-record record)
                                                                            everywhere))))
                        (t
-                        (map-over-output-records-overlapping-region #'gather-was-and-is record everywhere)))))
-        (gather-was-and-is record)))
+                        (map-over-output-records-overlapping-region #'gather-is record everywhere) ))))
+        (gather-is record)))
     ;;
     (let (gone)
       ;; gone = was \ is