[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Fri Dec 1 22:39:15 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv14362
Modified Files:
input-editor.lisp
Log Message:
Now support for CLIM 2.2 (Franz User Guide) style input buffers.
--- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 21:51:08 1.7
+++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 22:39:14 1.8
@@ -41,7 +41,12 @@
:initform nil)
(%rescanning-p :reader stream-rescanning-p
:writer (setf stream-rescanning)
- :initform nil))
+ :initform nil)
+ (%input-buffer-array :accessor input-buffer-array
+ :initform nil
+ :documentation "After a command has been
+executed, the contents of the Drei area instance shall be
+replaced by the contents of this array, if non-NIL."))
(:documentation "An mixin that helps in implementing Drei-based
input-editing streams. This class should not be directly
instantiated."))
@@ -170,15 +175,62 @@
;; want to permit the user to undo input for this context.
(clear-undo-history (buffer (drei-instance stream))))
+(defun update-drei-buffer (stream)
+ "Update the Drei buffer of the Drei instance used by `stream'
+if the `input-buffer-array' of `stream' is non-NIl. This will set
+the contents of the array to the contents of the array up to the
+fill pointer. When this function returns, the
+`input-buffer-array' of `stream' will be NIL. Also, the syntax
+will be up-to-date."
+ (with-accessors ((array input-buffer-array)) stream
+ (let ((buffer (buffer (drei-instance stream))))
+ (when array
+ ;; Attempt to minimise the changes to the buffer, so the
+ ;; position of marks will not be changed too much. Find the
+ ;; first mismatch between buffer contents and array contents.
+ (let ((index (loop
+ for index from 0 below (min (length array)
+ (size buffer))
+ unless (eql (buffer-object buffer index)
+ (aref array index))
+ do (return index)
+ finally (return nil)))
+ (insertion-pointer (stream-insertion-pointer stream)))
+ (when index ; NIL if buffer and array are identical.
+ ;; Delete from the first mismatch to the end of the buffer.
+ (delete-buffer-range buffer index
+ (- (size buffer) index))
+ ;; Insert from the mismatch to array end into the buffer.
+ (insert-buffer-sequence buffer index
+ (subseq array index))
+ ;; We also need to update the syntax.
+ (update-syntax buffer (syntax buffer))
+ ;; Finally, see if it is possible to maintain the old
+ ;; position of the insertion pointer.
+ (setf (stream-insertion-pointer stream)
+ (min insertion-pointer (size buffer)))))
+ (setf array nil)))))
+
+;; While the CLIM spec says that user-commands are not allowed to do
+;; much with the input buffer, the Franz User Guide provides some
+;; examples that hint to the opposite. How do we make modifications of
+;; the input-buffer, which must be a standard array with a fill
+;; pointer, to be applied to the "real" buffer? This is how: when this
+;; method is called, we store the object in the stream object. In the
+;; command loop, we check the stream object and update the buffer
+;; (using `update-drei-buffer') to reflect the changes done to the
+;; buffer.
(defmethod stream-input-buffer ((stream drei-input-editing-mixin))
- ;; NOTE: This is very slow, please do not use it unless you want to
- ;; be compatible with other editor substrates. Use the Drei buffer
- ;; directly instead.
- (with-accessors ((buffer buffer)) (drei-instance stream)
- (let* ((array (buffer-sequence buffer 0 (size buffer))))
- (make-array (length array)
- :fill-pointer (length array)
- :initial-contents array))))
+ ;; NOTE: This is very slow (consing up a whole new array - twice!),
+ ;; please do not use it unless you want to be compatible with other
+ ;; editor substrates. Use the Drei buffer directly instead.
+ (or (input-buffer-array stream)
+ (setf (input-buffer-array stream)
+ (with-accessors ((buffer buffer)) (drei-instance stream)
+ (let* ((array (buffer-sequence buffer 0 (size buffer))))
+ (make-array (length array)
+ :fill-pointer (length array)
+ :initial-contents array))))))
(defmethod replace-input ((stream drei-input-editing-mixin) (new-input array)
&key
@@ -372,21 +424,25 @@
*pointer-documentation-output*
minibuffer)
:prompt "M-x ")
- ;; We narrow the buffer to the input position, so the user won't
- ;; be able to erase the original command (when entering command
- ;; arguments) or stuff like argument prompts.
- (accepting-from-user (drei)
- (drei-core:with-narrowed-buffer (drei (input-position stream) t t)
- (handler-case (process-gestures-or-command drei)
- (unbound-gesture-sequence (c)
- (display-message "~A is unbound" (gesture-name (gestures c))))
- (abort-gesture (c)
- (if (member (abort-gesture-event c)
- *abort-gestures*
- :test #'event-matches-gesture-name-p)
- (signal 'abort-gesture :event (abort-gesture-event c))
- (when was-directly-processing
- (display-message "Aborted")))))))
+ ;; Commands are permitted to signal immediate rescans, but
+ ;; we may need to do some stuff first.
+ (unwind-protect
+ (accepting-from-user (drei)
+ ;; We narrow the buffer to the input position, so the user won't
+ ;; be able to erase the original command (when entering command
+ ;; arguments) or stuff like argument prompts.
+ (drei-core:with-narrowed-buffer (drei (input-position stream) t t)
+ (handler-case (process-gestures-or-command drei)
+ (unbound-gesture-sequence (c)
+ (display-message "~A is unbound" (gesture-name (gestures c))))
+ (abort-gesture (c)
+ (if (member (abort-gesture-event c)
+ *abort-gestures*
+ :test #'event-matches-gesture-name-p)
+ (signal 'abort-gesture :event (abort-gesture-event c))
+ (when was-directly-processing
+ (display-message "Aborted")))))))
+ (update-drei-buffer stream))
;; Will also take care of redisplaying minibuffer.
(display-drei drei)
(let ((first-mismatch (offset (high-mark buffer))))
More information about the Mcclim-cvs
mailing list