[beirc-cvs] CVS beirc
afuchs
afuchs at common-lisp.net
Tue Mar 21 22:50:21 UTC 2006
Update of /project/beirc/cvsroot/beirc
In directory clnet:/tmp/cvs-serv22374
Modified Files:
application.lisp
Log Message:
Make read-frame-command always clear the input window - especially for abort-gesture
--- /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:45:03 1.67
+++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:50:21 1.68
@@ -952,47 +952,47 @@
(call-next-method))
(defmethod read-frame-command ((frame beirc) &key (stream *standard-input*))
- (multiple-value-prog1
- (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 #\/)
- (clim:read-gesture :stream stream)
- (accept 'command :stream stream :prompt 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)))
+ (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 #\/)
+ (clim:read-gesture :stream stream)
+ (accept 'command :stream stream :prompt 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)))
(defun irc-event-loop (frame connection)
More information about the Beirc-cvs
mailing list