[mcclim-cvs] CVS mcclim

[crhodes]

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)