[mcclim-cvs] CVS mcclim/Drei

[thenriksen]

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

Modified Files:
	drei-clim.lisp drei-redisplay.lisp 
Log Message:
Implement "cursors are children of their Drei instance (if applicable)"-policy.


--- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp	2008/02/01 17:10:53	1.40
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp	2008/02/02 19:03:26	1.41
@@ -56,11 +56,12 @@
 ;;; of what CLIM already provides. That seemed a bit (=a lot) hairy,
 ;;; though.
 
-;;; Cursors are output records. When a cursor is created, it adds
-;;; itself to its output stream. The owner of the cursor (a Drei
-;;; instance) is responsible for removing the cursor once it is done
-;;; with it. Cursors can be active/inactive and enabled/disabled and
-;;; have the same activity-status as their associated view.
+;;; Cursors are output records. After a cursor is created, The owning
+;;; Drei instance instnace should add it to the output stream. The
+;;; owner of the cursor (a Drei instance) is responsible for removing
+;;; the cursor once it is done with it. Cursors can be active/inactive
+;;; and enabled/disabled and have the same activity-status as their
+;;; associated view.
 (defclass drei-cursor (standard-sequence-output-record)
   ((%view :reader view
           :initarg :view
@@ -96,10 +97,6 @@
 Drei buffer. The most important role for instances of subclasses
 of this class is to visually represent the position of point."))
 
-(defmethod initialize-instance :after ((object drei-cursor) &rest initargs)
-  (declare (ignore initargs))
-  (stream-add-output-record (output-stream object) object))
-
 (defgeneric active (cursor)
   (:documentation "Whether the cursor is active or
 not. An active cursor is drawn using the active ink, and an
@@ -204,6 +201,14 @@
 (defmethod (setf view) :after (new-val (drei drei-pane))
   (window-clear drei))
 
+(defmethod (setf cursors) :around (new-cursors (drei drei-pane))
+  (let ((old-cursors (cursors drei)))
+    (call-next-method)
+    (dolist (old-cursor old-cursors)
+      (erase-output-record old-cursor drei nil))
+    (dolist (new-cursor new-cursors)
+      (stream-add-output-record drei new-cursor))))
+
 (defmethod note-sheet-grafted :after ((pane drei-pane))
   (setf (stream-default-view pane) (view pane)))
 
@@ -374,6 +379,10 @@
 (defmethod (setf view) :after ((new-view drei-view) (drei drei-area))
   (setf (extend-pane-bottom new-view) t))
 
+(defmethod (setf cursors) :after (new-cursors (drei drei-area))
+  (dolist (new-cursor (cursors drei))
+    (setf (output-record-parent new-cursor) drei)))
+
 (defmethod esa-current-window ((drei drei-area))
   (editor-pane drei))
 
@@ -415,24 +424,28 @@
   +foreground-ink+)
 
 (defmethod output-record-children ((record drei-area))
-  '())
+  (cursors record))
 
 (defmethod output-record-count ((record drei-area))
-  0)
+  (length (cursors record)))
 
 (defmethod map-over-output-records-containing-position
     (function (record drei-area) x y
      &optional (x-offset 0) (y-offset 0)
      &rest function-args)
-  (declare (ignore function x y x-offset y-offset function-args))
-  nil)
+  (declare (ignore x-offset y-offset))
+  (dolist (cursor (cursors record))
+    (when (region-contains-position-p cursor x y)
+      (apply function cursor function-args))))
 
 (defmethod map-over-output-records-overlapping-region
     (function (record drei-area) region
      &optional (x-offset 0) (y-offset 0)
      &rest function-args)
-  (declare (ignore function region x-offset y-offset function-args))
-  nil)
+  (declare (ignore x-offset y-offset))
+  (dolist (cursor (cursors record))
+    (when (region-intersects-region-p cursor region)
+      (apply function cursor function-args))))
 
 (defmethod bounding-rectangle* ((drei drei-area))
   (with-accessors ((pane editor-pane)
@@ -457,6 +470,16 @@
                            (t 0)))
                 (max y2 (+ y1 height)))))))
 
+(defmethod replay-output-record :after ((drei drei-area) (stream extended-output-stream)
+                                        &optional (x-offset 0) (y-offset 0) (region +everywhere+))
+  (declare (ignore x-offset y-offset region))
+  (dolist (cursor (cursors drei))
+    (replay cursor stream)))
+
+(defmethod recompute-extent-for-changed-child  ((drei drei-area) (child output-record)
+                                                old-min-x old-min-y old-max-x old-max-y)
+  nil)
+
 (defmethod rectangle-edges* ((rectangle drei-area))
   (bounding-rectangle* rectangle))
 
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp	2008/02/01 22:28:15	1.57
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp	2008/02/02 19:03:26	1.58
@@ -930,18 +930,18 @@
     (change-space-requirements pane
      :width (max (bounding-rectangle-max-x cursor)
                  (bounding-rectangle-max-x pane))
-     :width (max (if (extend-pane-bottom view)
-                     (bounding-rectangle-max-y cursor)
-                     0)
-                 (bounding-rectangle-max-y pane)))
+     :height (max (if (extend-pane-bottom view)
+                      (bounding-rectangle-max-y cursor)
+                      0)
+                  (bounding-rectangle-max-y pane)))
     ;; And draw the cursor again.
     (call-next-method)))
 
 (defmethod display-drei-view-cursor :around ((stream extended-output-stream)
                                              (view drei-buffer-view)
                                              (cursor drei-cursor))
+  (clear-output-record cursor)
   (when (visible-p cursor)
-    (clear-output-record cursor)
     (prog1 (call-next-method)
       (with-bounding-rectangle* (x1 y1 x2 y2) cursor
         (do-displayed-lines (line view)
@@ -1011,13 +1011,6 @@
 ;;;
 ;;; Drei area redisplay.
 
-(defmethod erase-output-record :after ((drei drei-area) (stream extended-output-stream)
-                                       &optional (errorp nil errorp-supplied))
-  (dolist (cursor (cursors drei))
-    (apply #'erase-output-record cursor stream
-           (when errorp-supplied
-             (list errorp)))))
-
 ;; XXX: Full redraw for every replay, should probably use the `region'
 ;; parameter to only invalidate some strokes.
 (defmethod replay-output-record ((drei drei-area) (stream extended-output-stream) &optional
@@ -1025,14 +1018,11 @@
   (declare (ignore x-offset y-offset region))
   (letf (((stream-cursor-position stream) (output-record-start-cursor-position drei)))
     (invalidate-all-strokes (view drei))
-    (display-drei-view-contents stream (view drei)))
-  (dolist (cursor (cursors drei))
-    (replay cursor stream)))
+    (display-drei-view-contents stream (view drei))))
 
 (defmethod replay-output-record ((cursor drei-cursor) stream &optional
                                  (x-offset 0) (y-offset 0) (region +everywhere+))
   (declare (ignore x-offset y-offset region))
-  (clear-output-record cursor)
   (with-output-recording-options (stream :record t :draw t)
     (display-drei-view-cursor stream (view cursor) cursor)))