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

Modified Files: drei-redisplay.lisp views.lisp Log Message: Fixed redisplay issue where changes to the contents of strokes were sometimes not picked up correctly.

--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/21 20:23:40 1.47 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/22 15:21:07 1.48 @@ -330,6 +330,31 @@ (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." + (with-accessors ((lines displayed-lines)) view + (cond ((< offset (line-start-offset (aref lines 0))) + 0) + ((> offset (line-end-offset (last-displayed-line view))) + (1- (displayed-lines-count view))) + (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)))))) + (defun ensure-line-information-size (view min-size) "Ensure that the array of lines for `view' contains at least `min-size' elements." @@ -379,14 +404,24 @@ (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))) + (old-drawing-options (stroke-drawing-options stroke)) + (changed-region (first (changed-regions view)))) (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))) + (stroke-drawing-options stroke)) + (or (null changed-region) + (not (overlaps (stroke-start-offset stroke) (stroke-end-offset stroke) + (car changed-region) (cdr changed-region))))) (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. + (when (and changed-region + (>= (stroke-end-offset stroke) + (cdr changed-region))) + (pop (changed-regions view))) (incf (line-stroke-count line)) (setf (line-end-offset line) (stroke-end-offset stroke)))))

--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/21 17:08:28 1.25 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/22 15:21:07 1.26 @@ -552,7 +552,13 @@ :initform 0 :type number :documentation "The width of the longest -displayed line in device units.")) +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.")) (:metaclass modual-class) (:documentation "A view that contains a `drei-buffer' object. The buffer is displayed on a simple line-by-line basis, @@ -586,6 +592,47 @@ "Return true if `view' is a `drei-buffer-view'." (typep view 'drei-buffer-view))

+(defun overlaps (x1 x2 y1 y2) + "Return true if the x1/x2 region overlaps with y1/y2." + (or (<= x1 y1 x2) + (<= y1 x1 y2) + (<= 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))) + (setf (first list) + (cons (cons start end) (first list))) + 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))))) + +(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))) + (defclass drei-syntax-view (drei-buffer-view) ((%syntax :accessor syntax :documentation "An instance of the syntax class used @@ -675,48 +722,49 @@ (modified-p view) t)) (call-next-method))

-(defmethod synchronize-view :around ((view drei-syntax-view) &key - force-p (begin 0) (end (size (buffer view)))) - (assert (>= end begin)) - ;; If nothing changed, then don't call the other methods. - (when (or (not (= (prefix-size view) (suffix-size view) - (buffer-size view) (size (buffer view)))) - force-p) - (call-next-method))) +(defun needs-resynchronization (view) + "Return true if the the view of the buffer of `view' is +potentially out of date. Return false otherwise." + (not (= (prefix-size view) (suffix-size view) + (buffer-size view) (size (buffer view)))))

(defmethod synchronize-view ((view drei-syntax-view) - &key (begin 0) (end (size (buffer view)))) + &key (begin 0) (end (size (buffer view))) + force-p) "Synchronize the syntax view with the underlying buffer. `Begin' and `end' are offsets specifying the region of the buffer that must be synchronised, defaulting to 0 and the size of the buffer respectively." - (let ((prefix-size (prefix-size view)) - (suffix-size (suffix-size view))) - ;; Set some minimum values here so if `update-syntax' calls - ;; `update-parse' itself, we won't end with infinite recursion. - (setf (prefix-size view) (max (if (> begin prefix-size) - prefix-size - end) - prefix-size) - (suffix-size view) (max (if (>= end (- (size (buffer view)) suffix-size)) - (max (- (size (buffer view)) begin) suffix-size) - suffix-size) - suffix-size) - (buffer-size view) (size (buffer view))) - (multiple-value-bind (parsed-start parsed-end) - (update-syntax (syntax view) prefix-size suffix-size begin end) - (assert (>= parsed-end parsed-start)) - ;; Now set the proper new values for prefix-size and - ;; suffix-size. - (setf (prefix-size view) (max (if (>= prefix-size parsed-start) - parsed-end - prefix-size) + (assert (>= end begin)) + ;; If nothing changed, then don't call the other methods. + (when (or (needs-resynchronization view) force-p) + (let ((prefix-size (prefix-size view)) + (suffix-size (suffix-size view))) + ;; Set some minimum values here so if `update-syntax' calls + ;; `update-parse' itself, we won't end with infinite recursion. + (setf (prefix-size view) (max (if (> begin prefix-size) + prefix-size + end) prefix-size) - (suffix-size view) (max (if (>= parsed-end (- (size (buffer view)) suffix-size)) - (- (size (buffer view)) parsed-start) + (suffix-size view) (max (if (>= end (- (size (buffer view)) suffix-size)) + (max (- (size (buffer view)) begin) suffix-size) suffix-size) - suffix-size))) - (call-next-method))) + suffix-size) + (buffer-size view) (size (buffer view))) + (multiple-value-bind (parsed-start parsed-end) + (update-syntax (syntax view) prefix-size suffix-size begin end) + (assert (>= parsed-end parsed-start)) + ;; Now set the proper new values for prefix-size and + ;; suffix-size. + (setf (prefix-size view) (max (if (>= prefix-size parsed-start) + parsed-end + prefix-size) + prefix-size) + (suffix-size view) (max (if (>= parsed-end (- (size (buffer view)) suffix-size)) + (- (size (buffer view)) parsed-start) + suffix-size) + suffix-size))))) + (call-next-method))

(defun make-syntax-for-view (view syntax-symbol &rest args) (apply #'make-instance syntax-symbol