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