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

[Christophe Rhodes]

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

Modified Files:
	gui.lisp 
Log Message:
rearrange the toplevel loop a little

Date: Fri May  6 18:56:33 2005
Author: crhodes

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.132 climacs/gui.lisp:1.133
--- climacs/gui.lisp:1.132	Fri May  6 01:00:23 2005
+++ climacs/gui.lisp	Fri May  6 18:56:32 2005
@@ -282,39 +282,46 @@
 	       (when (null (remaining-keys *application-frame*))
 		 (setf (executingp *application-frame*) nil)
 		 (redisplay-frame-panes frame))))
-	(loop
+	(flet ((process-gestures ()
+		 (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))
+			       (do-command command)
+			       (return)))
+			    (t nil)))))
+		  do (update-climacs))))
+	  (loop
 	   for maybe-error = t
-	   do (with-simple-restart (return-to-climacs "Return to Climacs")
-		(handler-case
-		    (with-input-context ('(command
-					   :command-table 'global-climacs-table))
-		      (object)
-		      (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))
-					     (do-command command)
-					     (return)))
-					  (t nil)))))
-		       (update-climacs))
-		      (t
-		       (do-command object)
-		       (setq maybe-error nil)))
-		  (abort-gesture () (display-message "Quit"))))
-	   (when maybe-error
-	     (beep))
-	   (update-climacs))))))
+	   do (restart-case
+		  (progn
+		    (handler-case
+			(with-input-context 
+			      ('(command :command-table 'global-climacs-table))
+			    (object)
+		            (process-gestures)
+			  (t
+			   (do-command object)
+			   (setq maybe-error nil)))
+		      (abort-gesture () (display-message "Quit")))
+		    (when maybe-error
+		      (beep))
+		    (update-climacs))
+		(return-to-climacs () nil))))))))
 
 (defmacro simple-command-loop (command-table loop-condition end-clauses)
   (let ((gesture (gensym))