February 2008 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 14 Feb '08

14 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv31883/Drei Modified Files: views.lisp Log Message: Oops, accidentally reintroduced old bug. Pick up on buffer changes affecting strokes. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/13 21:58:50 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/14 08:15:01 1.38 @@ -771,6 +771,7 @@ (defmethod observer-notified ((view drei-buffer-view) (buffer drei-buffer) changed-region) (destructuring-bind (start-offset . end-offset) changed-region + (invalidate-strokes-in-region view start-offset end-offset :modified t) (with-accessors ((prefix-size lines-prefix-size) (suffix-size lines-suffix-size)) view (setf prefix-size (min start-offset prefix-size)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 13 Feb '08

13 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv15222/Drei Modified Files: drei-redisplay.lisp views.lisp Log Message: Some general cleanups in Drei redisplay. No functionality changes. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/12 19:22:37 1.63 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/13 21:58:50 1.64 @@ -272,37 +272,6 @@ 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." @@ -348,6 +317,39 @@ (+ (line-stroke-count ,line) ,stroke-index)))) ,@body))))) +(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." + (as-region (start-offset end-offset) + ;; If the region is outside the visible region, no-op. + (when (and (plusp (displayed-lines-count view)) ; If there is any display... + (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)))))) + (defun find-stroke-containing-offset (view offset) "Find the stroke of `view' that displays the buffer offset `offset'. If no such stroke can be found, this function returns @@ -430,7 +432,8 @@ `view', and add it to the sequence of displayed strokes in `line'. `Line-change' should be a relative offset specifying how much the start-offset of `line' has changed since the last time -it was redisplayed." +it was redisplayed. `Offset' is the offset at which the next +stroke will start." (let* ((stroke (line-stroke-information line (line-stroke-count line))) (old-start-offset (stroke-start-offset stroke)) (old-end-offset (stroke-end-offset stroke)) @@ -678,19 +681,21 @@ ;; ugly, just complex. (multiple-value-bind (line-width baseline descent pump-state) ;; Pump all the line strokes and calculate their dimensions. - (loop for index from 0 - for stroke = (line-stroke-information line index) - for stroke-dimensions = (stroke-dimensions stroke) - for pump-state = (put-stroke view line initial-pump-state offset-change) then - (put-stroke view line pump-state offset-change) - do (update-stroke-dimensions pane view stroke cursor-x cursor-y) - (setf cursor-x (x2 stroke-dimensions)) - maximizing (- (dimensions-height stroke-dimensions) - (center stroke-dimensions)) into descent - maximizing (+ (center stroke-dimensions) cursor-y) into baseline - summing (dimensions-width stroke-dimensions) into line-width - when (stroke-at-end-of-line (buffer view) stroke) - return (values line-width baseline descent pump-state)) + (loop with offset = start-offset + for index from 0 + for stroke = (line-stroke-information line index) + for stroke-dimensions = (stroke-dimensions stroke) + for pump-state = (put-stroke view line initial-pump-state offset-change) + then (put-stroke view line pump-state offset-change) + do (update-stroke-dimensions pane view stroke cursor-x cursor-y) + (setf cursor-x (x2 stroke-dimensions)) + (setf offset (stroke-end-offset stroke)) + maximizing (- (dimensions-height stroke-dimensions) + (center stroke-dimensions)) into descent + maximizing (+ (center stroke-dimensions) cursor-y) into baseline + summing (dimensions-width stroke-dimensions) into line-width + when (stroke-at-end-of-line (buffer view) stroke) + return (values line-width baseline descent pump-state)) (let ((line-height (- (+ baseline descent) cursor-y))) ;; Loop over the strokes and clear the parts of the pane that ;; has to be redrawn, trying to minimise the number of calls to @@ -783,16 +788,19 @@ (defmethod display-drei-view-contents ((pane basic-pane) (view drei-buffer-view)) (with-bounding-rectangle* (x1 y1 x2 y2) view - (let ((old-width (- x2 x1)) - (old-height (- y2 y1))) + (let* ((old-width (- x2 x1)) + (old-height (- y2 y1)) + (start-offset (offset (beginning-of-line (top view)))) + (pump-state (pump-state-for-offset view start-offset)) + (pane-height (bounding-rectangle-height (or (pane-viewport pane) pane)))) + ;; For invalidation of the parts of the display that have + ;; changed. + (synchronize-view view :begin (offset (top view)) :end (offset (bot view))) (setf (displayed-lines-count view) 0 (max-line-width view) 0) (multiple-value-bind (cursor-x cursor-y) (stream-cursor-position pane) (with-output-recording-options (pane :record nil :draw t) - (loop with start-offset = (offset (beginning-of-line (top view))) - with pump-state = (pump-state-for-offset view start-offset) - with pane-height = (bounding-rectangle-height (or (pane-viewport pane) pane)) - for line = (line-information view (displayed-lines-count view)) + (loop for line = (line-information view (displayed-lines-count view)) do (multiple-value-bind (new-pump-state line-height) (draw-line-strokes pane view pump-state start-offset cursor-x cursor-y old-width) @@ -823,17 +831,19 @@ "Return a pump state usable for pumpting strokes for `view' (a `drei-buffer-view') from `offset'." ;; Perform binary search looking for line starting with `offset'. + (synchronize-view view :begin offset) (with-accessors ((lines lines)) view (loop with low-index = 0 with high-index = (nb-elements lines) for middle = (floor (+ low-index high-index) 2) - for line-start = (start-mark (element* lines middle)) - do (cond ((mark> offset line-start) + for this-line = (element* lines middle) + for line-start = (start-mark this-line) + do (cond ((offset-in-line-p this-line offset) + (loop-finish)) + ((mark> offset line-start) (setf low-index (1+ middle))) ((mark< offset line-start) - (setf high-index middle)) - ((mark= offset line-start) - (loop-finish))) + (setf high-index middle))) finally (return (make-pump-state middle offset 0))))) (defun fetch-chunk (line chunk-index) --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/12 19:22:37 1.36 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/13 21:58:50 1.37 @@ -578,7 +578,7 @@ the string is accessed through the reader.") (%displayed-lines :accessor displayed-lines :initform (make-array 0 :element-type 'displayed-line - :initial-element (make-displayed-line)) + :initial-element (make-displayed-line)) :type array :documentation "An array of the `displayed-line' objects displayed by the view. Not all of these @@ -594,10 +594,18 @@ :type number :documentation "The width of the longest displayed line in device units.") - (lines :initform (make-instance 'standard-flexichain) - :reader lines - :documentation "The lines of the buffer, stored in a -format that makes it easy to retrieve information about them.")) + (%lines :initform (make-instance 'standard-flexichain) + :reader lines + :documentation "The lines of the buffer, stored in a +format that makes it easy to retrieve information about them.") + (%lines-prefix :accessor lines-prefix-size + :documentation "The number of unchanged +objects at the start of the buffer since the list of lines was +last updated.") + (%lines-suffix :accessor lines-suffix-size + :documentation "The number of unchanged objects +at the end of the buffer since since the list of lines was last +updated.")) (:metaclass modual-class) (:documentation "A view that contains a `drei-buffer' object. The buffer is displayed on a simple line-by-line basis, @@ -608,7 +616,9 @@ &key buffer single-line read-only initial-contents) (declare (ignore initargs)) - (with-accessors ((top top) (bot bot)) view + (with-accessors ((top top) (bot bot) + (lines-prefix lines-prefix-size) + (lines-suffix lines-suffix-size)) view (unless buffer ;; So many fun things are defined on (setf buffer) that we use ;; slot-value here. This is just a glorified initform anyway. @@ -617,8 +627,9 @@ :read-only read-only :initial-contents initial-contents))) (setf top (make-buffer-mark (buffer view) 0 :left) - bot (make-buffer-mark (buffer view) (size (buffer view)) :right)) - (update-line-data view 0 (size (buffer view))))) + bot (clone-mark top :right) + lines-prefix 0 + lines-suffix 0))) (defmethod (setf top) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view)) @@ -628,12 +639,13 @@ (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)) + (with-accessors ((top top) (bot bot) + (lines-prefix lines-prefix-size) + (lines-suffix lines-suffix-size)) view + (setf top (make-buffer-mark buffer 0 :left) + bot (clone-mark top :right) + lines-prefix 0 + lines-suffix 0))) (defmethod cache-string :around ((view drei-buffer-view)) (let ((string (call-next-method))) @@ -713,55 +725,59 @@ (cons (- (1+ chunk-end-offset) line-start-offset) t))))) -(defun update-line-data (view start end) +(defun update-line-data (view) "Update the sequence of lines stored by the `drei-buffer-view' -`view'. `Start' and `end' are buffer offsets delimiting the -region that has changed since the last update." - (let ((low-mark (make-buffer-mark (buffer view) start :left)) - (high-mark (make-buffer-mark (buffer view) end :left))) - (when (mark<= low-mark high-mark) - (beginning-of-line low-mark) - (end-of-line high-mark) - (with-accessors ((lines lines)) view - (let ((low-index 0) - (high-index (nb-elements lines))) - ;; Binary search for the start of changed lines. - (loop while (< low-index high-index) - do (let* ((middle (floor (+ low-index high-index) 2)) - (line-start (start-mark (element* lines middle)))) - (cond ((mark> low-mark line-start) - (setf low-index (1+ middle))) - (t - (setf high-index middle))))) - ;; Discard lines that have to be re-analyzed. - (loop while (and (< low-index (nb-elements lines)) - (mark<= (start-mark (element* lines low-index)) - high-mark)) - do (delete* lines low-index)) - ;; Analyze new lines. - (loop while (mark<= low-mark high-mark) - for i from low-index - do (progn (let ((line-start-mark (clone-mark low-mark))) - (insert* lines i (make-instance - 'buffer-line - :start-mark line-start-mark - :line-length (- (offset (end-of-line low-mark)) - (offset line-start-mark)))) - (if (end-of-buffer-p low-mark) - (loop-finish) - ;; skip newline - (forward-object low-mark)))))))))) +`view'." + (with-accessors ((prefix-size lines-prefix-size) + (suffix-size lines-suffix-size)) view + (when (<= prefix-size (- (size (buffer view)) suffix-size)) + (let ((low-mark (make-buffer-mark (buffer view) prefix-size :left)) + (high-mark (make-buffer-mark + (buffer view) (- (size (buffer view)) suffix-size) :left))) + (beginning-of-line low-mark) + (end-of-line high-mark) + (with-accessors ((lines lines)) view + (let ((low-index 0) + (high-index (nb-elements lines))) + ;; Binary search for the start of changed lines. + (loop while (< low-index high-index) + do (let* ((middle (floor (+ low-index high-index) 2)) + (line-start (start-mark (element* lines middle)))) + (cond ((mark> low-mark line-start) + (setf low-index (1+ middle))) + (t + (setf high-index middle))))) + ;; Discard lines that have to be re-analyzed. + (loop while (and (< low-index (nb-elements lines)) + (mark<= (start-mark (element* lines low-index)) + high-mark)) + do (delete* lines low-index)) + ;; Analyze new lines. + (loop while (mark<= low-mark high-mark) + for i from low-index + do (progn (let ((line-start-mark (clone-mark low-mark))) + (insert* lines i (make-instance + 'buffer-line + :start-mark line-start-mark + :line-length (- (offset (end-of-line low-mark)) + (offset line-start-mark)))) + (if (end-of-buffer-p low-mark) + (loop-finish) + ;; skip newline + (forward-object low-mark))))))))) + (setf prefix-size (size (buffer view)) + suffix-size (size (buffer view))))) (defmethod observer-notified ((view drei-buffer-view) (buffer drei-buffer) 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))) + (with-accessors ((prefix-size lines-prefix-size) + (suffix-size lines-suffix-size)) view + (setf prefix-size (min start-offset prefix-size) + suffix-size (min (- (size buffer) end-offset) suffix-size))))) + +(defmethod synchronize-view ((view drei-buffer-view) &key) + (update-line-data view)) ;;; Exploit the stored line information. @@ -771,24 +787,32 @@ (<= (offset (start-mark line)) offset (end-offset line))) +(defun index-of-line-containing-offset (view mark-or-offset) + "Return the index of the line `mark-or-offset' is in for +`view'. `View' must be a `drei-buffer-view'." + ;; Perform binary search looking for line containing `offset1'. + (as-offsets ((offset mark-or-offset)) + (with-accessors ((lines lines)) view + (loop with low-index = 0 + with high-index = (nb-elements lines) + for middle = (floor (+ low-index high-index) 2) + for this-line = (element* lines middle) + for line-start = (start-mark this-line) + do (cond ((offset-in-line-p this-line offset) + (loop-finish)) + ((mark> offset line-start) + (setf low-index (1+ middle))) + ((mark< offset line-start) + (setf high-index middle))) + finally (return middle))))) + (defun line-containing-offset (view mark-or-offset) "Return the line `mark-or-offset' is in for `view'. `View' must be a `drei-buffer-view'." ;; Perform binary search looking for line containing `offset1'. (as-offsets ((offset mark-or-offset)) (with-accessors ((lines lines)) view - (loop with low-index = 0 - with high-index = (nb-elements lines) - for middle = (floor (+ low-index high-index) 2) - for this-line = (element* lines middle) - for line-start = (start-mark this-line) - do (cond ((offset-in-line-p this-line offset) - (loop-finish)) - ((mark> offset line-start) - (setf low-index (1+ middle))) - ((mark< offset line-start) - (setf high-index middle))) - finally (return this-line))))) + (element* lines (index-of-line-containing-offset view offset))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -838,11 +862,7 @@ (add-observer buffer view) ;; 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) - (suffix-size suffix-size) - (prefix-size prefix-size) - (buffer-size buffer-size) - (bot bot) (top top)) view + (with-accessors ((view-syntax syntax)) view (setf view-syntax (make-syntax-for-view view (class-of view-syntax))))) (defmethod (setf syntax) :after (syntax (view drei-syntax-view)) @@ -869,17 +889,18 @@ (defmethod observer-notified ((view drei-syntax-view) (buffer drei-buffer) changed-region) - (with-accessors ((prefix-size prefix-size) - (suffix-size suffix-size)) view - (setf prefix-size (min (car changed-region) prefix-size) - suffix-size (min (- (size buffer) (cdr changed-region)) - suffix-size) - (modified-p view) t)) + (destructuring-bind (start-offset . end-offset) changed-region + (with-accessors ((prefix-size prefix-size) + (suffix-size suffix-size) + (modified-p modified-p)) view + (setf prefix-size (min start-offset prefix-size) + suffix-size (min (- (size buffer) end-offset) suffix-size) + modified-p t))) (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." +potentially out of date. Return false otherwise." (not (= (prefix-size view) (suffix-size view) (buffer-size view) (size (buffer view)))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 12 Feb '08

12 Feb '08

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

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv27656/Drei Modified Files: drei-redisplay.lisp fundamental-syntax.lisp packages.lisp Log Message: Replace the old and inefficient generic buffer view redisplay with new one based on functionality stolen from Fundamental syntax. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/03 19:17:26 1.61 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/02/11 23:05:21 1.62 @@ -757,48 +757,6 @@ (+ width cursor-x) cursor-y draw baseline))))))) -(defmethod pump-state-for-offset ((view drei-buffer-view) (offset integer)) - "For a `drei-buffer-view' a pump-state is merely an offset into -the buffer determining where the next stroke should start." - offset) - -(defun fetch-chunk (buffer chunk-start-offset) - "Retrieve a chunk from `buffer', with the chunk starting at -`chunk-start-offset'. The chunk is a cons, with the car being the -start-offset of the chunk as an integer, and the cdr being either -the end-offset of the chunk as an integer, or a function. If a -function, the chunk is a one-object non-string chunk, and the -function is the drawing function for the chunk." - (let* ((line-end-offset (end-of-line-offset - buffer chunk-start-offset)) - (chunk-end-offset (buffer-find-nonchar - buffer chunk-start-offset - (min (+ *maximum-chunk-size* - chunk-start-offset) - line-end-offset)))) - (cond ((or (not (= chunk-end-offset chunk-start-offset)) - (and (offset-beginning-of-line-p buffer chunk-start-offset) - (offset-end-of-line-p buffer chunk-end-offset))) - (cons chunk-start-offset - chunk-end-offset)) - ((not (characterp (buffer-object buffer chunk-end-offset))) - (cons chunk-end-offset (object-drawer)))))) - -(defmethod stroke-pump ((view drei-buffer-view) stroke pump-state) - (let* ((chunk (fetch-chunk (buffer view) pump-state)) - (drawing-options (if (functionp (cdr chunk)) - (make-drawing-options :function (cdr chunk)) - +default-drawing-options+)) - (actual-end-offset (if (functionp (cdr chunk)) - (1+ (car chunk)) - (cdr chunk)))) - (setf (stroke-start-offset stroke) (car chunk) - (stroke-end-offset stroke) actual-end-offset - (stroke-drawing-options stroke) drawing-options) - (if (offset-end-of-line-p (buffer view) actual-end-offset) - (1+ actual-end-offset) - actual-end-offset))) - (defmethod display-drei-view-contents ((pane basic-pane) (view drei-buffer-view)) (with-bounding-rectangle* (x1 y1 x2 y2) view (let ((old-width (- x2 x1)) @@ -824,6 +782,82 @@ (setf (offset (bot view)) (line-end-offset line)) (clear-stale-lines pane view old-width old-height)))))))) +;;; A default redisplay implementation that should work for subclasses +;;; of `drei-buffer-view'. Syntaxes that don't want to implement their +;;; own redisplay behavior can just call these. + +(defstruct (pump-state + (:constructor make-pump-state + (line-index offset chunk-index))) + "A pump state object used by the `drei-buffer-view'. `Line' is +the line object `offset' is in, and `line-index' is the index of +`line' in the list of lines maintained by the view that created +this pump state." + line-index offset chunk-index) + +(defun buffer-view-pump-state-for-offset (view offset) + "Return a pump state usable for pumpting strokes for `view' (a +`drei-buffer-view') from `offset'." + ;; Perform binary search looking for line starting with `offset'. + (with-accessors ((lines lines)) view + (loop with low-index = 0 + with high-index = (nb-elements lines) + for middle = (floor (+ low-index high-index) 2) + for line-start = (start-mark (element* lines middle)) + do (cond ((mark> offset line-start) + (setf low-index (1+ middle))) + ((mark< offset line-start) + (setf high-index middle)) + ((mark= offset line-start) + (loop-finish))) + finally (return (make-pump-state middle offset 0))))) + +(defun fetch-chunk (line chunk-index) + "Retrieve the `chunk-index'th chunk from `line'. The return +value is either an integer, in which case it specifies the +end-offset of a string chunk relative to the start of the line, +or a function, in which case it is the drawing function for a +single-object non-character chunk." + (destructuring-bind (relative-chunk-end-offset . objectp) + (aref (chunks line) chunk-index) + (if objectp (object-drawer) (+ relative-chunk-end-offset + (offset (start-mark line)))))) + +(defun buffer-view-stroke-pump (view stroke pump-state) + "Pump redisplay data into `stroke' based on `pump-state' and +the information managed by `view', which must be a +`drei-buffer-view'." + ;; `Pump-state' will be destructively modified. + (prog1 pump-state + (with-accessors ((line-index pump-state-line-index) + (offset pump-state-offset) + (chunk-index pump-state-chunk-index)) pump-state + (let* ((chunk (fetch-chunk + (element* (lines view) line-index) chunk-index)) + (drawing-options (if (functionp chunk) + (make-drawing-options :function chunk) + +default-drawing-options+)) + (end-offset (if (functionp chunk) + (1+ offset) + chunk))) + (setf (stroke-start-offset stroke) offset + (stroke-end-offset stroke) end-offset + (stroke-drawing-options stroke) drawing-options) + (if (offset-end-of-line-p (buffer view) end-offset) + (setf line-index (1+ line-index) + chunk-index 0 + offset (1+ end-offset)) + (setf chunk-index (1+ chunk-index) + offset end-offset)))))) + +(defmethod pump-state-for-offset ((view drei-buffer-view) (offset integer)) + (buffer-view-pump-state-for-offset view offset)) + +(defmethod stroke-pump ((view drei-buffer-view) stroke pump-state) + (buffer-view-stroke-pump view stroke pump-state)) + +;;; Cursor handling. + (defun offset-in-stroke-position (stream view stroke offset) "Calculate the position in device units of `offset' in `stroke', relative to the starting position of `stroke'. `Offset' --- /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2008/02/11 22:50:04 1.12 +++ /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2008/02/11 23:05:22 1.13 @@ -53,71 +53,18 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; display - -(defstruct (pump-state - (:constructor make-pump-state - (line-index offset chunk-index))) - "A pump state object used in the fundamental syntax. `Line' is -the line object `offset' is in, and `line-index' is the index of -`line' in the list of lines maintained by the syntax that created -this pump state." - line-index - offset - chunk-index) +;;; Redisplay +;;; +;;; Just uses the default buffer-view redisplay behavior. (defmethod pump-state-for-offset-with-syntax ((view textual-drei-syntax-view) (syntax fundamental-syntax) (offset integer)) - ;; Perform binary search looking for line starting with `offset'. - (with-accessors ((lines lines)) view - (loop with low-index = 0 - with high-index = (nb-elements lines) - for middle = (floor (+ low-index high-index) 2) - for line-start = (start-mark (element* lines middle)) - do (cond ((mark> offset line-start) - (setf low-index (1+ middle))) - ((mark< offset line-start) - (setf high-index middle)) - ((mark= offset line-start) - (loop-finish))) - finally (return (make-pump-state middle offset 0))))) - -(defun fetch-chunk (line chunk-index) - "Retrieve the `chunk-index'th chunk from `line'. The return -value is either an integer, in which case it specifies the -end-offset of a string chunk relative to the start of the line, -or a function, in which case it is the drawing function for a -single-object non-character chunk." - (destructuring-bind (relative-chunk-end-offset . objectp) - (aref (chunks line) chunk-index) - (if objectp (object-drawer) (+ relative-chunk-end-offset - (offset (start-mark line)))))) + (buffer-view-pump-state-for-offset view offset)) (defmethod stroke-pump-with-syntax ((view textual-drei-syntax-view) (syntax fundamental-syntax) stroke - (pump-state pump-state)) - ;; `Pump-state' will be destructively modified. - (prog1 pump-state - (with-accessors ((line-index pump-state-line-index) - (offset pump-state-offset) - (chunk-index pump-state-chunk-index)) pump-state - (let* ((chunk (fetch-chunk - (element* (lines view) line-index) chunk-index)) - (drawing-options (if (functionp chunk) - (make-drawing-options :function chunk) - +default-drawing-options+)) - (end-offset (if (functionp chunk) - (1+ offset) - chunk))) - (setf (stroke-start-offset stroke) offset - (stroke-end-offset stroke) end-offset - (stroke-drawing-options stroke) drawing-options) - (if (offset-end-of-line-p (buffer view) end-offset) - (setf line-index (1+ line-index) - chunk-index 0 - offset (1+ end-offset)) - (setf chunk-index (1+ chunk-index) - offset end-offset)))))) + pump-state) + (buffer-view-stroke-pump view stroke pump-state)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/02/11 22:50:05 1.51 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/02/11 23:05:22 1.52 @@ -222,6 +222,8 @@ #:lines #:buffer-line #:start-mark #:line-length #:chunks #:end-offset #:line-containing-offset #:offset-in-line-p + #:buffer-view-pump-state-for-offset + #:buffer-view-stroke-pump #:drei-syntax-view #:syntax #:syntax-view-p #:pump-state-for-offset-with-syntax

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv23316/Apps/Inspector Modified Files: inspector.lisp Log Message: Once again accidentally committed local debugging hack... --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:50:04 1.43 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:51:42 1.44 @@ -47,7 +47,7 @@ :display-function 'display-app) (int :interactor :width 600 :height 100 :max-height 100)) (:layouts - (default (vertically () (scrolling () app) #+nil int)))) + (default (vertically () (scrolling () app) int)))) (defmethod initialize-instance :after ((frame inspector) &rest args) (declare (ignore args))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv23082/Drei Modified Files: fundamental-syntax.lisp lr-syntax.lisp packages.lisp views.lisp Log Message: Flayed Fundamental syntax, most of what it used to do is now done by the drei-buffer-view directly. --- /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2008/01/07 22:01:53 1.11 +++ /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2008/02/11 22:50:04 1.12 @@ -34,119 +34,22 @@ ;;; The syntax object and misc stuff. (define-syntax fundamental-syntax (syntax) - ((lines :initform (make-instance 'standard-flexichain) - :reader lines) - (scan :accessor scan)) + () (:command-table fundamental-table) (:name "Fundamental")) -(defmethod initialize-instance :after ((syntax fundamental-syntax) &rest args) - (declare (ignore args)) - (with-accessors ((buffer buffer) (scan scan)) syntax - (setf scan (make-buffer-mark buffer 0 :left)))) - (setf *default-syntax* 'fundamental-syntax) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; update syntax -(defclass line-object () - ((%start-mark :reader start-mark - :initarg :start-mark) - (%line-length :reader line-length - :initarg :line-length) - (%chunks :accessor chunks - :initform (make-array 5 - :adjustable t - :fill-pointer 0) - :documentation "A list of cons-cells, with the car -being a buffer offset relative to the `start-mark' of the line, -and the cdr being T if the chunk covers a non-character, and NIL -if it covers a character sequence."))) - -(defun line-end-offset (line) - "Return the end buffer offset of `line'." - (+ (offset (start-mark line)) (line-length line))) - -(defun get-chunk (buffer line-start-offset chunk-start-offset line-end-offset) - "Return a chunk in the form of a cons cell. The chunk will -start at `chunk-start-offset' and extend no further than -`line-end-offset'." - (let* ((chunk-end-offset (buffer-find-nonchar - buffer chunk-start-offset - (min (+ *maximum-chunk-size* - chunk-start-offset) - line-end-offset)))) - (cond ((= chunk-start-offset line-end-offset) - (cons (- chunk-end-offset - line-start-offset) nil)) - ((or (not (= chunk-end-offset chunk-start-offset)) - (and (offset-beginning-of-line-p buffer chunk-start-offset) - (offset-end-of-line-p buffer chunk-end-offset))) - (cons (- chunk-end-offset - line-start-offset) nil)) - ((not (characterp (buffer-object buffer chunk-end-offset))) - (cons (- (1+ chunk-end-offset) - line-start-offset) t))))) - (defmethod update-syntax values-max-min ((syntax fundamental-syntax) prefix-size suffix-size &optional begin end) (declare (ignore begin end)) - (let ((low-mark (make-buffer-mark (buffer syntax) prefix-size :left)) - (high-mark (make-buffer-mark - (buffer syntax) (- (size (buffer syntax)) suffix-size) :left))) - (when (mark<= low-mark high-mark) - (beginning-of-line low-mark) - (end-of-line high-mark) - (with-slots (lines scan) syntax - (let ((low-index 0) - (high-index (nb-elements lines))) - ;; Binary search for the start of changed lines. - (loop while (< low-index high-index) - do (let* ((middle (floor (+ low-index high-index) 2)) - (line-start (start-mark (element* lines middle)))) - (cond ((mark> low-mark line-start) - (setf low-index (1+ middle))) - (t - (setf high-index middle))))) - ;; Discard lines that have to be re-analyzed. - (loop while (and (< low-index (nb-elements lines)) - (mark<= (start-mark (element* lines low-index)) - high-mark)) - do (delete* lines low-index)) - ;; Analyze new lines. - (setf (offset scan) (offset low-mark)) - (loop while (mark<= scan high-mark) - for i from low-index - do (progn (let ((line-start-mark (clone-mark scan))) - (insert* lines i (make-instance - 'line-object - :start-mark line-start-mark - :line-length (- (offset (end-of-line scan)) - (offset line-start-mark)))) - (if (end-of-buffer-p scan) - (loop-finish) - ;; skip newline - (forward-object scan)))))))) - ;; Fundamental syntax always parses the entire buffer. - (values 0 (size (buffer syntax))))) - -(defmethod initialize-instance :after ((line line-object) - &rest initargs) - (declare (ignore initargs)) - (loop with buffer = (buffer (start-mark line)) - with line-start-offset = (offset (start-mark line)) - with line-end-offset = (+ line-start-offset (line-length line)) - with chunk-start-offset = line-start-offset - for chunk-info = (get-chunk buffer - line-start-offset - chunk-start-offset line-end-offset) - do (vector-push-extend chunk-info (chunks line)) - (setf chunk-start-offset (+ (car chunk-info) - line-start-offset)) - when (= chunk-start-offset line-end-offset) - do (loop-finish))) + ;; We do nothing. Technically, Fundamental syntax always parses the + ;; entire buffer, though. + (values 0 (size (buffer syntax)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -165,20 +68,19 @@ (defmethod pump-state-for-offset-with-syntax ((view textual-drei-syntax-view) (syntax fundamental-syntax) (offset integer)) - (update-parse syntax 0 offset) ;; Perform binary search looking for line starting with `offset'. - (with-accessors ((lines lines)) syntax + (with-accessors ((lines lines)) view (loop with low-index = 0 - with high-index = (nb-elements lines) - for middle = (floor (+ low-index high-index) 2) - for line-start = (start-mark (element* lines middle)) - do (cond ((mark> offset line-start) - (setf low-index (1+ middle))) - ((mark< offset line-start) - (setf high-index middle)) - ((mark= offset line-start) - (loop-finish))) - finally (return (make-pump-state middle offset 0))))) + with high-index = (nb-elements lines) + for middle = (floor (+ low-index high-index) 2) + for line-start = (start-mark (element* lines middle)) + do (cond ((mark> offset line-start) + (setf low-index (1+ middle))) + ((mark< offset line-start) + (setf high-index middle)) + ((mark= offset line-start) + (loop-finish))) + finally (return (make-pump-state middle offset 0))))) (defun fetch-chunk (line chunk-index) "Retrieve the `chunk-index'th chunk from `line'. The return @@ -199,9 +101,8 @@ (with-accessors ((line-index pump-state-line-index) (offset pump-state-offset) (chunk-index pump-state-chunk-index)) pump-state - (update-parse syntax 0 offset) (let* ((chunk (fetch-chunk - (element* (lines syntax) line-index) chunk-index)) + (element* (lines view) line-index) chunk-index)) (drawing-options (if (functionp chunk) (make-drawing-options :function chunk) +default-drawing-options+)) @@ -222,31 +123,6 @@ ;;; ;;; exploit the parse -(defun offset-in-line-p (line offset) - "Return true if `offset' is in the buffer region delimited by -`line'." - (<= (offset (start-mark line)) offset - (line-end-offset line))) - -(defun line-containing-offset (syntax mark-or-offset) - "Return the line `mark-or-offset' is in for `syntax'. `Syntax' -must be a `fundamental-syntax' object." - ;; Perform binary search looking for line containing `offset1'. - (as-offsets ((offset mark-or-offset)) - (with-accessors ((lines lines)) syntax - (loop with low-index = 0 - with high-index = (nb-elements lines) - for middle = (floor (+ low-index high-index) 2) - for this-line = (element* lines middle) - for line-start = (start-mark this-line) - do (cond ((offset-in-line-p this-line offset) - (loop-finish)) - ((mark> offset line-start) - (setf low-index (1+ middle))) - ((mark< offset line-start) - (setf high-index middle))) - finally (return this-line))))) - ;; do this better (defmethod syntax-line-indentation ((syntax fundamental-syntax) mark tab-width) 0) --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/02/10 00:42:03 1.17 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/02/11 22:50:05 1.18 @@ -35,7 +35,8 @@ (current-state) (initial-state :initarg :initial-state) (current-start-mark) - (current-size))) + (current-size) + (scan :accessor scan))) (defmethod initialize-instance :after ((syntax lr-syntax-mixin) &rest args) (declare (ignore args)) @@ -554,7 +555,8 @@ (drawing-options pump-state-drawing-options) (highlighting-rules pump-state-highlighting-rules)) pump-state - (let ((line (line-containing-offset (syntax view) offset))) + (let* ((line (line-containing-offset view offset)) + (line-end-offset (end-offset line))) (flet ((finish (new-offset symbol &optional stroke-drawing-options sticky-p) (setf start-symbol symbol) (unless (null stroke-drawing-options) @@ -567,7 +569,7 @@ (return-from find-next-stroke-end new-offset))) (cond ((null start-symbol) ;; This means that all remaining lines are blank. - (finish (line-end-offset line) nil)) + (finish line-end-offset nil)) ((and (typep start-symbol 'literal-object-mixin) (= offset (start-offset start-symbol))) (finish (end-offset start-symbol) start-symbol nil)) @@ -584,8 +586,8 @@ (let ((options-to-be-used (if (frame-sticky-p (first drawing-options)) (frame-drawing-options (first drawing-options)) symbol-drawing-options))) - (cond ((> (start-offset symbol) (line-end-offset line)) - (finish (line-end-offset line) start-symbol)) + (cond ((> (start-offset symbol) line-end-offset) + (finish line-end-offset start-symbol)) ((and (typep symbol 'literal-object-mixin)) (finish (start-offset symbol) symbol (or symbol-drawing-options @@ -607,7 +609,7 @@ ;; If there are no more parse symbols, we just go ;; line-by-line from here. This should mean that all ;; remaining lines are blank. - (finish (line-end-offset line) nil)))))))) + (finish line-end-offset nil)))))))) (defmethod stroke-pump-with-syntax ((view textual-drei-syntax-view) (syntax lr-syntax-mixin) stroke --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/31 12:14:05 1.50 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/02/11 22:50:05 1.51 @@ -217,11 +217,18 @@ ;; Views and their facilities. #:drei-view #:modified-p #:no-cursors + #:drei-buffer-view #:buffer #:top #:bot #:buffer-view-p + #:lines + #:buffer-line #:start-mark #:line-length #:chunks #:end-offset + #:line-containing-offset #:offset-in-line-p + #:drei-syntax-view #:syntax #:syntax-view-p #:pump-state-for-offset-with-syntax #:stroke-pump-with-syntax + #:point-mark-view #:point-mark-view-p + #:textual-drei-syntax-view #:tab-space-count #:space-width #:tab-width #:use-tabs #:auto-fill-mode #:auto-fill-column @@ -509,9 +516,7 @@ (defpackage :drei-fundamental-syntax (:use :clim-lisp :clim :drei-buffer :drei-base :drei-syntax :flexichain :drei :drei-core :esa-utils) - (:export #:fundamental-syntax #:scan - #:start-mark #:line-length #:line-end-offset - #:line-containing-offset #:offset-in-line-p) + (:export #:fundamental-syntax) (:documentation "Implementation of the basic syntax module for editing plain text.")) --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/03 07:16:48 1.34 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/02/11 22:50:05 1.35 @@ -550,6 +550,10 @@ (:documentation "Scroll `view', which is displayed on `pane', a page up.")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Buffer view + (defclass drei-buffer-view (drei-view) ((%buffer :accessor buffer :initarg :buffer @@ -595,7 +599,11 @@ :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.")) +overlapping, and are sorted in ascending order.") + (lines :initform (make-instance 'standard-flexichain) + :reader lines + :documentation "The lines of the buffer, stored in a +format that makes it easy to retrieve information about them.")) (:metaclass modual-class) (:documentation "A view that contains a `drei-buffer' object. The buffer is displayed on a simple line-by-line basis, @@ -615,7 +623,8 @@ :read-only read-only :initial-contents initial-contents))) (setf top (make-buffer-mark (buffer view) 0 :left) - bot (make-buffer-mark (buffer view) (size (buffer view)) :right)))) + bot (make-buffer-mark (buffer view) (size (buffer view)) :right)) + (update-line-data view 0 (size (buffer view))))) (defmethod (setf top) :after (new-value (view drei-buffer-view)) (invalidate-all-strokes view)) @@ -674,11 +683,143 @@ list)))) (setf (changed-regions view) (worker (changed-regions view))))) +(defclass buffer-line () + ((%start-mark :reader start-mark + :initarg :start-mark + :documentation "The mark at which this line starts.") + (%line-length :reader line-length + :initarg :line-length + :documentation "The length of the line described by this object.") + (%chunks :accessor chunks + :initform (make-array 5 + :adjustable t + :fill-pointer 0) + :documentation "A list of cons-cells, with the car +being a buffer offset relative to the `start-mark' of the line, +and the cdr being T if the chunk covers a non-character, and NIL +if it covers a character sequence.")) + (:documentation "An object describing a single line in the +buffer associated with a `drei-buffer-view'")) + +(defmethod initialize-instance :after ((line buffer-line) + &rest initargs) + (declare (ignore initargs)) + (loop with buffer = (buffer (start-mark line)) + with line-start-offset = (offset (start-mark line)) + with line-end-offset = (+ line-start-offset (line-length line)) + with chunk-start-offset = line-start-offset + for chunk-info = (get-chunk buffer + line-start-offset + chunk-start-offset line-end-offset) + do (vector-push-extend chunk-info (chunks line)) + (setf chunk-start-offset (+ (car chunk-info) + line-start-offset)) + when (= chunk-start-offset line-end-offset) + do (loop-finish))) + +(defmethod end-offset ((line buffer-line)) + "Return the end buffer offset of `line'." + (+ (offset (start-mark line)) (line-length line))) + +(defun get-chunk (buffer line-start-offset chunk-start-offset line-end-offset) + "Return a chunk in the form of a cons cell. The chunk will +start at `chunk-start-offset' and extend no further than +`line-end-offset'." + (let* ((chunk-end-offset (buffer-find-nonchar + buffer chunk-start-offset + (min (+ *maximum-chunk-size* + chunk-start-offset) + line-end-offset)))) + (cond ((= chunk-start-offset line-end-offset) + (cons (- chunk-end-offset + line-start-offset) nil)) + ((or (not (= chunk-end-offset chunk-start-offset)) + (and (offset-beginning-of-line-p buffer chunk-start-offset) + (offset-end-of-line-p buffer chunk-end-offset))) + (cons (- chunk-end-offset + line-start-offset) nil)) + ((not (characterp (buffer-object buffer chunk-end-offset))) + (cons (- (1+ chunk-end-offset) + line-start-offset) t))))) + +(defun update-line-data (view start end) + "Update the sequence of lines stored by the `drei-buffer-view' +`view'. `Start' and `end' are buffer offsets delimiting the +region that has changed since the last update." + (let ((low-mark (make-buffer-mark (buffer view) start :left)) + (high-mark (make-buffer-mark (buffer view) end :left))) + (when (mark<= low-mark high-mark) + (beginning-of-line low-mark) + (end-of-line high-mark) + (with-accessors ((lines lines)) view + (let ((low-index 0) + (high-index (nb-elements lines))) + ;; Binary search for the start of changed lines. + (loop while (< low-index high-index) + do (let* ((middle (floor (+ low-index high-index) 2)) + (line-start (start-mark (element* lines middle)))) + (cond ((mark> low-mark line-start) + (setf low-index (1+ middle))) + (t + (setf high-index middle))))) + ;; Discard lines that have to be re-analyzed. + (loop while (and (< low-index (nb-elements lines)) + (mark<= (start-mark (element* lines low-index)) + high-mark)) + do (delete* lines low-index)) + ;; Analyze new lines. + (loop while (mark<= low-mark high-mark) + for i from low-index + do (progn (let ((line-start-mark (clone-mark low-mark))) + (insert* lines i (make-instance + 'buffer-line + :start-mark line-start-mark + :line-length (- (offset (end-of-line low-mark)) + (offset line-start-mark)))) + (if (end-of-buffer-p low-mark) + (loop-finish) + ;; skip newline + (forward-object low-mark)))))))))) + (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))) + (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))) + +;;; Exploit the stored line information. + +(defun offset-in-line-p (line offset) + "Return true if `offset' is in the buffer region delimited by +`line'." + (<= (offset (start-mark line)) offset + (end-offset line))) + +(defun line-containing-offset (view mark-or-offset) + "Return the line `mark-or-offset' is in for `view'. `View' +must be a `drei-buffer-view'." + ;; Perform binary search looking for line containing `offset1'. + (as-offsets ((offset mark-or-offset)) + (with-accessors ((lines lines)) view + (loop with low-index = 0 + with high-index = (nb-elements lines) + for middle = (floor (+ low-index high-index) 2) + for this-line = (element* lines middle) + for line-start = (start-mark this-line) + do (cond ((offset-in-line-p this-line offset) + (loop-finish)) + ((mark> offset line-start) + (setf low-index (1+ middle))) + ((mark< offset line-start) + (setf high-index middle))) + finally (return this-line))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Syntax views (defclass drei-syntax-view (drei-buffer-view) ((%syntax :accessor syntax

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv23082/Apps/Inspector Modified Files: inspector.lisp Log Message: Flayed Fundamental syntax, most of what it used to do is now done by the drei-buffer-view directly. --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/03 23:42:01 1.42 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:50:04 1.43 @@ -47,7 +47,7 @@ :display-function 'display-app) (int :interactor :width 600 :height 100 :max-height 100)) (:layouts - (default (vertically () (scrolling () app) int)))) + (default (vertically () (scrolling () app) #+nil int)))) (defmethod initialize-instance :after ((frame inspector) &rest args) (declare (ignore args))

1 0

[mcclim-cvs] CVS mcclim-website
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim-website In directory clnet:/tmp/cvs-serv18182 Modified Files: index.html Log Message: Some more Google-optimisation. --- /project/mcclim/cvsroot/mcclim-website/index.html 2008/02/05 13:00:32 1.4 +++ /project/mcclim/cvsroot/mcclim-website/index.html 2008/02/11 19:26:32 1.5 @@ -1,15 +1,20 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> - <title>McCLIM</title> + <title>McCLIM - A powerful GUI toolkit for Common Lisp</title> <link rel="stylesheet" type="text/css" href="mcclim.css"> + <meta name="keywords" content="Common Lisp, Lisp, CLIM, McCLIM, + GUI" /> + <meta name="description" content="The project page for an +implementation of CLIM, a GUI toolkit written in, and for, Common +Lisp." /> </head> <body> <br> <center> <img src="McCLIM-3.png"> - <h1>Welcome</h1> + <h1>A GUI toolkit for Common Lisp</h1> </center> <div class="link-sidebar"> @@ -140,7 +145,7 @@ </div> <br> <hr> -$Date: 2008/02/05 13:00:32 $ +$Date: 2008/02/11 19:26:32 $

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 10 Feb '08

10 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv32363/Drei Modified Files: lisp-syntax.lisp lr-syntax.lisp Log Message: Added notion of "sticky" highlighting rules to LR syntax. Used this to add syntax highlighting for reader conditionals in Lisp syntax. Has instant gratification - faster than SLIME! (Ok, we cheat, and can just look at the running Lisp, but anyway.) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/31 18:44:36 1.73 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/02/10 00:42:03 1.74 @@ -994,7 +994,8 @@ ;;;;;;;;;;;;;;;; Reader conditionals ;;; parse trees -(defclass reader-conditional-form (form) ()) +(defclass reader-conditional-form (form) + ((%conditional-true-p :accessor conditional-true-p))) (defclass reader-conditional-positive-form (reader-conditional-form) ()) (defclass reader-conditional-negative-form (reader-conditional-form) ()) @@ -1833,6 +1834,20 @@ (progn (cache-symbol-info syntax symbol-form) (global-boundp symbol-form)))) +(defun cache-conditional-info (syntax form) + "Cache information about the reader conditional `symbol-form' represents, +so that it can be quickly looked up later." + (setf (conditional-true-p form) + (eval-feature-conditional (second-noncomment (children form)) syntax))) + +(defun reader-conditional-true (syntax form) + "Return true if the reader conditional `form' has a true +condition." + (if (slot-boundp form '%conditional-true-p) + (conditional-true-p form) + (progn (cache-conditional-info syntax form) + (conditional-true-p form)))) + (defun parenthesis-highlighter (view form) "Return the drawing style with which the parenthesis lexeme `form' should be highlighted." @@ -1844,6 +1859,23 @@ +bold-face-drawing-options+ +default-drawing-options+)) +(defun reader-conditional-rule-fn (positive comment-options) + "Return a function for use as a syntax highlighting +rule-generator for reader conditionals. If `positive', the +function will be for positive +reader-conditionals. `Comment-options' is the drawing options +object that will be returned when the conditional is not +fulfilled." + (if positive + #'(lambda (view form) + (if (reader-conditional-true (syntax view) form) + +default-drawing-options+ + (values comment-options t))) + #'(lambda (view form) + (if (not (reader-conditional-true (syntax view) form)) + +default-drawing-options+ + (values comment-options t))))) + (define-syntax-highlighting-rules emacs-style-highlighting (error-lexeme (*error-drawing-options*)) (string-form (*string-drawing-options*)) @@ -1857,18 +1889,29 @@ ((symbol-form-is-boundp (syntax view) form) *special-variable-drawing-options*) (t +default-drawing-options+))))) - (parenthesis-lexeme (:function #'parenthesis-highlighter))) + (parenthesis-lexeme (:function #'parenthesis-highlighter)) + (reader-conditional-positive-form + (:function (reader-conditional-rule-fn t *comment-drawing-options*))) + (reader-conditional-negative-form + (:function (reader-conditional-rule-fn nil *comment-drawing-options*)))) + +(defvar *retro-comment-drawing-options* + (make-drawing-options :face (make-face :ink +dimgray+)) + "The drawing options used for retro-highlighting in Lisp syntax.") (define-syntax-highlighting-rules retro-highlighting (error-symbol (*error-drawing-options*)) (string-form (:options :face +italic-face+)) - (comment (:face :ink +dimgray+)) + (comment (*retro-comment-drawing-options*)) (literal-object-form (:options :function (object-drawer))) (complete-token-form (:function #'(lambda (syntax form) (cond ((symbol-form-is-macrobound-p syntax form) +bold-face-drawing-options+) (t +default-drawing-options+))))) - ;; XXX: Ugh, copied from above. + (reader-conditional-positive-form + (:function (reader-conditional-rule-fn t *retro-comment-drawing-options*))) + (reader-conditional-negative-form + (:function (reader-conditional-rule-fn nil *retro-comment-drawing-options*))) (parenthesis-lexeme (:function #'parenthesis-highlighter))) (defparameter *syntax-highlighting-rules* 'emacs-style-highlighting --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/09 11:14:08 1.16 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/02/10 00:42:03 1.17 @@ -443,7 +443,18 @@ Alternatively, `type' can be any object (usually a dynamically bound symbol), in which case it will be evaluated to get the -drawing options." +drawing options. + +`Type' can also be a list, in which case the first element will +be interpreted as described above, and the remaining elements +will be considered keyword arguments. The following keyword +arguments are supported: + + `:sticky': if true, the syntax highlighting options defined by + this rule will apply to all children as well, effectively + overriding their options. The default is false. For a + `:function', `:sticky' will not work. Instead, return a true + secondary value from the function." (check-type name symbol) `(progn (fmakunbound ',name) @@ -451,18 +462,20 @@ (:method (view (parser-symbol parser-symbol)) nil)) ,@(flet ((make-rule-exp (type args) - (case type - (:face `(let ((options (make-drawing-options :face (make-face ,@args)))) - #'(lambda (view parser-symbol) - (declare (ignore view parser-symbol)) - options))) - (:options `#'(lambda (view parser-symbol) - (declare (ignore view parser-symbol)) - (make-drawing-options ,@args))) - (:function (first args)) - (t `#'(lambda (view parser-symbol) - (declare (ignore view parser-symbol)) - ,type))))) + (let ((actual-type (first (listed type)))) + (destructuring-bind (&key sticky) (rest (listed type)) + (case actual-type + (:face `(let ((options (make-drawing-options :face (make-face ,@args)))) + #'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + (values options ,sticky)))) + (:options `#'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + (values (make-drawing-options ,@args) ,sticky))) + (:function (first args)) + (t `#'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + (values ,actual-type ,sticky)))))))) (loop for (parser-symbol (type . args)) in rules collect `(let ((rule ,(make-rule-exp type args))) (defmethod ,name (view (parser-symbol ,parser-symbol)) @@ -499,6 +512,18 @@ parser-symbol offset drawing-options highlighting-rules) +(defstruct (drawing-options-frame + (:constructor make-drawing-options-frame + (end-offset drawing-options sticky-p)) + (:conc-name frame-)) + "An entry in the drawing options stack maintained by the +`pump-state' structure. `End-offset' is the end buffer offset +for the frame, `drawing-options' is the drawing options that +should be used until that offset, and if `sticky-p' is true it +will not be possible to put other frames on top of this one in +the stack." + end-offset drawing-options sticky-p) + (defmethod pump-state-for-offset-with-syntax ((view textual-drei-syntax-view) (syntax lr-syntax-mixin) (offset integer)) (update-parse syntax 0 (size (buffer view))) @@ -506,15 +531,18 @@ (highlighting-rules (syntax-highlighting-rules syntax))) (labels ((initial-drawing-options (parser-symbol) (if (null parser-symbol) - (cons (size (buffer view)) +default-drawing-options+) - (let ((drawing-options - (get-drawing-options highlighting-rules view parser-symbol))) + (make-drawing-options-frame + (size (buffer view)) +default-drawing-options+ nil) + (multiple-value-bind (drawing-options sticky) + (get-drawing-options highlighting-rules view parser-symbol) (if (null drawing-options) (initial-drawing-options (parent parser-symbol)) - (cons (end-offset parser-symbol) drawing-options)))))) + (make-drawing-options-frame (end-offset parser-symbol) + drawing-options sticky)))))) (make-pump-state parser-symbol offset (list (initial-drawing-options parser-symbol) - (cons (1+ (size (buffer view))) +default-drawing-options+)) + (make-drawing-options-frame + (1+ (size (buffer view))) +default-drawing-options+ nil)) highlighting-rules)))) (defun find-next-stroke-end (view pump-state) @@ -527,15 +555,16 @@ (highlighting-rules pump-state-highlighting-rules)) pump-state (let ((line (line-containing-offset (syntax view) offset))) - (flet ((finish (offset symbol &optional stroke-drawing-options) + (flet ((finish (new-offset symbol &optional stroke-drawing-options sticky-p) (setf start-symbol symbol) - (loop until (> (car (first drawing-options)) offset) - do (pop drawing-options)) (unless (null stroke-drawing-options) - (push (cons (end-offset symbol) stroke-drawing-options) + (push (if (frame-sticky-p (first drawing-options)) + (make-drawing-options-frame + (end-offset symbol) (frame-drawing-options (first drawing-options)) t) + (make-drawing-options-frame + (end-offset symbol) stroke-drawing-options sticky-p)) drawing-options)) - (return-from find-next-stroke-end - offset))) + (return-from find-next-stroke-end new-offset))) (cond ((null start-symbol) ;; This means that all remaining lines are blank. (finish (line-end-offset line) nil)) @@ -543,28 +572,38 @@ (= offset (start-offset start-symbol))) (finish (end-offset start-symbol) start-symbol nil)) (t - (or (do-parse-symbols-forward (symbol offset start-symbol) - (let ((symbol-drawing-options - (get-drawing-options highlighting-rules view symbol))) - (cond ((> (start-offset symbol) (line-end-offset line)) - (finish (line-end-offset line) start-symbol)) - ((and (typep symbol 'literal-object-mixin)) - (finish (start-offset symbol) symbol - (or symbol-drawing-options - (make-drawing-options :function (object-drawer))))) - ((and (> (start-offset symbol) offset) - (not (drawing-options-equal (or symbol-drawing-options - +default-drawing-options+) - (cdr (first drawing-options)))) - (if (null symbol-drawing-options) - (>= (start-offset symbol) (car (first drawing-options))) - t)) - (finish (start-offset symbol) symbol symbol-drawing-options)) - ((and (= (start-offset symbol) offset) - symbol-drawing-options - (not (drawing-options-equal symbol-drawing-options - (cdr (first drawing-options))))) - (finish (start-offset symbol) symbol symbol-drawing-options))))) + (or (let* ((current-frame (first drawing-options)) + (currently-used-options (frame-drawing-options current-frame))) + (do-parse-symbols-forward (symbol offset start-symbol) + (multiple-value-bind (symbol-drawing-options sticky) + (get-drawing-options highlighting-rules view symbol) + ;; Remove frames that are no longer applicable... + (loop until (> (frame-end-offset (first drawing-options)) + (start-offset symbol)) + do (pop drawing-options)) + (let ((options-to-be-used (if (frame-sticky-p (first drawing-options)) + (frame-drawing-options (first drawing-options)) + symbol-drawing-options))) + (cond ((> (start-offset symbol) (line-end-offset line)) + (finish (line-end-offset line) start-symbol)) + ((and (typep symbol 'literal-object-mixin)) + (finish (start-offset symbol) symbol + (or symbol-drawing-options + (make-drawing-options :function (object-drawer))))) + ((and (> (start-offset symbol) offset) + (not (drawing-options-equal (or options-to-be-used + +default-drawing-options+) + currently-used-options)) + (if (null symbol-drawing-options) + (>= (start-offset symbol) (frame-end-offset current-frame)) + t)) + (finish (start-offset symbol) symbol symbol-drawing-options sticky)) + ((and (= (start-offset symbol) offset) + symbol-drawing-options + (not (drawing-options-equal + options-to-be-used + (frame-drawing-options (first drawing-options))))) + (finish (start-offset symbol) symbol symbol-drawing-options sticky))))))) ;; If there are no more parse symbols, we just go ;; line-by-line from here. This should mean that all ;; remaining lines are blank. @@ -578,11 +617,15 @@ (with-accessors ((offset pump-state-offset) (current-drawing-options pump-state-drawing-options)) pump-state - (let ((old-drawing-options (cdr (first current-drawing-options))) - (end-offset (find-next-stroke-end view pump-state))) + (let ((old-drawing-options (frame-drawing-options (first current-drawing-options))) + (end-offset (find-next-stroke-end view pump-state)) + (old-offset offset)) (setf (stroke-start-offset stroke) offset (stroke-end-offset stroke) end-offset (stroke-drawing-options stroke) old-drawing-options offset (if (offset-end-of-line-p (buffer view) end-offset) (1+ end-offset) - end-offset)))))) + end-offset)) + ;; Don't use empty strokes, try again... + (when (= old-offset offset) + (stroke-pump-with-syntax view syntax stroke pump-state))))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 08 Feb '08

08 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv6421/Drei Modified Files: syntax.lisp Log Message: Fixed command table inheritance so syntax modes take precedence over the syntax itself. --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/30 11:48:40 1.17 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/02/08 18:37:32 1.18 @@ -43,7 +43,7 @@ (defgeneric syntax-command-tables (syntax) (:documentation "Returns additional command tables provided by `syntax'.") - (:method-combination append) + (:method-combination append :most-specific-last) (:method append ((syntax syntax)) (list (command-table syntax))))

1 0