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

Modified Files: drei-redisplay.lisp views.lisp Log Message: Changed how buffer changes are registered by the redisplay module.

--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/11 23:05:21 1.62 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/12 19:22:37 1.63 @@ -272,6 +272,37 @@ do (invalidate-line-strokes line :modified modified :cleared cleared)))

+(defun invalidate-strokes-in-region (view start-offset end-offset + &key modified cleared) + "Invalidate all the strokes of `view' that overlap the region +`start-offset'/`end-offset' by setting their dirty-bit to +true. If `modified' or `cleared' is true, also set their +modified-bit to true. If `cleared' is true, inform the strokes +that their previous output has been cleared by someone, and that +they do not need to clear it themselves during their next +redisplay." + ;; If the region is outside the visible region, no-op. + (when (overlaps start-offset end-offset + (offset (top view)) (offset (bot view))) + (let ((line1-index (index-of-displayed-line-containing-offset view start-offset)) + (line2-index (index-of-displayed-line-containing-offset view end-offset))) + (loop for line = (line-information view line1-index) + when (<= start-offset + (line-start-offset line) (line-end-offset line) + end-offset) + ;; The entire line is within the region. + do (invalidate-line-strokes line :modified modified + :cleared cleared) + ;; Only part of the line is within the region. + else do (do-displayed-line-strokes (stroke line) + (when (overlaps start-offset end-offset + (stroke-start-offset stroke) + (stroke-end-offset stroke)) + (invalidate-stroke stroke :modified modified + :cleared cleared))) + if (= line1-index line2-index) do (loop-finish) + else do (incf line1-index))))) + (defmacro do-displayed-lines ((line-sym view) &body body) "Loop over lines on display for `view', evaluating `body' with `line-sym' bound to the `displayed-line' object for each line." @@ -328,10 +359,11 @@ (end-offset (stroke-end-offset stroke)))) (return stroke))))))

-(defun find-index-of-line-containing-offset (view offset) - "Return the index of the line containing `offset'. If `offset' -is before the displayed lines, return 0. If `offset' is after the -displayed lines, return the index of the last line." +(defun index-of-displayed-line-containing-offset (view offset) + "Return the index of the `displayed-line' object containing +`offset'. If `offset' is before the displayed lines, return 0. If +`offset' is after the displayed lines, return the index of the +last line." (with-accessors ((lines displayed-lines)) view (cond ((< offset (line-start-offset (aref lines 0))) 0) @@ -340,18 +372,18 @@ (t ;; Binary search for the line. (loop with low-index = 0 - with high-index = (displayed-lines-count view) - for middle = (floor (+ low-index high-index) 2) - for this-line = (aref lines middle) - for line-start = (line-start-offset this-line) - for line-end = (line-end-offset this-line) - do (cond ((<= line-start offset line-end) - (loop-finish)) - ((mark> offset line-start) - (setf low-index (1+ middle))) - ((mark< offset line-start) - (setf high-index middle))) - finally (return middle)))))) + with high-index = (displayed-lines-count view) + for middle = (floor (+ low-index high-index) 2) + for this-line = (aref lines middle) + for line-start = (line-start-offset this-line) + for line-end = (line-end-offset this-line) + do (cond ((<= line-start offset line-end) + (loop-finish)) + ((> offset line-start) + (setf low-index (1+ middle))) + ((< offset line-start) + (setf high-index middle))) + finally (return middle))))))

(defun ensure-line-information-size (view min-size) "Ensure that the array of lines for `view' contains at least @@ -402,24 +434,14 @@ (let* ((stroke (line-stroke-information line (line-stroke-count line))) (old-start-offset (stroke-start-offset stroke)) (old-end-offset (stroke-end-offset stroke)) - (old-drawing-options (stroke-drawing-options stroke)) - (changed-region (first (changed-regions view)))) + (old-drawing-options (stroke-drawing-options stroke))) (prog1 (stroke-pump view stroke pump-state) (unless (and old-start-offset (= (+ old-start-offset line-change) (stroke-start-offset stroke)) (= (+ old-end-offset line-change) (stroke-end-offset stroke)) (drawing-options-equal old-drawing-options - (stroke-drawing-options stroke)) - (or (null changed-region) - (not (overlaps (stroke-start-offset stroke) (stroke-end-offset stroke) - (car changed-region) (cdr changed-region))))) + (stroke-drawing-options stroke))) (invalidate-stroke stroke :modified t)) - ;; Move to the next changed region, if it is not possible for - ;; more stroks to overlap with the current one. - (loop while (and (first (changed-regions view)) - (>= (stroke-end-offset stroke) - (cdr (first (changed-regions view))))) - do (pop (changed-regions view))) (incf (line-stroke-count line)) (setf (line-end-offset line) (stroke-end-offset stroke)))))

@@ -634,7 +656,8 @@ (do-undisplayed-line-strokes (stroke line) (if (null (stroke-start-offset stroke)) (return) - (setf (stroke-start-offset stroke) nil)))) + (progn (setf (stroke-start-offset stroke) nil) + (invalidate-stroke stroke :modified t)))))

(defun draw-line-strokes (pane view initial-pump-state start-offset cursor-x cursor-y @@ -711,7 +734,8 @@ (do-undisplayed-line-strokes (stroke line) (if (null (stroke-start-offset stroke)) (return) - (setf (stroke-start-offset stroke) nil)))) + (progn (setf (stroke-start-offset stroke) nil) + (invalidate-stroke stroke :modified t))))) (with-bounding-rectangle* (x1 y1 x2 y2) view (declare (ignore x2)) (when (> old-height (- y2 y1)) --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/11 22:50:05 1.35 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/12 19:22:37 1.36 @@ -594,12 +594,6 @@ :type number :documentation "The width of the longest displayed line in device units.") - (%changed-regions :accessor changed-regions - :initform nil - :documentation "A list of (start . end) conses -of buffer offsets, delimiting the regions of the buffer that have -changed since the last redisplay. The regions are not -overlapping, and are sorted in ascending order.") (lines :initform (make-instance 'standard-flexichain) :reader lines :documentation "The lines of the buffer, stored in a @@ -632,8 +626,11 @@ (defmethod (setf bot) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view))

-(defmethod (setf buffer) :after (new-value (view drei-buffer-view)) - (invalidate-all-strokes view)) +(defmethod (setf buffer) :after (buffer (view drei-buffer-view)) + (invalidate-all-strokes view) + (with-accessors ((top top) (bot bot)) view + (setf top (make-buffer-mark buffer 0 :left) + bot (make-buffer-mark buffer (size buffer) :right))))

(defmethod (setf syntax) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view :modified t)) @@ -657,32 +654,6 @@ (<= y1 x1 x2 y2) (<= x1 y1 y1 x2)))

-(defun remember-changed-region (view start end) - "Note that the buffer region delimited by the offset `start' -and `end' has been modified." - (labels ((worker (list) - ;; Return a new changed-regions list. Try to extend old - ;; regions instead of adding new ones. - (cond ((null list) - (list (cons start end))) - ;; If start/end overlaps with (first list), extend - ;; (first list) - ((overlaps start end (car (first list)) (cdr (first list))) - (setf (car (first list)) (min start (car (first list))) - (cdr (first list)) (max end (cdr (first list)))) - list) - ;; If start/end is wholly before (first list), push - ;; on a new region. - ((< start (car (first list))) - (cons (cons start end) list)) - ;; If start/end is wholly before (first list), go - ;; further down list. If at end of list, add new - ;; element. - ((< (cdr (first list)) end) - (setf (rest list) (worker (rest list))) - list)))) - (setf (changed-regions view) (worker (changed-regions view))))) - (defclass buffer-line () ((%start-mark :reader start-mark :initarg :start-mark @@ -783,12 +754,14 @@

(defmethod observer-notified ((view drei-buffer-view) (buffer drei-buffer) changed-region) - ;; If something has been redisplayed, and there have been changes to - ;; some of those lines, mark them as dirty. - (remember-changed-region view (car changed-region) (cdr changed-region)) - ;; I suspect it's most efficient to keep this always up to date, - ;; even for small changes. - (update-line-data view (car changed-region) (cdr changed-region))) + (destructuring-bind (start-offset . end-offset) changed-region + ;; If something has been redisplayed, and there have been changes + ;; to some of those strokes, mark them as dirty. + (invalidate-strokes-in-region + view start-offset end-offset :modified t) + ;; I suspect it's most efficient to keep this always up to date, + ;; even for small changes. + (update-line-data view start-offset end-offset)))

;;; Exploit the stored line information.

@@ -866,21 +839,11 @@ ;; We need a new syntax object of the same type as the old one, and ;; to zero out the unchanged-prefix-values. (with-accessors ((view-syntax syntax) - (point point) (mark mark) (suffix-size suffix-size) (prefix-size prefix-size) (buffer-size buffer-size) (bot bot) (top top)) view - (setf point (clone-mark (point buffer)) - mark (clone-mark (point buffer) :right) - (offset mark) 0 - view-syntax (make-syntax-for-view view (class-of view-syntax)) - prefix-size 0 - suffix-size 0 - buffer-size -1 ; For reparse even if buffer is empty. - ;; Also set the top and bot marks. - top (make-buffer-mark buffer 0 :left) - bot (make-buffer-mark buffer (size buffer) :right)))) + (setf view-syntax (make-syntax-for-view view (class-of view-syntax)))))

(defmethod (setf syntax) :after (syntax (view drei-syntax-view)) (setf (prefix-size view) 0