[gsharp-cvs] CVS update: gsharp/esa.lisp

[Christophe Rhodes]

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv11314

Modified Files:
	esa.lisp 
Log Message:
OK, no-one complained anywhere, so commit the rearrangement of esa's 
toplevel so that the window's command-table is reloaded every time, 
rather than just after abort gestures.  This makes it possible to change 
the active command table

Date: Fri Oct 28 18:20:47 2005
Author: crhodes

Index: gsharp/esa.lisp
diff -u gsharp/esa.lisp:1.5 gsharp/esa.lisp:1.6
--- gsharp/esa.lisp:1.5	Sat Oct  1 11:37:32 2005
+++ gsharp/esa.lisp	Fri Oct 28 18:20:47 2005
@@ -210,29 +210,32 @@
 (defun substitute-numeric-argument-p (command numargp)
   (substitute numargp *numeric-argument-p* command :test #'eq))
 
-(defun process-gestures (frame command-table)
-  (loop
-   for gestures = '()
-   do (multiple-value-bind (numarg numargp)
-	  (read-numeric-argument :stream *standard-input*)
-	(loop 
-	 (setf *current-gesture* (esa-read-gesture))
-	 (setf gestures 
-	       (nconc gestures (list *current-gesture*)))
-	 (let ((item (find-gestures-with-inheritance gestures command-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))
-		(execute-frame-command frame command)
-		(return)))
-	     (t nil)))))
-   do (redisplay-frame-panes frame)))
+(defun process-gestures-or-command (frame command-table)
+  (with-input-context 
+      (`(command :command-table ,(command-table (car (windows frame)))))
+      (object)
+      (let ((gestures '()))
+        (multiple-value-bind (numarg numargp)
+            (read-numeric-argument :stream *standard-input*)
+          (loop 
+           (setf *current-gesture* (esa-read-gesture))
+           (setf gestures 
+                 (nconc gestures (list *current-gesture*)))
+           (let ((item (find-gestures-with-inheritance gestures command-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))
+                  (execute-frame-command frame command)
+                  (return)))
+               (t nil))))))
+      (t
+       (execute-frame-command frame object))))
 
 (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p)
   (declare (ignore force-p))
@@ -261,22 +264,13 @@
 	  (*abort-gestures* `((:keyboard #\g ,(make-modifier-state :control)))))
       (redisplay-frame-panes frame :force-p t)
       (loop
-       for maybe-error = t
        do (restart-case
-	   (progn
-	     (handler-case
-	      (with-input-context 
-		  (`(command :command-table ,(command-table (car (windows frame)))))
-		  (object)
-		  (process-gestures frame (command-table (car (windows frame))))
-		(t
-		 (execute-frame-command frame object)
-		 (setq maybe-error nil)))
-	      (abort-gesture () (display-message "Quit")))
-	     (when maybe-error
-	       (beep))
-	     (redisplay-frame-panes frame))
-	   (return-to-climacs () nil))))))
+              (progn
+                (handler-case
+                    (process-gestures-or-command frame (command-table (car (windows frame))))
+                  (abort-gesture () (display-message "Quit")))
+                (redisplay-frame-panes frame))
+	   (return-to-esa () nil))))))
 
 (defmacro simple-command-loop (command-table loop-condition end-clauses)
   (let ((gesture (gensym))