mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 11 Feb '08

11 Feb '08

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

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv23316/Apps/Inspector Modified Files: inspector.lisp Log Message: Once again accidentally committed local debugging hack... --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:50:04 1.43 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:51:42 1.44 @@ -47,7 +47,7 @@ :display-function 'display-app) (int :interactor :width 600 :height 100 :max-height 100)) (:layouts - (default (vertically () (scrolling () app) #+nil int)))) + (default (vertically () (scrolling () app) int)))) (defmethod initialize-instance :after ((frame inspector) &rest args) (declare (ignore args))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 11 Feb '08

11 Feb '08

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

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv23082/Apps/Inspector Modified Files: inspector.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/Apps/Inspector/inspector.lisp 2008/02/03 23:42:01 1.42 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2008/02/11 22:50:04 1.43 @@ -47,7 +47,7 @@ :display-function 'display-app) (int :interactor :width 600 :height 100 :max-height 100)) (:layouts - (default (vertically () (scrolling () app) int)))) + (default (vertically () (scrolling () app) #+nil int)))) (defmethod initialize-instance :after ((frame inspector) &rest args) (declare (ignore args))

1 0

[mcclim-cvs] CVS mcclim-website
by thenriksen 11 Feb '08

11 Feb '08

Update of /project/mcclim/cvsroot/mcclim-website In directory clnet:/tmp/cvs-serv18182 Modified Files: index.html Log Message: Some more Google-optimisation. --- /project/mcclim/cvsroot/mcclim-website/index.html 2008/02/05 13:00:32 1.4 +++ /project/mcclim/cvsroot/mcclim-website/index.html 2008/02/11 19:26:32 1.5 @@ -1,15 +1,20 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> - <title>McCLIM</title> + <title>McCLIM - A powerful GUI toolkit for Common Lisp</title> <link rel="stylesheet" type="text/css" href="mcclim.css"> + <meta name="keywords" content="Common Lisp, Lisp, CLIM, McCLIM, + GUI" /> + <meta name="description" content="The project page for an +implementation of CLIM, a GUI toolkit written in, and for, Common +Lisp." /> </head> <body> <br> <center> <img src="McCLIM-3.png"> - <h1>Welcome</h1> + <h1>A GUI toolkit for Common Lisp</h1> </center> <div class="link-sidebar"> @@ -140,7 +145,7 @@ </div> <br> <hr> -$Date: 2008/02/05 13:00:32 $ +$Date: 2008/02/11 19:26:32 $

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 10 Feb '08

10 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv32363/Drei Modified Files: lisp-syntax.lisp lr-syntax.lisp Log Message: Added notion of "sticky" highlighting rules to LR syntax. Used this to add syntax highlighting for reader conditionals in Lisp syntax. Has instant gratification - faster than SLIME! (Ok, we cheat, and can just look at the running Lisp, but anyway.) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/31 18:44:36 1.73 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/02/10 00:42:03 1.74 @@ -994,7 +994,8 @@ ;;;;;;;;;;;;;;;; Reader conditionals ;;; parse trees -(defclass reader-conditional-form (form) ()) +(defclass reader-conditional-form (form) + ((%conditional-true-p :accessor conditional-true-p))) (defclass reader-conditional-positive-form (reader-conditional-form) ()) (defclass reader-conditional-negative-form (reader-conditional-form) ()) @@ -1833,6 +1834,20 @@ (progn (cache-symbol-info syntax symbol-form) (global-boundp symbol-form)))) +(defun cache-conditional-info (syntax form) + "Cache information about the reader conditional `symbol-form' represents, +so that it can be quickly looked up later." + (setf (conditional-true-p form) + (eval-feature-conditional (second-noncomment (children form)) syntax))) + +(defun reader-conditional-true (syntax form) + "Return true if the reader conditional `form' has a true +condition." + (if (slot-boundp form '%conditional-true-p) + (conditional-true-p form) + (progn (cache-conditional-info syntax form) + (conditional-true-p form)))) + (defun parenthesis-highlighter (view form) "Return the drawing style with which the parenthesis lexeme `form' should be highlighted." @@ -1844,6 +1859,23 @@ +bold-face-drawing-options+ +default-drawing-options+)) +(defun reader-conditional-rule-fn (positive comment-options) + "Return a function for use as a syntax highlighting +rule-generator for reader conditionals. If `positive', the +function will be for positive +reader-conditionals. `Comment-options' is the drawing options +object that will be returned when the conditional is not +fulfilled." + (if positive + #'(lambda (view form) + (if (reader-conditional-true (syntax view) form) + +default-drawing-options+ + (values comment-options t))) + #'(lambda (view form) + (if (not (reader-conditional-true (syntax view) form)) + +default-drawing-options+ + (values comment-options t))))) + (define-syntax-highlighting-rules emacs-style-highlighting (error-lexeme (*error-drawing-options*)) (string-form (*string-drawing-options*)) @@ -1857,18 +1889,29 @@ ((symbol-form-is-boundp (syntax view) form) *special-variable-drawing-options*) (t +default-drawing-options+))))) - (parenthesis-lexeme (:function #'parenthesis-highlighter))) + (parenthesis-lexeme (:function #'parenthesis-highlighter)) + (reader-conditional-positive-form + (:function (reader-conditional-rule-fn t *comment-drawing-options*))) + (reader-conditional-negative-form + (:function (reader-conditional-rule-fn nil *comment-drawing-options*)))) + +(defvar *retro-comment-drawing-options* + (make-drawing-options :face (make-face :ink +dimgray+)) + "The drawing options used for retro-highlighting in Lisp syntax.") (define-syntax-highlighting-rules retro-highlighting (error-symbol (*error-drawing-options*)) (string-form (:options :face +italic-face+)) - (comment (:face :ink +dimgray+)) + (comment (*retro-comment-drawing-options*)) (literal-object-form (:options :function (object-drawer))) (complete-token-form (:function #'(lambda (syntax form) (cond ((symbol-form-is-macrobound-p syntax form) +bold-face-drawing-options+) (t +default-drawing-options+))))) - ;; XXX: Ugh, copied from above. + (reader-conditional-positive-form + (:function (reader-conditional-rule-fn t *retro-comment-drawing-options*))) + (reader-conditional-negative-form + (:function (reader-conditional-rule-fn nil *retro-comment-drawing-options*))) (parenthesis-lexeme (:function #'parenthesis-highlighter))) (defparameter *syntax-highlighting-rules* 'emacs-style-highlighting --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/09 11:14:08 1.16 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/02/10 00:42:03 1.17 @@ -443,7 +443,18 @@ Alternatively, `type' can be any object (usually a dynamically bound symbol), in which case it will be evaluated to get the -drawing options." +drawing options. + +`Type' can also be a list, in which case the first element will +be interpreted as described above, and the remaining elements +will be considered keyword arguments. The following keyword +arguments are supported: + + `:sticky': if true, the syntax highlighting options defined by + this rule will apply to all children as well, effectively + overriding their options. The default is false. For a + `:function', `:sticky' will not work. Instead, return a true + secondary value from the function." (check-type name symbol) `(progn (fmakunbound ',name) @@ -451,18 +462,20 @@ (:method (view (parser-symbol parser-symbol)) nil)) ,@(flet ((make-rule-exp (type args) - (case type - (:face `(let ((options (make-drawing-options :face (make-face ,@args)))) - #'(lambda (view parser-symbol) - (declare (ignore view parser-symbol)) - options))) - (:options `#'(lambda (view parser-symbol) - (declare (ignore view parser-symbol)) - (make-drawing-options ,@args))) - (:function (first args)) - (t `#'(lambda (view parser-symbol) - (declare (ignore view parser-symbol)) - ,type))))) + (let ((actual-type (first (listed type)))) + (destructuring-bind (&key sticky) (rest (listed type)) + (case actual-type + (:face `(let ((options (make-drawing-options :face (make-face ,@args)))) + #'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + (values options ,sticky)))) + (:options `#'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + (values (make-drawing-options ,@args) ,sticky))) + (:function (first args)) + (t `#'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + (values ,actual-type ,sticky)))))))) (loop for (parser-symbol (type . args)) in rules collect `(let ((rule ,(make-rule-exp type args))) (defmethod ,name (view (parser-symbol ,parser-symbol)) @@ -499,6 +512,18 @@ parser-symbol offset drawing-options highlighting-rules) +(defstruct (drawing-options-frame + (:constructor make-drawing-options-frame + (end-offset drawing-options sticky-p)) + (:conc-name frame-)) + "An entry in the drawing options stack maintained by the +`pump-state' structure. `End-offset' is the end buffer offset +for the frame, `drawing-options' is the drawing options that +should be used until that offset, and if `sticky-p' is true it +will not be possible to put other frames on top of this one in +the stack." + end-offset drawing-options sticky-p) + (defmethod pump-state-for-offset-with-syntax ((view textual-drei-syntax-view) (syntax lr-syntax-mixin) (offset integer)) (update-parse syntax 0 (size (buffer view))) @@ -506,15 +531,18 @@ (highlighting-rules (syntax-highlighting-rules syntax))) (labels ((initial-drawing-options (parser-symbol) (if (null parser-symbol) - (cons (size (buffer view)) +default-drawing-options+) - (let ((drawing-options - (get-drawing-options highlighting-rules view parser-symbol))) + (make-drawing-options-frame + (size (buffer view)) +default-drawing-options+ nil) + (multiple-value-bind (drawing-options sticky) + (get-drawing-options highlighting-rules view parser-symbol) (if (null drawing-options) (initial-drawing-options (parent parser-symbol)) - (cons (end-offset parser-symbol) drawing-options)))))) + (make-drawing-options-frame (end-offset parser-symbol) + drawing-options sticky)))))) (make-pump-state parser-symbol offset (list (initial-drawing-options parser-symbol) - (cons (1+ (size (buffer view))) +default-drawing-options+)) + (make-drawing-options-frame + (1+ (size (buffer view))) +default-drawing-options+ nil)) highlighting-rules)))) (defun find-next-stroke-end (view pump-state) @@ -527,15 +555,16 @@ (highlighting-rules pump-state-highlighting-rules)) pump-state (let ((line (line-containing-offset (syntax view) offset))) - (flet ((finish (offset symbol &optional stroke-drawing-options) + (flet ((finish (new-offset symbol &optional stroke-drawing-options sticky-p) (setf start-symbol symbol) - (loop until (> (car (first drawing-options)) offset) - do (pop drawing-options)) (unless (null stroke-drawing-options) - (push (cons (end-offset symbol) stroke-drawing-options) + (push (if (frame-sticky-p (first drawing-options)) + (make-drawing-options-frame + (end-offset symbol) (frame-drawing-options (first drawing-options)) t) + (make-drawing-options-frame + (end-offset symbol) stroke-drawing-options sticky-p)) drawing-options)) - (return-from find-next-stroke-end - offset))) + (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)) @@ -543,28 +572,38 @@ (= offset (start-offset start-symbol))) (finish (end-offset start-symbol) start-symbol nil)) (t - (or (do-parse-symbols-forward (symbol offset start-symbol) - (let ((symbol-drawing-options - (get-drawing-options highlighting-rules view symbol))) - (cond ((> (start-offset symbol) (line-end-offset line)) - (finish (line-end-offset line) start-symbol)) - ((and (typep symbol 'literal-object-mixin)) - (finish (start-offset symbol) symbol - (or symbol-drawing-options - (make-drawing-options :function (object-drawer))))) - ((and (> (start-offset symbol) offset) - (not (drawing-options-equal (or symbol-drawing-options - +default-drawing-options+) - (cdr (first drawing-options)))) - (if (null symbol-drawing-options) - (>= (start-offset symbol) (car (first drawing-options))) - t)) - (finish (start-offset symbol) symbol symbol-drawing-options)) - ((and (= (start-offset symbol) offset) - symbol-drawing-options - (not (drawing-options-equal symbol-drawing-options - (cdr (first drawing-options))))) - (finish (start-offset symbol) symbol symbol-drawing-options))))) + (or (let* ((current-frame (first drawing-options)) + (currently-used-options (frame-drawing-options current-frame))) + (do-parse-symbols-forward (symbol offset start-symbol) + (multiple-value-bind (symbol-drawing-options sticky) + (get-drawing-options highlighting-rules view symbol) + ;; Remove frames that are no longer applicable... + (loop until (> (frame-end-offset (first drawing-options)) + (start-offset symbol)) + do (pop drawing-options)) + (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)) + ((and (typep symbol 'literal-object-mixin)) + (finish (start-offset symbol) symbol + (or symbol-drawing-options + (make-drawing-options :function (object-drawer))))) + ((and (> (start-offset symbol) offset) + (not (drawing-options-equal (or options-to-be-used + +default-drawing-options+) + currently-used-options)) + (if (null symbol-drawing-options) + (>= (start-offset symbol) (frame-end-offset current-frame)) + t)) + (finish (start-offset symbol) symbol symbol-drawing-options sticky)) + ((and (= (start-offset symbol) offset) + symbol-drawing-options + (not (drawing-options-equal + options-to-be-used + (frame-drawing-options (first drawing-options))))) + (finish (start-offset symbol) symbol symbol-drawing-options sticky))))))) ;; If there are no more parse symbols, we just go ;; line-by-line from here. This should mean that all ;; remaining lines are blank. @@ -578,11 +617,15 @@ (with-accessors ((offset pump-state-offset) (current-drawing-options pump-state-drawing-options)) pump-state - (let ((old-drawing-options (cdr (first current-drawing-options))) - (end-offset (find-next-stroke-end view pump-state))) + (let ((old-drawing-options (frame-drawing-options (first current-drawing-options))) + (end-offset (find-next-stroke-end view pump-state)) + (old-offset offset)) (setf (stroke-start-offset stroke) offset (stroke-end-offset stroke) end-offset (stroke-drawing-options stroke) old-drawing-options offset (if (offset-end-of-line-p (buffer view) end-offset) (1+ end-offset) - end-offset)))))) + end-offset)) + ;; Don't use empty strokes, try again... + (when (= old-offset offset) + (stroke-pump-with-syntax view syntax stroke pump-state))))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 08 Feb '08

08 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv6421/Drei Modified Files: syntax.lisp Log Message: Fixed command table inheritance so syntax modes take precedence over the syntax itself. --- /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/01/30 11:48:40 1.17 +++ /project/mcclim/cvsroot/mcclim/Drei/syntax.lisp 2008/02/08 18:37:32 1.18 @@ -43,7 +43,7 @@ (defgeneric syntax-command-tables (syntax) (:documentation "Returns additional command tables provided by `syntax'.") - (:method-combination append) + (:method-combination append :most-specific-last) (:method append ((syntax syntax)) (list (command-table syntax))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 08 Feb '08

08 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv31674/Drei Modified Files: lisp-syntax-commands.lisp Log Message: Added argument hinting for Lisp when entering newlines and right parentheses. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2008/01/17 11:29:55 1.16 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2008/02/08 18:05:51 1.17 @@ -90,16 +90,21 @@ "Show argument list for a given symbol." (show-arglist (current-syntax) symbol)) -(define-command (com-space :command-table lisp-table) +(define-command (com-self-insert-then-arglist :command-table lisp-table) () - "Insert a space and display argument hints in the minibuffer." - (insert-character #\Space) - ;; We must update the syntax in order to reflect any changes to - ;; the parse tree our insertion of a space character may have - ;; done. + "Insert the gesture used to invoke this command and display +argument hints in the minibuffer." + (insert-character *current-gesture*) (show-arglist-for-form-at-mark (point) (current-syntax)) (clear-completions)) +(define-command (com-newline-indent-then-arglist :command-table lisp-table) () + "Inserts a newline, indents the new line, then displays +argument hints in the minibuffer." + (insert-object (point) #\Newline) + (indent-current-line (current-view) (point)) + (show-arglist-for-form-at-mark (point) (current-syntax))) + (define-command (com-complete-symbol :name t :command-table lisp-table) () "Attempt to complete the symbol at mark. If successful, move point @@ -216,10 +221,14 @@ 'lisp-table '((#\c :control) (#\d :control) (#\a))) -(set-key 'com-space +(set-key 'com-self-insert-then-arglist 'lisp-table '((#\Space))) +(set-key 'com-self-insert-then-arglist + 'lisp-table + '((#\)))) + (set-key 'com-complete-symbol 'lisp-table '((#\Tab :meta))) @@ -232,7 +241,7 @@ 'lisp-table '((#\Tab))) -(set-key 'drei-commands::com-newline-and-indent +(set-key 'com-newline-indent-then-arglist 'lisp-table '(#\Newline))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 08 Feb '08

08 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19251/Drei Modified Files: input-editor.lisp Log Message: Finally make that ridiculously complated input-editor do as I want it do to! Slowish, but who cares? Perhaps the input-editor needs a special buffer implementation... --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/08 12:43:59 1.45 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/08 13:24:48 1.46 @@ -558,9 +558,11 @@ if stuff is inserted after the insertion pointer." (assert (<= (input-position stream) (stream-scan-pointer stream))) (let* ((drei (drei-instance stream)) + (buffer (buffer (view drei))) (*command-processor* drei) (was-directly-processing (directly-processing-p drei)) - (*drei-input-editing-stream* stream)) + (*drei-input-editing-stream* stream) + (old-buffer-contents (buffer-sequence buffer 0 (size buffer)))) (with-bound-drei-special-variables (drei :prompt "M-x ") (update-drei-buffer stream) ;; Commands are permitted to signal immediate rescans, but @@ -573,7 +575,7 @@ (drei-core:with-narrowed-buffer (drei (loop for index from (1- (input-position stream)) above 0 - when (typep (buffer-object (buffer (view drei)) index) + when (typep (buffer-object buffer index) 'noise-string) return (1+ index) finally (return 0)) @@ -589,8 +591,7 @@ (when was-directly-processing (display-message "Aborted"))))))) (update-drei-buffer stream)) - (let ((first-mismatch (when (plusp (prefix-size (view drei))) - (prefix-size (view drei))))) + (let ((first-mismatch (buffer-array-mismatch buffer old-buffer-contents))) (display-drei drei :redisplay-minibuffer t) (cond ((null first-mismatch) ;; No change actually took place, even though IP may

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 08 Feb '08

08 Feb '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv2460/Drei Modified Files: input-editor.lisp Log Message: Now actually fixed some more things. Net result: input-editing should be more stable and predictable. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/08 11:36:35 1.44 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/02/08 12:43:59 1.45 @@ -556,6 +556,7 @@ `stream-read-gesture' for the stream encapsulated by `stream'. The second return value of this function will be `type' if stuff is inserted after the insertion pointer." + (assert (<= (input-position stream) (stream-scan-pointer stream))) (let* ((drei (drei-instance stream)) (*command-processor* drei) (was-directly-processing (directly-processing-p drei)) @@ -588,13 +589,14 @@ (when was-directly-processing (display-message "Aborted"))))))) (update-drei-buffer stream)) - (let ((first-mismatch (prefix-size (view drei)))) + (let ((first-mismatch (when (plusp (prefix-size (view drei))) + (prefix-size (view drei))))) (display-drei drei :redisplay-minibuffer t) (cond ((null first-mismatch) ;; No change actually took place, even though IP may ;; have moved. nil) - ((<= first-mismatch (stream-scan-pointer stream)) + ((< first-mismatch (stream-scan-pointer stream)) ;; Eek, change before scan pointer - this probably ;; changes the scan, so we'll have to rescan ;; everything. Bummer!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs