[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