? abbrev.fasl
? base-test.fasl
? base.fasl
? buffer-test.fasl
? buffer.fasl
? cl-syntax.fasl
? gui.fasl
? html-syntax.fasl
? io.fasl
? kill-ring.fasl
? packages.fasl
? pane.fasl
? syntax.fasl
? text-syntax.fasl
? translate.fasl
? undo.fasl
? Doc/climacs-internals.aux
? Doc/climacs-internals.cp
? Doc/climacs-internals.dvi
? Doc/climacs-internals.fn
? Doc/climacs-internals.fns
? Doc/climacs-internals.ky
? Doc/climacs-internals.log
? Doc/climacs-internals.pdf
? Doc/climacs-internals.pg
? Doc/climacs-internals.ps
? Doc/climacs-internals.toc
? Doc/climacs-internals.tp
? Doc/climacs-internals.tps
? Doc/climacs-internals.vr
? Doc/undo.eps
? Persistent/binseq-package.fasl
? Persistent/binseq.fasl
? Persistent/obinseq.fasl
? Persistent/persistent-buffer.fasl
? testing/rt.fasl
Index: gui.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/gui.lisp,v
retrieving revision 1.108
diff -u -r1.108 gui.lisp
--- gui.lisp	13 Feb 2005 02:52:08 -0000	1.108
+++ gui.lisp	17 Feb 2005 13:49:19 -0000
@@ -241,54 +241,63 @@
 				 (sheet-children vbox)))))))
 
 (defun climacs-top-level (frame &key
-			  command-parser command-unparser 
-			  partial-command-parser prompt)
+                          command-parser command-unparser
+                          partial-command-parser prompt)
   (declare (ignore command-parser command-unparser partial-command-parser prompt))
   (with-slots (windows) frame
-     (setf windows (list (find-climacs-pane (find-pane-named frame 'win))))
-     (push (buffer (car windows)) (buffers frame))
-     (let ((*standard-output* (car windows))
-	   (*standard-input* (find-pane-named frame 'int))
-	   (*print-pretty* nil)
-	   (*abort-gestures* nil))
-       (redisplay-frame-panes frame :force-p t)
-       (loop (catch 'outer-loop
-	       (loop for gestures = '()
+    (setf windows (list (find-climacs-pane (find-pane-named frame 'win))))
+    (push (buffer (car windows)) (buffers frame))
+    (let ((*standard-output* (car windows))
+	  (*standard-input* (find-pane-named frame 'int))
+	  (*print-pretty* nil)
+	  (*abort-gestures* nil))
+      (redisplay-frame-panes frame :force-p t)
+      (flet ((do-command (command)
+	       (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)))
+	     (update-climacs ()
+	       (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
+	   for maybe-error = t
+	   do (catch 'outer-loop
+		(with-input-context ('(command
+				       :command-table 'global-climacs-table))
+		  (object)
+		  (loop
+		     for gestures = '()
 		     for numarg = (read-numeric-argument :stream *standard-input*)
 		     do (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))
-					 (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))))
-	     (beep)
-	     (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))))))
+			   (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))
+				      (do-command command)
+				      (return)))
+				   (t nil))))
+		       (update-climacs))
+		  (t
+		   (do-command object)
+		   (setq maybe-error nil))))
+	     (when maybe-error
+	       (beep))
+	     (update-climacs))))))
 
 (defmacro simple-command-loop (command-table loop-condition end-clauses)
   (let ((gesture (gensym))
? Flexichain/flexichain-package.fasl
? Flexichain/flexichain.fasl
? Flexichain/flexicursor.fasl
? Flexichain/skiplist-package.fasl
? Flexichain/skiplist.fasl
? Flexichain/utilities.fasl
? Flexichain/Doc/flexichain.aux
? Flexichain/Doc/flexichain.cb
? Flexichain/Doc/flexichain.dvi
? Flexichain/Doc/flexichain.idx
? Flexichain/Doc/flexichain.ilg
? Flexichain/Doc/flexichain.ind
? Flexichain/Doc/flexichain.log
? Flexichain/Doc/flexichain.ps
