? .DS_Store
? gtkairo.tgz
? patch-case1
? patch-case2.bz2
? patch-color-case
? Backends/Null/frame-manager.fasl
? Backends/Null/graft.fasl
? Backends/Null/medium.fasl
? Backends/Null/package.fasl
? Backends/Null/port.fasl
? Doc/docstrings
? Doc/Guided-Tour/guided-tour.aux
? Doc/Guided-Tour/guided-tour.log
? Doc/Guided-Tour/guided-tour.pdf
? Drei/abbrev.fasl
? Drei/base.fasl
? Drei/basic-commands.fasl
? Drei/buffer.fasl
? Drei/core-commands.fasl
? Drei/core.fasl
? Drei/delegating-buffer.fasl
? Drei/drei-clim.fasl
? Drei/drei-redisplay.fasl
? Drei/drei.fasl
? Drei/editing.fasl
? Drei/fundamental-syntax.fasl
? Drei/input-editor.fasl
? Drei/kill-ring.fasl
? Drei/lisp-syntax-commands.fasl
? Drei/lisp-syntax-swank.fasl
? Drei/lisp-syntax-swine.fasl
? Drei/lisp-syntax.fasl
? Drei/misc-commands.fasl
? Drei/motion.fasl
? Drei/packages.fasl
? Drei/rectangle.fasl
? Drei/search-commands.fasl
? Drei/syntax.fasl
? Drei/undo.fasl
? Drei/unicode-commands.fasl
? Drei/Persistent/binseq-package.fasl
? Drei/Persistent/binseq.fasl
? Drei/Persistent/binseq2.fasl
? Drei/Persistent/obinseq.fasl
? Drei/Persistent/persistent-buffer.fasl
? Drei/Persistent/persistent-undo.fasl
? Drei/cl-automaton/automaton-package.fasl
? Drei/cl-automaton/automaton.fasl
? Drei/cl-automaton/eqv-hash.fasl
? Drei/cl-automaton/regexp.fasl
? Drei/cl-automaton/state-and-transition.fasl
? ESA/colors.fasl
? ESA/esa-buffer.fasl
? ESA/esa-command-parser.fasl
? ESA/esa-io.fasl
? ESA/esa.fasl
? ESA/packages.fasl
? ESA/utils.fasl
? Extensions/rgb-image.fasl
Index: recording.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/recording.lisp,v
retrieving revision 1.135
diff -u -r1.135 recording.lisp
--- recording.lisp	7 Sep 2007 16:49:11 -0000	1.135
+++ recording.lisp	23 Sep 2007 00:03:19 -0000
@@ -970,6 +970,9 @@
 (defclass standard-tree-output-record (compound-output-record)
   ((children :initform (%make-tree-output-record-tree)
              :accessor %tree-record-children)
+   (ungeometric-children :initform (make-hash-table :test #'eql)
+                         :accessor %tree-record-ungeometric-children
+                         :documentation "Container for children that have null bounding rectangles. (I.e. output-historic, not geometric things.)")
    (children-hash :initform (make-hash-table :test #'eql) :reader %tree-record-children-cache)
    (child-count :initform 0)
    (last-insertion-nr :initform 0 :accessor last-insertion-nr)))
@@ -983,29 +986,44 @@
 (defun %remove-entry-from-children-cache (record entry)
   (remhash entry (%tree-record-children-cache record)))
 
+(defmethod output-record-count ((record standard-tree-output-record))
+  (slot-value record 'child-count))
+
 (defmethod output-record-children ((record standard-tree-output-record))
-  (map 'list
-       #'tree-output-record-entry-record
-       (spatial-trees:search (%record-to-spatial-tree-rectangle record)
-                             (%tree-record-children record))))
+  (nconc
+   (loop for child being the hash-key in (%tree-record-ungeometric-children record)
+         collect child)
+   (map 'list
+        #'tree-output-record-entry-record
+        (spatial-trees:search (%record-to-spatial-tree-rectangle record)
+                              (%tree-record-children record)))))
 
 (defmethod add-output-record (child (record standard-tree-output-record))
-  (let ((entry (make-tree-output-record-entry child (incf (last-insertion-nr record)))))
-    (spatial-trees:insert entry (%tree-record-children record))
-    (setf (output-record-parent child) record)
-    (setf (%entry-in-children-cache record child) entry))
+  (if (null-bounding-rectangle-p record)
+      (setf (gethash child (%tree-record-ungeometric-children record))
+            (make-tree-output-record-entry child (incf (last-insertion-nr record))))
+      (let ((entry (make-tree-output-record-entry child (incf (last-insertion-nr record)))))
+        (spatial-trees:insert entry (%tree-record-children record))
+        (setf (output-record-parent child) record)
+        (setf (%entry-in-children-cache record child) entry)))
   (incf (slot-value record 'child-count))
   (values))
 
 (defmethod delete-output-record (child (record standard-tree-output-record) &optional (errorp t))
-  (let ((entry (find child (spatial-trees:search (%entry-in-children-cache record child)
-                                                 (%tree-record-children record))
-                     :key #'tree-output-record-entry-record)))
-    (decf (slot-value record 'child-count))
+  (let (entry)
+    (cond ((null-bounding-rectangle-p child)
+           (setf entry (gethash child (%tree-record-ungeometric-children record)))
+           (remhash child (%tree-record-ungeometric-children record)))
+          (t
+           (setf entry
+                 (find child (spatial-trees:search (%entry-in-children-cache record child)
+                                                   (%tree-record-children record))
+                       :key #'tree-output-record-entry-record))
+           (spatial-trees:delete entry (%tree-record-children record))))
     (cond
       ((not (null entry))
-       (spatial-trees:delete entry (%tree-record-children record))
        (%remove-entry-from-children-cache record child)
+       (decf (slot-value record 'child-count))
        (setf (output-record-parent child) nil))
       (errorp (error "~S is not a child of ~S" child record)))))
 
@@ -1015,14 +1033,17 @@
              (%remove-entry-from-children-cache record child))
        (output-record-children record))
   (setf (slot-value record 'child-count) 0)
-  (setf (%tree-record-children record) (%make-tree-output-record-tree)))
-
-(defmethod output-record-count ((record standard-tree-output-record))
-  (slot-value record 'child-count))
+  (setf (%tree-record-children record) (%make-tree-output-record-tree))
+  (clrhash (%tree-record-children record)))
 
-(defun map-over-tree-output-records (function record rectangle sort-order function-args)
-  (dolist (child (sort (spatial-trees:search rectangle
-                                             (%tree-record-children record))
+(defun map-over-tree-output-records (function record rectangle everywhere-p sort-order function-args)
+  (dolist (child (sort (concatenate 'list
+                                    (when everywhere-p
+                                      (loop for entry being the hash-values
+                                            of (%tree-record-ungeometric-children record)
+                                            collect entry))
+                                    (spatial-trees:search rectangle
+                                                          (%tree-record-children record)))
                        (ecase sort-order
                          (:most-recent-first #'>)
                          (:most-recent-last #'<))
@@ -1030,12 +1051,13 @@
     (apply function (tree-output-record-entry-record child) function-args)))
 
 (defmethod map-over-output-records-1 (function (record standard-tree-output-record) function-args)
-  (map-over-tree-output-records function record (%record-to-spatial-tree-rectangle record) :most-recent-last
+  (map-over-tree-output-records function record (%record-to-spatial-tree-rectangle record) t :most-recent-last
                                 function-args))
 
 (defmethod map-over-output-records-containing-position (function (record standard-tree-output-record) x y &optional x-offset y-offset &rest function-args)
   (declare (ignore x-offset y-offset))
-  (map-over-tree-output-records function record (rectangles:make-rectangle :lows `(,x ,y) :highs `(,x ,y)) :most-recent-first
+  (map-over-tree-output-records function record (rectangles:make-rectangle :lows `(,x ,y) :highs `(,x ,y))
+                                nil :most-recent-first
                                 function-args)) 
 
 (defmethod map-over-output-records-overlapping-region (function (record standard-tree-output-record) region &optional x-offset y-offset &rest function-args)
@@ -1048,11 +1070,12 @@
                   (if (region-intersects-region-p (multiple-value-call 'make-rectangle* (bounding-rectangle* child))
                                                      region)
                        (apply function child function-args)))
-                record (%record-to-spatial-tree-rectangle (bounding-rectangle region)) :most-recent-last
-                nil))))
+                record (%record-to-spatial-tree-rectangle (bounding-rectangle region))
+                (region-equal region +everywhere+) :most-recent-last nil))))
 
 (defmethod recompute-extent-for-changed-child :around ((record standard-tree-output-record) child old-min-x old-min-y old-max-x old-max-y)
-  (when (eql record (output-record-parent child))
+  (when (and (not (null-bounding-rectangle-p child))
+             (eql record (output-record-parent child)))
     (let ((entry (%entry-in-children-cache record child)))
      (spatial-trees:delete entry (%tree-record-children record))
      (setf (tree-output-record-entry-cached-rectangle entry) nil)
