[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Fri Dec 1 21:51:08 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv9192
Modified Files:
input-editor.lisp
Log Message:
Removed all non-specified use of `stream-input-buffer' because it's
very slow (consing up a brand new array).
--- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/11/22 14:15:53 1.6
+++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2006/12/01 21:51:08 1.7
@@ -171,8 +171,9 @@
(clear-undo-history (buffer (drei-instance stream))))
(defmethod stream-input-buffer ((stream drei-input-editing-mixin))
- ;; NOTE: This is very slow, we should attempt to replace uses of
- ;; this function in McCLIM with something more efficient.
+ ;; 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)
@@ -275,71 +276,70 @@
&allow-other-keys)
(with-keywords-removed (rest-args (:peek-p))
(rescan-if-necessary stream)
- (with-accessors ((buffer stream-input-buffer)
- (insertion-pointer stream-insertion-pointer)
+ (with-accessors ((insertion-pointer stream-insertion-pointer)
(scan-pointer stream-scan-pointer)
(activation-gesture activation-gesture)) stream
- (loop
- (loop
- while (< scan-pointer insertion-pointer)
- while (< scan-pointer (length buffer))
- do (let ((gesture (aref buffer scan-pointer)))
- ;; Skip noise strings.
- (cond ((typep gesture 'noise-string)
- (incf scan-pointer))
- ((and (not peek-p)
- (typep gesture 'accept-result))
- (incf scan-pointer)
- #+(or mcclim building-mcclim)
- (climi::throw-object-ptype (object gesture)
- (result-type gesture)))
- ;; Note that this implies that
- ;; `stream-read-gesture' may return accept
- ;; results, which might as well be arbitrary
- ;; objects to the code calling
- ;; `stream-read-gesture', since it can't really
- ;; do anything with them except for asserting
- ;; that they exist. According to the spec,
- ;; "accept results are treated as a single
- ;; gesture", and this kind of behavior is
- ;; necessary to make sure `stream-read-gesture'
- ;; doesn't simply claim that there are no more
- ;; gestures in the input-buffer when the
- ;; remaining gesture(s) is an accept result.
- ((typep gesture 'accept-result)
- (return-from stream-read-gesture gesture))
- (t
- (unless peek-p
+ (let ((buffer (buffer (drei-instance stream))))
+ (loop
+ (loop
+ while (< scan-pointer insertion-pointer)
+ while (< scan-pointer (size buffer))
+ do (let ((gesture (buffer-object buffer scan-pointer)))
+ ;; Skip noise strings.
+ (cond ((typep gesture 'noise-string)
(incf scan-pointer))
- (return-from stream-read-gesture gesture))
- (t (incf scan-pointer)))))
- (setf (stream-rescanning stream) nil)
- (when activation-gesture
- (return-from stream-read-gesture
- (prog1 activation-gesture
- (unless peek-p
- (setf activation-gesture nil)))))
- ;; In McCLIM, stream-process-gesture is responsible for
- ;; inserting characters into the buffer, changing the
- ;; insertion pointer and possibly setting up the
- ;; activation-gesture slot.
- (loop
- with gesture and type
- do (setf (values gesture type)
- (apply #'stream-read-gesture
- (encapsulating-stream-stream stream) rest-args))
- when (null gesture)
- do (return-from stream-read-gesture (values gesture type))
- when (stream-process-gesture stream gesture type)
- do (loop-finish))))))
+ ((and (not peek-p)
+ (typep gesture 'accept-result))
+ (incf scan-pointer)
+ #+(or mcclim building-mcclim)
+ (climi::throw-object-ptype (object gesture)
+ (result-type gesture)))
+ ;; Note that this implies that
+ ;; `stream-read-gesture' may return accept
+ ;; results, which might as well be arbitrary
+ ;; objects to the code calling
+ ;; `stream-read-gesture', since it can't really
+ ;; do anything with them except for asserting
+ ;; that they exist. According to the spec,
+ ;; "accept results are treated as a single
+ ;; gesture", and this kind of behavior is
+ ;; necessary to make sure `stream-read-gesture'
+ ;; doesn't simply claim that there are no more
+ ;; gestures in the input-buffer when the
+ ;; remaining gesture(s) is an accept result.
+ ((typep gesture 'accept-result)
+ (return-from stream-read-gesture gesture))
+ (t
+ (unless peek-p
+ (incf scan-pointer))
+ (return-from stream-read-gesture gesture))
+ (t (incf scan-pointer)))))
+ (setf (stream-rescanning stream) nil)
+ (when activation-gesture
+ (return-from stream-read-gesture
+ (prog1 activation-gesture
+ (unless peek-p
+ (setf activation-gesture nil)))))
+ ;; In McCLIM, stream-process-gesture is responsible for
+ ;; inserting characters into the buffer, changing the
+ ;; insertion pointer and possibly setting up the
+ ;; activation-gesture slot.
+ (loop
+ with gesture and type
+ do (setf (values gesture type)
+ (apply #'stream-read-gesture
+ (encapsulating-stream-stream stream) rest-args))
+ when (null gesture)
+ do (return-from stream-read-gesture (values gesture type))
+ when (stream-process-gesture stream gesture type)
+ do (loop-finish)))))))
(defmethod stream-unread-gesture ((stream drei-input-editing-mixin)
gesture)
- (with-accessors ((buffer stream-input-buffer)
- (scan-pointer stream-scan-pointer)
+ (with-accessors ((scan-pointer stream-scan-pointer)
(activation-gesture activation-gesture)) stream
(when (> scan-pointer 0)
- (if (and (eql scan-pointer (fill-pointer buffer))
+ (if (and (eql scan-pointer (stream-insertion-pointer stream))
(activation-gesture-p gesture))
(setf activation-gesture gesture)
(decf scan-pointer)))))
@@ -355,8 +355,8 @@
`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."
- (let* ((before (stream-input-buffer stream))
- (drei (drei-instance stream))
+ (let* ((drei (drei-instance stream))
+ (buffer (buffer drei))
(*command-processor* drei)
(was-directly-processing (directly-processing-p drei))
(minibuffer (or (minibuffer drei) *minibuffer*))
@@ -389,7 +389,8 @@
(display-message "Aborted")))))))
;; Will also take care of redisplaying minibuffer.
(display-drei drei)
- (let ((first-mismatch (mismatch before (stream-input-buffer stream))))
+ (let ((first-mismatch (offset (high-mark buffer))))
+ (clear-modify buffer)
(cond ((null first-mismatch)
;; No change actually took place, even though IP may
;; have moved.
More information about the Mcclim-cvs
mailing list