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

Modified Files: drei-clim.lisp drei-redisplay.lisp Log Message: Changed Drei areas to be proper and well-behaved output records.

Interestingly, they ended up quite similar to parts of Goatee.

--- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/16 22:50:06 1.31 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/17 23:11:06 1.32 @@ -319,7 +319,7 @@ (table drei-command-table)) `(exclusive-gadget-table))

-(defclass drei-area (drei standard-sequence-output-record +(defclass drei-area (drei displayed-output-record region command-processor instant-macro-execution-mixin) ((%background-ink :initarg :background-ink @@ -332,12 +332,17 @@ editable area. Should be an integer >= 0 or T, meaning that it will extend to the end of the viewport, if the Drei area is in a scrolling arrangement.") - (%drei-position :accessor input-editor-position - :initarg :input-editor-position - :documentation "The position of the Drei + (%position :accessor area-position + :initarg :area-position + :documentation "The position of the Drei editing area in the coordinate system of the encapsulated stream. An (X,Y) list, not necessarily the same as the position -of the associated output record.")) +of the associated output record.") + (%parent-output-record :accessor output-record-parent + :initarg :parent + :initform nil + :documentation "The parent output +record of the Drei area instance.")) (:metaclass modual-class) (:default-initargs :command-executor 'execute-drei-command) (:documentation "A Drei editable area implemented as an output @@ -347,9 +352,8 @@ &key x-position y-position) (check-type x-position number) (check-type y-position number) - (setf (input-editor-position area) (list x-position y-position) - (extend-pane-bottom (view area)) t) - (tree-recompute-extent area)) + (setf (area-position area) (list x-position y-position) + (extend-pane-bottom (view area)) t))

(defmethod (setf view) :after ((new-view drei-view) (drei drei-area)) (setf (extend-pane-bottom new-view) t)) @@ -360,6 +364,97 @@ (defmethod display-drei ((drei drei-area)) (display-drei-area drei))

+;;; Implementation of the displayed-output-record and region protocol +;;; for Drei areas. The redisplay-related stuff is in +;;; drei-redisplay.lisp. + +(defmethod output-record-position ((record drei-area)) + (values-list (area-position record))) + +(defmethod (setf output-record-position) ((new-x number) (new-y number) + (record drei-area)) + (setf (area-position record) (list new-x new-y))) + +(defmethod output-record-start-cursor-position ((record drei-area)) + (output-record-position record)) + +(defmethod (setf output-record-start-cursor-position) ((new-x number) (new-y number) + (record drei-area)) + (setf (output-record-position record) (list new-x new-y))) + +(defmethod output-record-hit-detection-rectangle* ((record drei-area)) + (bounding-rectangle* record)) + +(defmethod output-record-refined-position-test ((record drei-area) x y) + t) + +(defmethod displayed-output-record-ink ((record drei-area)) + +foreground-ink+) + +(defmethod output-record-children ((record drei-area)) + '()) + +(defmethod output-record-count ((record drei-area)) + 0) + +(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) + +(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) + +(defmethod bounding-rectangle* ((drei drei-area)) + (with-accessors ((pane editor-pane) + (min-width min-width)) drei + (let* ((style (medium-text-style pane)) + (style-width (text-style-width style pane)) + (height (text-style-height style pane))) + (multiple-value-bind (x1 y1 x2 y2) + (drei-bounding-rectangle* drei) + (when (= x1 y1 x2 y2 0) + ;; It hasn't been displayed yet, so stuff the position into + ;; it... + (setf x1 (first (area-position drei)) + y1 (second (area-position drei)))) + (values x1 y1 + (max x2 (+ x1 style-width) + (cond ((numberp min-width) + (+ x1 min-width)) + ;; Must be T, then. + ((pane-viewport pane) + (+ x1 (bounding-rectangle-width (pane-viewport-region pane)))) + (t 0))) + (max y2 (+ y1 height))))))) + +(defmethod rectangle-edges* ((rectangle drei-area)) + (bounding-rectangle* rectangle)) + +(defmethod region-union ((region1 drei-area) region2) + (region-union (bounding-rectangle region1) region2)) + +(defmethod region-union (region1 (region2 drei-area)) + (region-union region1 (bounding-rectangle region2))) + +(defmethod region-intersection ((region1 drei-area) region2) + (region-intersection (bounding-rectangle region1) region2)) + +(defmethod region-intersection (region1 (region2 drei-area)) + (region-intersection region1 (bounding-rectangle region2))) + +(defmethod region-difference ((region1 drei-area) region2) + (region-difference (bounding-rectangle region1) region2)) + +(defmethod region-difference (region1 (region2 drei-area)) + (region-difference region1 (bounding-rectangle region2))) + ;; For areas, we need to switch to ESA abort gestures after we have ;; left the CLIM gesture reading machinery, but before we start doing ;; ESA gesture processing. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/17 17:25:31 1.43 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/17 23:11:06 1.44 @@ -955,41 +955,12 @@ (when errorp-supplied errorp))))

-(defmethod bounding-rectangle* ((drei drei-area)) - (with-accessors ((pane editor-pane) - (min-width min-width)) drei - (let* ((style (medium-text-style pane)) - (style-width (text-style-width style pane)) - (ascent (text-style-ascent style pane)) - (descent (text-style-descent style pane)) - (height (+ ascent descent))) - (multiple-value-bind (x1 y1 x2 y2) - (drei-bounding-rectangle* drei) - (when (= x1 y1 x2 y2 0) - ;; It hasn't been displayed yet, so stuff the position into - ;; it... - (setf x1 (first (input-editor-position drei)) - y1 (second (input-editor-position drei)))) - (values x1 y1 - (max x2 (+ x1 style-width) - (cond ((numberp min-width) - (+ x1 min-width)) - ;; Must be T, then. - ((pane-viewport pane) - (+ x1 (bounding-rectangle-width (pane-viewport-region pane)))) - (t 0))) - (max y2 (+ y1 height))))))) - -(defmethod bounding-rectangle ((drei drei-area)) - (with-bounding-rectangle* (x1 y1 x2 y2) drei - (make-rectangle* x1 y1 x2 y2))) - ;; 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 (x-offset 0) (y-offset 0) (region +everywhere+)) (declare (ignore x-offset y-offset region)) - (letf (((stream-cursor-position stream) (values-list (input-editor-position drei)))) + (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)) @@ -1005,12 +976,13 @@

(defun display-drei-area (drei) (with-accessors ((stream editor-pane) (view view)) drei - (clear-output-record drei) - (replay drei stream) - (with-bounding-rectangle* (x1 y1 x2 y2) drei - (letf (((stream-current-output-record stream) drei)) - ;; XXX: This sets the size of the output record. - (draw-rectangle* stream x1 y1 x2 y2 :ink +transparent-ink+))) + (with-bounding-rectangle* (old-x1 old-y1 old-x2 old-y2) drei + (replay drei stream) + (with-bounding-rectangle* (new-x1 new-y1 new-x2 new-y2) drei + (unless (and (= new-x1 old-x1) (= new-y1 old-y2) + (= new-x2 old-x2) (= new-y2 old-y2)) + (recompute-extent-for-changed-child (output-record-parent drei) drei + old-x1 old-y1 old-x2 old-y2)))) (when (point-cursor drei) (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor drei) (when (pane-viewport stream)