[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