[beirc-cvs] CVS beirc
afuchs
afuchs at common-lisp.net
Mon Aug 20 18:33:25 UTC 2007
Update of /project/beirc/cvsroot/beirc
In directory clnet:/tmp/cvs-serv29545
Modified Files:
application.lisp
Log Message:
Finally commit Troels Henriksen's read-frame-command patch.
Drei is more strict w.r.t. inserting input while rescanning, so unbreak
it.
--- /project/beirc/cvsroot/beirc/application.lisp 2007/06/27 23:16:00 1.89
+++ /project/beirc/cvsroot/beirc/application.lisp 2007/08/20 18:33:24 1.90
@@ -1055,61 +1055,64 @@
(defmethod read-frame-command ((frame beirc) &key (stream *standard-input*))
(let ((bad-input nil))
(unwind-protect
- (clim:with-input-editing (stream)
- (when (and (current-receiver frame) (incomplete-input (current-receiver frame)))
- (replace-input stream (incomplete-input (current-receiver frame)) :rescan t))
- (with-input-context ('command) (object)
- (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame))
- (catch 'keystroke-command
- (let ((force-restore-input-state nil))
- (labels ((reset-saved-input ()
- (when (current-receiver frame)
- (setf (incomplete-input (current-receiver frame)) ""))))
- (handler-bind ((accelerator-gesture
- (lambda (gesture)
- (save-input-line stream frame)
- (throw 'keystroke-command (lookup-keystroke-command-item
- (accelerator-gesture-event gesture)
- (frame-command-table frame)))))
- (abort-gesture
- (lambda (gesture)
- (declare (ignore gesture))
- (reset-saved-input)
- (setf force-restore-input-state nil)))
- (invoked-command-by-clicking
- (lambda (cond)
- (declare (ignore cond))
- (save-input-line stream frame)
- (setf force-restore-input-state t)
- (invoke-restart 'acknowledged))))
- (let ((c (clim:read-gesture :stream stream :peek-p t)))
- (multiple-value-prog1
- (cond ((eql c #\/)
- (handler-case
- (progn
- (clim:read-gesture :stream stream)
- (accept 'command :stream stream :prompt nil))
- (simple-completion-error (c)
- #+mcclim
- (let ((preliminary-line (save-input-line stream frame)))
- (setf (incomplete-input (current-receiver frame))
- (subseq preliminary-line 0
- (search (climi::completion-error-input-so-far c)
- preliminary-line))
- bad-input (subseq preliminary-line
- (search (climi::completion-error-input-so-far c)
- preliminary-line))
- force-restore-input-state t))
- (beep)
- nil)))
- (t
- (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream))))
- (if force-restore-input-state
- (setf force-restore-input-state nil)
- (reset-saved-input)))))))))
- (command
- (save-input-line stream frame)
- object)))
+ (clim:with-input-editing (stream)
+ (when (and (current-receiver frame) (incomplete-input (current-receiver frame))
+ (not (stream-rescanning-p stream)))
+ (replace-input stream
+ (incomplete-input (current-receiver frame))
+ :rescan t))
+ (with-input-context ('command) (object)
+ (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame))
+ (catch 'keystroke-command
+ (let ((force-restore-input-state nil))
+ (labels ((reset-saved-input ()
+ (when (current-receiver frame)
+ (setf (incomplete-input (current-receiver frame)) ""))))
+ (handler-bind ((accelerator-gesture
+ (lambda (gesture)
+ (save-input-line stream frame)
+ (throw 'keystroke-command (lookup-keystroke-command-item
+ (accelerator-gesture-event gesture)
+ (frame-command-table frame)))))
+ (abort-gesture
+ (lambda (gesture)
+ (declare (ignore gesture))
+ (reset-saved-input)
+ (setf force-restore-input-state nil)))
+ (invoked-command-by-clicking
+ (lambda (cond)
+ (declare (ignore cond))
+ (save-input-line stream frame)
+ (setf force-restore-input-state t)
+ (invoke-restart 'acknowledged))))
+ (let ((c (clim:read-gesture :stream stream :peek-p t)))
+ (multiple-value-prog1
+ (cond ((eql c #\/)
+ (handler-case
+ (progn
+ (clim:read-gesture :stream stream)
+ (accept 'command :stream stream :prompt "" :prompt-mode :raw))
+ (simple-completion-error (c)
+ #+mcclim
+ (let ((preliminary-line (save-input-line stream frame)))
+ (setf (incomplete-input (current-receiver frame))
+ (subseq preliminary-line 0
+ (search (climi::completion-error-input-so-far c)
+ preliminary-line))
+ bad-input (subseq preliminary-line
+ (search (climi::completion-error-input-so-far c)
+ preliminary-line))
+ force-restore-input-state t))
+ (beep)
+ nil)))
+ (t
+ (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream))))
+ (if force-restore-input-state
+ (setf force-restore-input-state nil)
+ (reset-saved-input)))))))))
+ (command
+ (save-input-line stream frame)
+ object)))
(window-clear stream)
(when bad-input
(format stream "Bad input \"")
More information about the Beirc-cvs
mailing list