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)