[mcclim-cvs] CVS mcclim

thenriksen thenriksen at common-lisp.net
Tue Jan 22 08:51:03 UTC 2008


Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv19045

Modified Files:
	commands.lisp frames.lisp 
Log Message:
Committed patch from Nikodemus Siivola fixing undefined variables.


--- /project/mcclim/cvsroot/mcclim/commands.lisp	2007/12/10 19:33:18	1.72
+++ /project/mcclim/cvsroot/mcclim/commands.lisp	2008/01/22 08:51:02	1.73
@@ -332,7 +332,7 @@
 	 (command-name-from-symbol command-name))
 	(errorp
 	 (error 'command-not-accessible :command-table-name
-                (command-table-designator-as-name table)))
+                (command-table-designator-as-name command-table)))
 	(t nil)))
 
 (defun find-menu-item (menu-name command-table &key (errorp t))
@@ -436,7 +436,7 @@
            (in-table (position gesture keystroke-accelerators :test #'equal)))
       (when (and in-table errorp)
         (error 'command-already-present :command-table-name
-               (command-table-designator-as-name table)))
+               (command-table-designator-as-name command-table)))
       (if in-table
 	  (setf (nth in-table keystroke-items) item)
 	  (progn
@@ -474,7 +474,7 @@
 		  (setf (cdr items-tail) (cddr items-tail))))
 	    (when errorp
 	      (error 'command-not-present :command-table-name
-                     (command-table-designator-as-name table)))))))
+                     (command-table-designator-as-name command-table)))))))
   nil)
 
 (defun map-over-command-table-keystrokes (function command-table)
@@ -499,7 +499,7 @@
 	  do (return-from find-keystroke-item (values item command-table)))
     (if errorp
 	(error 'command-not-present :command-table-name
-               (command-table-designator-as-name table))
+               (command-table-designator-as-name command-table))
 	nil)))
 
 (defun lookup-keystroke-item (gesture command-table
@@ -522,11 +522,11 @@
 		   (values sub-item sub-command-table))))))
        command-table))))
 
-(defun partial-command-from-name (command-name)
+(defun partial-command-from-name (command-name command-table)
   (let ((parser (gethash command-name *command-parser-table*)))
     (if (null parser)
         (error 'command-not-present :command-table-name
-               (command-table-designator-as-name table))
+               (command-table-designator-as-name command-table))
         (cons command-name
               (mapcar #'(lambda (foo)
                           (declare (ignore foo))
@@ -549,7 +549,7 @@
     (if item
 	(let* ((value (command-menu-item-value item))
 	       (command (case (command-menu-item-type item)
-			 (:command
+                          (:command
 			  value)
 			 (:function
 			  (funcall value gesture numeric-arg))
@@ -558,7 +558,7 @@
 	  (if command
               ; Return a literal command, or create a partial command from a command-name
 	      (substitute-numeric-argument-marker (if (symbolp command)
-                                                      (partial-command-from-name command)
+                                                      (partial-command-from-name command command-table)
                                                       command)
                                                   numeric-arg)
 	      gesture))
--- /project/mcclim/cvsroot/mcclim/frames.lisp	2008/01/01 00:27:34	1.128
+++ /project/mcclim/cvsroot/mcclim/frames.lisp	2008/01/22 08:51:02	1.129
@@ -521,13 +521,14 @@
       (object)
       (call-next-method)
     (menu-item
-     (let ((command (command-menu-item-value object)))
+     (let ((command (command-menu-item-value object))
+           (table (frame-command-table frame)))
        (unless (listp command)
-	 (setq command (partial-command-from-name command)))
+	 (setq command (partial-command-from-name command table)))
        (if (and (typep stream 'interactor-pane)
 		(partial-command-p command))
 	   (command-line-read-remaining-arguments-for-partial-command
-	    (frame-command-table frame) stream command 0)
+	    table stream command 0)
 	   command)))))
 
 (defmethod read-frame-command ((frame application-frame)




More information about the Mcclim-cvs mailing list