[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Mon Feb 11 23:05:24 UTC 2008
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
More information about the Mcclim-cvs
mailing list