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)