[mcclim-devel] Listener menus

[Christophe Rhodes]

Hi,

The attached restores working menus to the Listener.  (It's not
completely clean; I'll try to explain why).

The first thing to do, done in the middle hunk of the three-hunk
patch, is to put back the listener-view specializations to the
interactor and the pointer documentation.  (The latter isn't
necessary, but I think it's right anyway).

The first hunk is the magical one: it defines a command-or-form accept
method which treats menu-items specially.  The problem is that a
menu-item is a perfectly good form, at least according to the various
presentation translators around; therefore, the command-or-form input
context "captures" the menu item.  I'm not sure that this is ever
desired behaviour, but it's certainly not desired behaviour inside
read-frame-command of the listener, so we reintroduce an input context
for menu-item inside the command-or-form context, and throw to the
outer context handler established by the McCLIM-provided
read-frame-command :around method.

As I say, I'm not sure that it's ever desireable for 'expression or
'form input contexts to capture menu-items; if it isn't, then probably
mcclim itself ought to prevent it from happening, maybe by a similar
trick inside the system accept methods?  It all looks a bit horrible,
though.  It's not great for the user as it stands, though, because as
far as I can tell there's no standard menu-item presentation type --
the one that McCLIM implements is good, but it's not in Gilbert's
annotatable spec -- and the contents of *input-context* are explicitly
unspecified.

The third hunk of this diff is an alternative approach, handling
menu-items specially if they're returned from read-frame-command.
This feels clunkier somehow -- for instance, the menu-item objects are
printed at the repl -- but seems to violate fewer abstractions.

Comments?

Cheers,

Christophe

PS: when I apply this patch and click on a menu item for, say, Show
Class Subclasses, the resulting dialog box eats my first keystroke
using Drei, but not using Goatee.

-------------- next part --------------
Index: listener.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp,v
retrieving revision 1.31
diff -u -r1.31 listener.lisp
--- listener.lisp	3 Dec 2006 22:56:46 -0000	1.31
+++ listener.lisp	3 Jan 2007 17:14:37 -0000
@@ -155,6 +155,42 @@
 	  (values result ptype)
 	  (input-not-of-required-type result ptype)))))
 
+(define-presentation-method accept :around
+  ((type command-or-form) stream (view listener-view) &key)
+  (let ((command-ptype `(command :command-table ,command-table)))
+    (with-input-context (`(or ,command-ptype form))
+        (object type event options)
+        ;; FIXME: this is not really right.  The problem is that a
+        ;; MENU-ITEM is a STANDARD-OBJECT, which has a
+        ;; presentation-to-command translator to FORM.  The normal
+        ;; menu item handling is in an :AROUND method on
+        ;; READ-FRAME-COMMAND, but this means that the inner accept
+        ;; method for FORM implicit in COMMAND-OR-FORM shadows that
+        ;; handling.
+        ;;
+        ;; This input context restores menu-item as overriding form,
+        ;; which is probably what we want; the way it does it is
+        ;; sensitive to McCLIM internals, which is less like what we
+        ;; want.
+        ;;
+        ;; (one McCLIM internal is the existence of a MENU-ITEM
+        ;; presentation type at all; I couldn't find it in the spec;
+        ;; another is the existence of a handler for menu-item in
+        ;; *input-context*.)
+        (with-input-context ('menu-item)
+            (object type event options)
+            (let ((initial-char (read-gesture :stream stream :peek-p t)))
+              (if (member initial-char *command-dispatchers*)
+                  (progn
+                    (read-gesture :stream stream)
+                    (accept command-ptype :stream stream :view view :prompt nil))
+                  (accept 'form :stream stream :view view :prompt nil)))
+          (menu-item
+           (funcall (cdr (find 'menu-item *input-context* :key #'car))
+                    object type event options)))
+      (t
+       (funcall (cdar *input-context*) object type event options)))))
+
 ;;; Listener interactor stream.  If only STREAM-PRESENT were
 ;;; specializable on the VIEW argument, this wouldn't be necessary.
 ;;; However, it isn't, so we have to play this game.  We currently
@@ -181,8 +217,9 @@
   (:panes (interactor-container
            (make-clim-stream-pane
             :type 'listener-interactor-pane
-            :name 'interactor :scroll-bars t))
-          (doc :pointer-documentation)
+            :name 'interactor :scroll-bars t
+            :default-view +listener-view+))
+          (doc :pointer-documentation :default-view +listener-pointer-documentation-view+)
           (wholine (make-pane 'wholine-pane
                      :display-function 'display-wholine :scroll-bars nil
                      :display-time :command-loop :end-of-line-action :allow)))
@@ -229,12 +266,28 @@
 (defmethod read-frame-command ((frame listener) &key (stream *standard-input*))  
   "Specialized for the listener, read a lisp form to eval, or a command."
   (multiple-value-bind (object type)
-      (accept 'command-or-form :stream stream :prompt nil)
+      (let ((*command-dispatchers* '(#\,)))
+        (accept 'command-or-form :stream stream :prompt nil))
     (format *trace-output* "~&object=~W~%" object)
     (if (presentation-subtypep type 'command)
         object
         `(com-eval ,object))))
 
+#|
+        ;; FIXME: CLIM:MENU-ITEM isn't actually a defined type by the
+        ;; standard.  This stuff is hidden by the input context for
+        ;; FORM implicit in the COMMAND-OR-FORM acceptor
+        (if (typep object 'menu-item)
+            (let ((command (command-menu-item-value object)))
+              (unless (listp command)
+                (setq command (list command)))       
+              (if (and (typep stream 'interactor-pane)
+                       (member *unsupplied-argument-marker* command :test #'eq))
+                  (command-line-read-remaining-arguments-for-partial-command
+                   (frame-command-table frame) stream command 0)
+                  command))
+|#
+
 (defun print-listener-prompt (stream frame)
   (declare (ignore frame))
   (with-text-face (stream :italic)