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