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

[Christophe Rhodes]

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

Modified Files:
	esa.lisp 
Log Message:
Play whack-a-mole with bugs exposed by tabedit: change the 
frame-command-table along with reading gestures or commands from that 
command table, so that presentation translators can be found.

Date: Thu Nov  3 15:58:53 2005
Author: crhodes

Index: climacs/esa.lisp
diff -u climacs/esa.lisp:1.22 climacs/esa.lisp:1.23
--- climacs/esa.lisp:1.22	Tue Nov  1 10:51:03 2005
+++ climacs/esa.lisp	Thu Nov  3 15:58:52 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))))))