[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