[climacs-cvs] CVS update: climacs/gui.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv27192

Modified Files:
	gui.lisp 
Log Message:
C-g now aborts extended commands.

Date: Tue Feb 22 08:29:09 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.118 climacs/gui.lisp:1.119
--- climacs/gui.lisp:1.118	Mon Feb 21 13:51:55 2005
+++ climacs/gui.lisp	Tue Feb 22 08:29:08 2005
@@ -176,8 +176,6 @@
     (return-from climacs-read-gesture
       (pop (remaining-keys *application-frame*))))
   (loop for gesture = (read-gesture :stream *standard-input*)
-	when (event-matches-gesture-name-p gesture '(:keyboard #\g 512)) ; FIXME
-	  do (throw 'outer-loop nil)
 	until (or (characterp gesture)
 		  (and (typep gesture 'keyboard-event)
 		       (or (keyboard-event-character gesture)
@@ -260,40 +258,41 @@
      (let ((*standard-output* (car windows))
 	   (*standard-input* (find-pane-named frame 'int))
 	   (*print-pretty* nil)
-	   (*abort-gestures* nil))
+	   (*abort-gestures* '((:keyboard #\g 512))))
        (redisplay-frame-panes frame :force-p t)
-       (loop (catch 'outer-loop
-	       (loop for gestures = '()
-		     do (multiple-value-bind (numarg numargp)
-			    (read-numeric-argument :stream *standard-input*)
-			  (loop (setf *current-gesture* (climacs-read-gesture))
-				(setf gestures (nconc gestures (list *current-gesture*)))
-				(let ((item (find-gestures gestures 'global-climacs-table)))
-				  (cond ((not item)
-					 (beep) (return))
-					((eq (command-menu-item-type item) :command)
-					 (let ((command (command-menu-item-value item)))
-					   (unless (consp command)
-					     (setf command (list command)))
-					   (setf command (substitute-numeric-argument-marker command numarg))
-					   (setf command (substitute-numeric-argument-p command numargp))
-					   (handler-case 
-					       (execute-frame-command frame command)
-					     (error (condition)
-					       (beep)
-					       (format *error-output* "~a~%" condition)))
-					   (setf (previous-command *standard-output*)
-						 (if (consp command)
-						     (car command)
-						     command))
-					   (return)))
-					(t nil))))
-			  (let ((buffer (buffer (current-window))))
-			    (when (modified-p buffer)
-			      (setf (needs-saving buffer) t)))
-			  (when (null (remaining-keys *application-frame*))
-			    (setf (executingp *application-frame*) nil)
-			    (redisplay-frame-panes frame)))))
+       (loop (handler-case 
+		 (loop for gestures = '()
+		       do (multiple-value-bind (numarg numargp)
+			      (read-numeric-argument :stream *standard-input*)
+			    (loop (setf *current-gesture* (climacs-read-gesture))
+				  (setf gestures (nconc gestures (list *current-gesture*)))
+				  (let ((item (find-gestures gestures 'global-climacs-table)))
+				    (cond ((not item)
+					   (beep) (return))
+					  ((eq (command-menu-item-type item) :command)
+					   (let ((command (command-menu-item-value item)))
+					     (unless (consp command)
+					       (setf command (list command)))
+					     (setf command (substitute-numeric-argument-marker command numarg))
+					     (setf command (substitute-numeric-argument-p command numargp))
+					     (handler-case 
+						 (execute-frame-command frame command)
+					       (error (condition)
+						 (beep)
+						 (format *error-output* "~a~%" condition)))
+					     (setf (previous-command *standard-output*)
+						   (if (consp command)
+						       (car command)
+						       command))
+					     (return)))
+					  (t nil))))
+			    (let ((buffer (buffer (current-window))))
+			      (when (modified-p buffer)
+				(setf (needs-saving buffer) t)))
+			    (when (null (remaining-keys *application-frame*))
+			      (setf (executingp *application-frame*) nil)
+			      (redisplay-frame-panes frame))))
+	       (abort-gesture () nil))
 	     (beep)
 	     (let ((buffer (buffer (current-window))))
 	       (when (modified-p buffer)