[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Wed Jan 2 14:43:40 UTC 2008
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))
More information about the Mcclim-cvs
mailing list