[climacs-cvs] CVS esa

dmurray dmurray at common-lisp.net
Fri May 12 18:51:54 UTC 2006


Update of /project/climacs/cvsroot/esa
In directory clnet:/tmp/cvs-serv22131

Modified Files:
	esa.lisp 
Log Message:
Wrapped simple-command-loop in a handler-case to deal
with abort appropriately. Now C-g during an Isearch
doesn't leave the Isearch mode active.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/05/11 15:36:56	1.17
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/05/12 18:51:54	1.18
@@ -540,22 +540,25 @@
   (let ((gesture (gensym))
         (item (gensym))
         (command (gensym)))
-    `(progn 
-       (redisplay-frame-panes *application-frame*)
-       (loop while ,loop-condition
-             as ,gesture = (esa-read-gesture)
-             as ,item = (find-gestures-with-inheritance (list ,gesture) ,command-table)
-             do (cond ((and ,item (eq (command-menu-item-type ,item) :command))
-                       (setf *current-gesture* ,gesture)
-                       (let ((,command (command-menu-item-value ,item)))
-                         (unless (consp ,command)
-                           (setf ,command (list ,command)))
-			 (execute-frame-command *application-frame*
-						,command)))
-                      (t
-                       (unread-gesture ,gesture)
-                       , at end-clauses))
-             (redisplay-frame-panes *application-frame*)))))
+    `(handler-case
+	 (progn 
+	   (redisplay-frame-panes *application-frame*)
+	   (loop while ,loop-condition
+		 as ,gesture = (esa-read-gesture)
+		 as ,item = (find-gestures-with-inheritance (list ,gesture) ,command-table)
+		 do (cond ((and ,item (eq (command-menu-item-type ,item) :command))
+			   (setf *current-gesture* ,gesture)
+			   (let ((,command (command-menu-item-value ,item)))
+			     (unless (consp ,command)
+			       (setf ,command (list ,command)))
+			     (execute-frame-command *application-frame*
+						    ,command)))
+			  (t
+			   (unread-gesture ,gesture)
+			   , at end-clauses))
+		    (redisplay-frame-panes *application-frame*)))
+       (abort-gesture ()
+	 , at end-clauses))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 




More information about the Climacs-cvs mailing list