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)))