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
