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

[Christophe Rhodes]

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

Modified Files:
	esa.lisp 
Log Message:
Sync esa with climacs.

Date: Thu Nov  3 15:59:23 2005
Author: crhodes

Index: gsharp/esa.lisp
diff -u gsharp/esa.lisp:1.8 gsharp/esa.lisp:1.9
--- gsharp/esa.lisp:1.8	Tue Nov  1 10:50:16 2005
+++ gsharp/esa.lisp	Thu Nov  3 15:59:23 2005
@@ -212,8 +212,11 @@
 
 (defun process-gestures-or-command (frame command-table)
   (with-input-context 
-      (`(or menu-item (command :command-table ,(command-table (car (windows frame))))))
+      ('menu-item)
       (object)
+    (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*)
@@ -234,19 +237,19 @@
                   (execute-frame-command frame command)
                   (return)))
                (t nil))))))
-      (menu-item
-       (let ((command (command-menu-item-value object)))
-         (unless (listp command)
-           (setq command (list command)))       
-         (when (and (typep (frame-standard-input frame) 'interactor-pane)
-                    (member *unsupplied-argument-marker* command :test #'eq))
-           (setq command
-                 (command-line-read-remaining-arguments-for-partial-command
-                  (frame-command-table frame) (frame-standard-input frame) 
-                  command 0)))
-         (execute-frame-command frame command)))
       (command
-       (execute-frame-command frame object))))
+       (execute-frame-command frame object)))
+    (menu-item
+     (let ((command (command-menu-item-value object)))
+       (unless (listp command)
+         (setq command (list command)))       
+       (when (and (typep (frame-standard-input frame) 'interactor-pane)
+                  (member *unsupplied-argument-marker* command :test #'eq))
+         (setq command
+               (command-line-read-remaining-arguments-for-partial-command
+                (frame-command-table frame) (frame-standard-input frame) 
+                command 0)))
+       (execute-frame-command frame command)))))
 
 (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p)
   (declare (ignore force-p))
@@ -278,7 +281,12 @@
        do (restart-case
               (progn
                 (handler-case
-                    (process-gestures-or-command frame (command-table (car (windows frame))))
+                    (progn
+                      ;; for presentation-to-command-translators,
+                      ;; which are searched for in
+                      ;; (frame-command-table *application-frame*)
+                      (setf (frame-command-table frame) (command-table (car (windows frame))))
+                      (process-gestures-or-command frame (command-table (car (windows frame)))))
                   (abort-gesture () (display-message "Quit")))
                 (redisplay-frame-panes frame))
 	   (return-to-esa () nil))))))