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

[Christophe Rhodes]

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

Modified Files:
	gui.lisp 
Log Message:
Provide a "comfort" restart, allowing recovery from unhandled lisp 
errors in the dynamic extent of the climacs command loop

Date: Thu May  5 12:59:43 2005
Author: crhodes

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.130 climacs/gui.lisp:1.131
--- climacs/gui.lisp:1.130	Thu May  5 00:51:19 2005
+++ climacs/gui.lisp	Thu May  5 12:59:42 2005
@@ -284,11 +284,12 @@
 		 (redisplay-frame-panes frame))))
 	(loop
 	   for maybe-error = t
-	   do (handler-case
-		  (with-input-context ('(command
-					 :command-table 'global-climacs-table))
-		    (object)
-		    (loop
+	   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*)
@@ -306,15 +307,14 @@
 					     (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))))))
+		       (update-climacs))
+		      (t
+		       (do-command object)
+		       (setq maybe-error nil)))
+		  (abort-gesture () (display-message "Quit"))))
+	   (when maybe-error
+	     (beep))
+	   (update-climacs))))))
 
 (defmacro simple-command-loop (command-table loop-condition end-clauses)
   (let ((gesture (gensym))