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

Modified Files: base.lisp drei-redisplay.lisp fundamental-syntax.lisp lr-syntax.lisp packages.lisp views.lisp Log Message: Connect redisplay to syntax information.

Currently, the necessary methods are only implemented for Fundamental syntax, so there is still no syntax highlighting. There is, however, a 30-40% performance increase in redisplay, as Fundamental syntax is much better at keeping track of buffer contents than the hack I wrote for drei-buffer-view.

--- /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2007/12/27 13:39:25 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2008/01/02 14:43:40 1.9 @@ -381,6 +381,56 @@ *kill-ring* (region-to-sequence mark1 mark2)) (delete-region mark1 mark2))

+(defun in-place-buffer-substring (buffer string offset1 offset2) + "Copy from `offset1' to `offset2' in `buffer' to `string', +which must be an adjustable vector of characters with a fill +pointer. All objects in the buffer range must be +characters. Returns `string'." + (loop for offset from offset1 below offset2 + for i upfrom 0 + do (vector-push-extend (buffer-object buffer offset) string) + finally (return string))) + +(defun fill-string-from-buffer (buffer string offset1 offset2) + "Copy from `offset1' to `offset2' in `buffer' to `string', +which must be an adjustable vector of characters with a fill +pointer. Once the buffer region has been copied to `string', or a +non-character object has been encountered in the buffer, the +number of characters copied to `string' will be returned." + (loop for offset from offset1 below offset2 + for i upfrom 0 + if (characterp (buffer-object buffer offset)) + do (vector-push-extend (buffer-object buffer offset) string) + else do (loop-finish) + finally (return i))) + +(defun buffer-find-nonchar (buffer start-offset max-offset) + "Search through `buffer' from `start-offset', returning the +first offset at which a non-character object is found, or +`max-offset', whichever comes first." + (loop for offset from start-offset below max-offset + unless (characterp (buffer-object buffer offset)) + do (loop-finish) + finally (return offset))) + +(defun offset-beginning-of-line-p (buffer offset) + "Return true if `offset' is at the beginning of a line in +`buffer' or at the beginning of `buffer'." + (or (zerop offset) (eql (buffer-object buffer (1- offset)) #\Newline))) + +(defun offset-end-of-line-p (buffer offset) + "Return true if `offset' is at the end of a line in +`buffer' or at the end of `buffer'." + (or (= (size buffer) offset) + (eql (buffer-object buffer offset) #\Newline))) + +(defun end-of-line-offset (buffer start-offset) + "Return the offset of the end of the line of `buffer' +containing `start-offset'." + (loop for offset from start-offset + until (offset-end-of-line-p buffer offset) + finally (return offset))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Character case --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/02 10:03:02 1.16 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/02 14:43:40 1.17 @@ -80,8 +80,7 @@ applicable. This method will only be called by the Drei redisplay engine when the cursor is active and the buffer position it refers to is on display - therefore, `offset-to-screen-position' -is *guaranteed* to not return NIL or T. This function will return -either the output record of the cursor, or NIL.") +is *guaranteed* to not return NIL or T.") (:method :around ((stream extended-output-stream) (view drei-view) (cursor drei-cursor)) (when (visible cursor view) @@ -198,40 +197,59 @@ (:documentation "Return a pump state that will enable pumping strokes from `offset' in the buffer of `view' (via `stroke-pump'). The pump state is not guaranteed to be valid past -the next call to `stroke-pump' or `synchronize-view'.")) +the next call to `stroke-pump' or `synchronize-view'. The results +are undefined if `offset' is not at the beginning of a line.") + (:method ((view drei-syntax-view) (offset integer)) + (pump-state-for-offset-with-syntax view (syntax view) offset)))

(defgeneric stroke-pump (view stroke pump-state) - (:documentation "Put stroke information in `stroke'. Returns -new pump-state.")) - -(defun in-place-buffer-substring (buffer string offset1 offset2) - "Copy from `offset1' to `offset2' in `buffer' to `string', -which must be an adjustable vector of characters with a fill -pointer. All objects in the buffer range must be -characters. Returns `string'." - (loop for offset from offset1 below offset2 - for i upfrom 0 - do (vector-push-extend (buffer-object buffer offset) string) - finally (return string))) - -(defun fill-string-from-buffer (buffer string offset1 offset2) - "Copy from `offset1' to `offset2' in `buffer' to `string', -which must be an adjustable vector of characters with a fill -pointer. Once the buffer region has been copied to `string', or a -non-character object has been encountered in the buffer, the -number of characters copied to `string' will be returned." - (loop for offset from offset1 below offset2 - for i upfrom 0 - if (characterp (buffer-object buffer offset)) - do (vector-push-extend (buffer-object buffer offset) string) - else do (loop-finish) - finally (return i))) + (:documentation "Put stroke information in `stroke', returns +new pump-state. `Pump-state' must either be the result of a call +to `pump-state-for-offset' or be the return value of an earlier +call to `stroke-pump'. A pump state is not guaranteed to be +valid past the next call to `stroke-pump' or +`synchronize-view'. It is permissible for `pump-state' to be +destructively modified by this function.") + (:method :around ((view drei-buffer-view) stroke pump-state) + ;; `call-next-method' for the next pump state, and compare + ;; the new stroke data with the old one. If it has changed, + ;; mark the stroke as dirty and modified. + (let ((old-start-offset (stroke-start-offset stroke)) + (old-end-offset (stroke-end-offset stroke)) + (old-drawing-options (stroke-drawing-options stroke)) + (new-pump-state (call-next-method))) + (unless (and old-start-offset + (= old-start-offset (stroke-start-offset stroke)) + (= old-end-offset (stroke-end-offset stroke)) + (drawing-options-equal old-drawing-options + (stroke-drawing-options stroke))) + (invalidate-stroke stroke :modified t)) + new-pump-state)) + (:method ((view drei-syntax-view) stroke pump-state) + (stroke-pump-with-syntax view (syntax view) stroke pump-state)))

(defun clear-rectangle* (stream x1 y1 x2 y2) "Draw on `stream' from (x1,y1) to (x2,y2) with the background ink for the stream." (draw-rectangle* stream x1 y1 x2 y2 :ink +background-ink+))

+(defun invalidate-stroke (stroke &key modified cleared) + "Invalidate `stroke' by setting its dirty-bit to true. If +`modified' or `cleared' is true, also set the modified-bit to +true. If `cleared' is true, inform the stroke that its previous +output has been cleared by someone, and that it does not need to +clear it itself during its next redisplay." + (setf (stroke-dirty stroke) t + (stroke-modified stroke) + (or (stroke-modified stroke) + modified + cleared)) + (when cleared + (setf (x1 (stroke-dimensions stroke)) 0 + (y1 (stroke-dimensions stroke)) 0 + (x2 (stroke-dimensions stroke)) 0 + (y2 (stroke-dimensions stroke)) 0))) + (defun invalidate-line-strokes (line &key modified cleared) "Invalidate all the strokes of `line' by setting their dirty-bit to true. If `modified' or `cleared' is true, also set @@ -240,17 +258,8 @@ and that they do not need to clear it themselves during their next redisplay." (loop for stroke across (line-strokes line) - do (setf (stroke-dirty stroke) t - (stroke-modified stroke) - (or (stroke-modified stroke) - modified - cleared)) - when cleared - do (let ((dimensions (stroke-dimensions stroke))) - (setf (x1 dimensions) 0 - (y1 dimensions) 0 - (x2 dimensions) 0 - (y2 dimensions) 0)))) + do (invalidate-stroke stroke :modified modified + :cleared cleared)))

(defun invalidate-all-strokes (view &key modified cleared) "Invalidate all the strokes of `view' by setting their @@ -560,33 +569,6 @@ the buffer determining where the next stroke should start." offset)

-(defun buffer-find-nonchar (buffer start-offset max-offset) - "Search through `buffer' from `start-offset', returning the -first offset at which a non-character object is found, or -`max-offset', whichever comes first." - (loop for offset from start-offset below max-offset - unless (characterp (buffer-object buffer offset)) - do (loop-finish) - finally (return offset))) - -(defun offset-beginning-of-line-p (buffer offset) - "Return true if `offset' is at the beginning of a line in -`buffer' or at the beginning of `buffer'." - (or (zerop offset) (eql (buffer-object buffer (1- offset)) #\Newline))) - -(defun offset-end-of-line-p (buffer offset) - "Return true if `offset' is at the end of a line in -`buffer' or at the end of `buffer'." - (or (= (size buffer) offset) - (eql (buffer-object buffer offset) #\Newline))) - -(defun end-of-line-offset (buffer start-offset) - "Return the offset of the end of the line of `buffer' -containing `start-offset'." - (loop for offset from start-offset - until (offset-end-of-line-p buffer offset) - finally (return 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 @@ -617,16 +599,9 @@ (actual-end-offset (if (functionp (cdr chunk)) (1+ (car chunk)) (cdr chunk)))) - (unless (and (stroke-start-offset stroke) - (= (stroke-start-offset stroke) (car chunk)) - (= (stroke-end-offset stroke) actual-end-offset) - (drawing-options-equal (stroke-drawing-options stroke) - drawing-options)) - (setf (stroke-start-offset stroke) (car chunk) - (stroke-end-offset stroke) actual-end-offset - (stroke-modified stroke) t - (stroke-dirty stroke) t - (stroke-drawing-options stroke) drawing-options)) + (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))) @@ -673,7 +648,6 @@ the end of the buffer."))

(defmethod offset-to-screen-position ((pane clim-stream-pane) (view drei-view) (offset number)) - (declare (optimize (debug 3))) (flet ((worker () (do-displayed-lines (line view) (when (<= (line-start-offset line) offset (line-end-offset line)) @@ -728,33 +702,29 @@ (view drei-buffer-view) (cursor drei-cursor)) (when (<= (offset (top view)) (offset (mark cursor)) (offset (bot view))) - (let ((cursor-output-record (call-next-method))) - (when cursor-output-record - (with-bounding-rectangle* (x1 y1 x2 y2) cursor-output-record - (do-displayed-lines (line view) - (cond ((> (y1 (line-dimensions line)) y2) - (return)) - ((coordinates-intersects-dimensions - (line-dimensions line) x1 y1 x2 y2) - (block stroke-loop - (do-displayed-line-strokes (stroke line) - (cond ((> (x1 (stroke-dimensions stroke)) x2) - (return-from stroke-loop)) - ((coordinates-intersects-dimensions - (stroke-dimensions stroke) x1 y1 x2 y2) - (setf (stroke-dirty stroke) t) - (setf (stroke-modified stroke) t))))))))))))) + (clear-output-record cursor) + (prog1 (call-next-method) + (with-bounding-rectangle* (x1 y1 x2 y2) cursor + (do-displayed-lines (line view) + (cond ((> (y1 (line-dimensions line)) y2) + (return)) + ((coordinates-intersects-dimensions + (line-dimensions line) x1 y1 x2 y2) + (block stroke-loop + (do-displayed-line-strokes (stroke line) + (cond ((> (x1 (stroke-dimensions stroke)) x2) + (return-from stroke-loop)) + ((coordinates-intersects-dimensions + (stroke-dimensions stroke) x1 y1 x2 y2) + (setf (stroke-dirty stroke) t) + (setf (stroke-modified stroke) t))))))))))))

(defmethod display-drei-view-cursor ((stream extended-output-stream) (view drei-buffer-view) (cursor drei-cursor)) (multiple-value-bind (cursor-x cursor-y line-height object-width) (offset-to-screen-position stream view (offset (mark cursor))) - (updating-output (stream :unique-id (list* stream view cursor) - :id-test #'equal - :cache-value (list* cursor-x cursor-y line-height object-width) - :cache-test #'equal - :all-new t) + (letf (((stream-current-output-record stream) cursor)) (draw-rectangle* stream cursor-x cursor-y (+ cursor-x object-width) (+ cursor-y line-height) @@ -917,7 +887,6 @@ (change-space-requirements pane :width output-width))))

(defmethod fix-pane-viewport :after ((pane drei-pane) (view point-mark-view)) - (declare (optimize (debug 3))) (when (and (pane-viewport pane) (active pane)) (multiple-value-bind (cursor-x cursor-y line-height object-width) (offset-to-screen-position pane view (offset (point view))) --- /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2007/12/08 08:53:50 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/fundamental-syntax.lisp 2008/01/02 14:43:40 1.8 @@ -34,7 +34,8 @@ ;;; The syntax object and misc stuff.

(define-syntax fundamental-syntax (syntax) - ((lines :initform (make-instance 'standard-flexichain)) + ((lines :initform (make-instance 'standard-flexichain) + :reader lines) (scan :accessor scan)) (:command-table fundamental-table) (:name "Fundamental")) @@ -51,24 +52,54 @@ ;;; update syntax

(defclass line-object () - ((start-mark :initarg :start-mark :reader start-mark))) - -(defmethod update-syntax-for-display (buffer (syntax fundamental-syntax) top bot) - nil) + ((%start-mark :reader start-mark + :initarg :start-mark) + (%chunks :accessor chunks + :initform (make-array 5 + :adjustable t + :fill-pointer 0)))) + +(defun get-chunk (buffer chunk-start-offset 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 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 nil)) + ((not (characterp (buffer-object buffer chunk-end-offset))) + (cons (1+ chunk-end-offset) t))))) + +(defmethod initialize-instance :after ((line line-object) + &rest initargs) + (declare (ignore initargs)) + (loop with buffer = (buffer (start-mark line)) + with chunk-start-offset = (offset (start-mark line)) + with line-end-offset = (end-of-line-offset buffer (offset (start-mark line))) + for chunk-info = (get-chunk (buffer (start-mark line)) + chunk-start-offset line-end-offset) + do (vector-push-extend chunk-info (chunks line)) + (setf chunk-start-offset (car chunk-info)) + when (= chunk-start-offset line-end-offset) + do (loop-finish)))

(defmethod update-syntax ((syntax fundamental-syntax) prefix-size suffix-size &optional begin end) (declare (ignore begin end)) - (let ((low-mark (clone-mark (scan syntax) :left)) - (high-mark (clone-mark (scan syntax) :left))) - (setf (offset low-mark) prefix-size - (offset high-mark) (- (size (buffer syntax)) suffix-size)) + (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)))) @@ -76,139 +107,91 @@ (setf low-index (1+ middle))) (t (setf high-index middle))))) - ;; discard lines that have to be re-analyzed + ;; 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 + ;; Analyze new lines. (setf (offset scan) (offset low-mark)) - (loop while (and (mark<= scan high-mark) - (not (end-of-buffer-p scan))) + (loop while (mark<= scan high-mark) for i from low-index do (progn (insert* lines i (make-instance 'line-object :start-mark (clone-mark scan))) (end-of-line scan) - (unless (end-of-buffer-p scan) - ;; skip newline - (forward-object scan))))))))) + (if (end-of-buffer-p scan) + (loop-finish) + ;; skip newline + (forward-object scan))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; display

-(defvar *white-space-start* nil) - -(defvar *current-line* 0) - -(defun handle-whitespace (pane view buffer start end) - (let ((space-width (space-width pane view)) - (tab-width (tab-width pane view))) - (with-sheet-medium (medium pane) - (with-accessors ((cursor-positions cursor-positions)) view - (loop while (< start end) - do (case (buffer-object buffer start) - (#\Newline (record-line-vertical-offset pane view (incf *current-line*)) - (terpri pane) - (stream-increment-cursor-position - pane (first (aref cursor-positions 0)) 0)) - ((#\Page #\Return #\Space) (stream-increment-cursor-position - pane space-width 0)) - (#\Tab (when (plusp tab-width) - (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0))))) - (incf start)))))) - -(defmethod display-line ((stream clim-stream-pane) (view textual-drei-syntax-view) mark) - (let ((mark (clone-mark mark))) - (let ((saved-offset nil) - (id 0) - (space-width (space-width stream view)) - (tab-width (tab-width stream view))) - (flet ((output-word () - (unless (null saved-offset) - (let ((contents (coerce (region-to-sequence - saved-offset - mark) - 'string))) - (updating-output (stream :unique-id (cons view (incf id)) - :id-test #'equal - :cache-value contents - :cache-test #'equal) - (unless (null contents) - (present contents 'string :stream stream)))) - (setf saved-offset nil)))) - (loop - until (end-of-line-p mark) - do (let ((obj (object-after mark))) - (cond ((eql obj #\Space) - (output-word) - (stream-increment-cursor-position stream space-width 0)) - ((eql obj #\Tab) - (output-word) - (let ((x (stream-cursor-position stream))) - (stream-increment-cursor-position - stream (- tab-width (mod x tab-width)) 0))) - ((constituentp obj) - (when (null saved-offset) - (setf saved-offset (offset mark)))) - ((characterp obj) - (output-word) - (updating-output (stream :unique-id (cons stream (incf id)) - :id-test #'equal - :cache-value obj) - (present obj 'character :stream stream))) - (t - (output-word) - (updating-output (stream :unique-id (cons stream (incf id)) - :id-test #'equal - :cache-value obj - :cache-test #'eq) - (present obj (presentation-type-of obj) - :stream stream))))) - do (forward-object mark) - finally - (output-word) - (unless (end-of-buffer-p mark) - (terpri stream))))))) - -(defmethod display-syntax-view ((stream clim-stream-pane) (view textual-drei-syntax-view) - (syntax fundamental-syntax)) - (update-parse syntax) - (with-accessors ((top top) (bot bot)) view - (with-accessors ((cursor-positions cursor-positions)) view - (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot)) - :initial-element nil - :fill-pointer 1 - :adjustable t) - *current-line* 0 - (aref cursor-positions 0) (multiple-value-list (stream-cursor-position stream)))) - (setf *white-space-start* (offset top)) - (with-slots (lines scan) syntax - (let ((low-index 0) - (high-index (nb-elements 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> top line-start) - (setf low-index (1+ middle))) - ((mark< top line-start) - (setf high-index middle)) - (t - (setf low-index middle - high-index middle))))) - (loop for i from low-index - while (and (< i (nb-elements lines)) - (mark< (start-mark (element* lines i)) - bot)) - do (let ((line (element* lines i))) - (updating-output (stream :unique-id (cons view i) - :id-test #'equal - :cache-value line - :cache-test #'equal) - (display-line stream view (start-mark (element* lines i)))))))))) +(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) + +(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 + (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, or a function, in which case it is +the drawing function for a single-object non-character chunk." + (destructuring-bind (chunk-end-offset . objectp) + (aref (chunks line) chunk-index) + (if objectp (object-drawer) chunk-end-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 + (update-parse syntax 0 offset) + (let* ((chunk (fetch-chunk + (element* (lines syntax) 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))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/12/19 17:17:37 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/02 14:43:40 1.6 @@ -294,6 +294,7 @@ (defmethod update-syntax ((syntax lr-syntax-mixin) prefix-size suffix-size &optional begin end) (declare (ignore begin end)) + (call-next-method) (let* ((low-mark-offset prefix-size) (high-mark-offset (- (size (buffer syntax)) suffix-size))) (when (<= low-mark-offset high-mark-offset) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/01 18:43:36 1.28 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/02 14:43:40 1.29 @@ -105,6 +105,12 @@ #:just-n-spaces #:move-to-column #:kill-region + #:in-place-buffer-substring + #:fill-string-from-buffer + #:buffer-find-nonchar + #:offset-beginning-of-line-p + #:offset-end-of-line-p + #:end-of-line-offset #:buffer-whitespacep #:buffer-region-case #:buffer-looking-at #:looking-at @@ -211,6 +217,8 @@ #:drei-view #:modified-p #:no-cursors #:drei-buffer-view #:buffer #:top #:bot #:drei-syntax-view #:syntax + #:pump-state-for-offset-with-syntax + #:stroke-pump-with-syntax #:point-mark-view #:textual-drei-syntax-view #:tab-space-count #:space-width #:tab-width #:use-tabs @@ -243,8 +251,17 @@ #:drei #:drei-pane #:drei-gadget-pane #:drei-area #:handling-drei-conditions #:handle-drei-condition #:execute-drei-command - #:display-drei-view-contents #:display-syntax-view - #:display-drei-view-cursor + #:display-drei-view-contents #:display-drei-view-cursor + + #:face #:make-face #:face-ink #:face-style + #:drawing-options #:make-drawing-options + #:drawing-options-face #:drawing-options-function + #:drawing-options-equal #:+default-drawing-options+ + #:stroke-start-offset #:stroke-end-offset + #:stroke-drawing-options + + #:pump-state-for-offset #:stroke-pump + #:object-drawer #:*maximum-chunk-size* #:with-drei-options #:performing-drei-operations #:invoke-performing-drei-operations #:with-bound-drei-special-variables --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/01 18:43:36 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/02 14:43:40 1.10 @@ -683,6 +683,25 @@ (synchronize-view view :begin begin :end end))) args))

+(defgeneric pump-state-for-offset-with-syntax (view syntax offset) + (:documentation "Return a pump state that will enable pumping +strokes from `offset' in the buffer of `view' as specified by +`syntax' (via `stroke-pump-for-syntax'). The pump state is not +guaranteed to be valid past the next call to +`stroke-pump-for-syntax' or `synchronize-view'. The results are +undefined if `offset' is not at the beginning of a line.")) + +(defgeneric stroke-pump-with-syntax (view syntax stroke pump-state) + (:documentation "Put stroke information in `stroke' as +specified by `syntax', returns new pump-state. `Pump-state' must +either be the result of a call to +`pump-state-for-offset-with-syntax' or be the return value of an +earlier call to `stroke-pump-with-syntax'. A pump state is not +guaranteed to be valid past the next call to +`stroke-pump-with-syntax' or `synchronize-view'. It is +permissible for `pump-state' to be destructively modified by this +function.")) + (defclass point-mark-view (drei-buffer-view) ((%point :initform nil :initarg :point :accessor point-of) (%mark :initform nil :initarg :mark :accessor mark-of))