Update of /project/mcclim/cvsroot/mcclim
In directory cl-net:/tmp/cvs-serv22774
Modified Files:
commands.lisp
Log Message:
I feel ashamed of myself, but: commit a dubious fix to the infinite
recursion observed when accepting a command from a
drei-gadget dispatching command-table.
The problem is that the accept presentation method sets the
frame-command-table to the command-table from which the command is being
accepted, while the dispatching table arranges to inherit from the
frame-command-table dynamically, leading to an infinite explosion.
This "fix" is dubious for a number of reasons, two of which are: the
previous code is arguably "correct" in that it uses the established
command-enabled protocol for detecting whether a command is disabled
(though it is definitely weird that that necessitates mutating the
frame-command-table); and that the fix doesn't actually address every
instance of this problem, there being another in ESA:ESA-TOP-LEVEL.
--- /project/mcclim/cvsroot/mcclim/commands.lisp 2008/12/06 14:56:41 1.81
+++ /project/mcclim/cvsroot/mcclim/commands.lisp 2009/02/17 14:06:35 1.82
@@ -1202,17 +1202,31 @@
(let ((possibilities nil))
(map-over-command-table-names
(lambda (cline-name command-name)
- (when (command-enabled command-name *application-frame*)
+ (unless (member command-name (disabled-commands *application-frame*))
(pushnew (cons cline-name command-name) possibilities
:key #'car :test #'string=)))
command-table)
(loop for (cline-name . command-name) in possibilities
do (funcall suggester cline-name command-name)))))
- ;; Bind the frame's command table so that the command-enabled
- ;; test passes with this command table.
- (letf (((frame-command-table *application-frame*)
- (find-command-table command-table)))
- (multiple-value-bind (object success string)
+ ;; KLUDGE: here, we used to bind the frame's command table so that
+ ;; a test with COMMAND-ENABLED passed with the command-table being
+ ;; accepted from. Unfortunately, that interfered awfully with
+ ;; drei gadgets and their command-table inheritance; the dynamic
+ ;; inheritance from (frame-command-table *application-frame*) [
+ ;; which is needed to get things like frame menu items and other
+ ;; commands to work ] works really badly if (frame-command-table
+ ;; *application-frame*) is set/bound to the dispatching
+ ;; command-table itself.
+ ;;
+ ;; Instead we now use the knowledge of how disabled commands are
+ ;; implemented to satisfy the constraint that only enabeled
+ ;; commands are acceptable (with the "accessible" constraint being
+ ;; automatically satisfied by the generator mapping over the
+ ;; command-table).
+ ;;
+ ;; This means that someone implementing their own version of the
+ ;; "enabled-command" protocol will lose. Sorry. CSR, 2009-02-17
+ (multiple-value-bind (object success string)
(complete-input stream
#'(lambda (so-far mode)
(complete-from-generator so-far
@@ -1222,7 +1236,7 @@
:partial-completers '(#\space))
(if success
(values object type)
- (simple-parse-error "No command named ~S" string))))))
+ (simple-parse-error "No command named ~S" string)))))
(defun command-line-command-parser (command-table stream)
(let ((command-name nil)