CLIM mail archive
[Prev][Next][Index][Thread]

bucky keys on cmd-menu items

    Date: Mon, 2 Nov 1992 13:18 EST
    From: Clinton Hyde <chyde@chesapeake.ads.com>

    I'd like to use other keys, (shift, control, meta...) on normal
    command-menu items. they seem to get born with :left and :right
    pres-translators; what do I need to do to get a :middle or a
    :shift-left attached to one?

Unfortunately, presentation translators store their gesture in the
translator object instead of in the command table, so this means that a
translator only gets to be on one gesture, which in turn means that you
can't re-add a translator to a command table using an additional gesture.
Alas, I don't think this will be fixed in CLIM 2.0.

So here are the menu item translator(s).  You can do two things with
them:  (1) give them new name(s) for new gesture(s), or (2) give them
:GESTURE T to make them work for all gestures.

(in-package :clim)	;for CLIM 1.1

(define-presentation-translator menu-item-identity
    (menu-item menu-item global-command-table
     :priority 1		;prefer this to IDENTITY
     :tester-definitive t
     :documentation ((object stream)
		     (let ((documentation (or (menu-item-documentation object)
					      (menu-item-display object))))
		       (write documentation :stream stream :escape nil)))
     :gesture :select)
    (object presentation)
  (values object (presentation-type presentation)))

(define-presentation-translator command-menu-element-to-command
    (command-menu-element command global-command-table
     :tester
       ((object event)
	(let* ((menu-item (third object))
	       (type (command-menu-item-type menu-item)))
	  (and (or (eql type ':command)
		   (eql type ':function))
	       (command-enabled
		 (command-name (extract-command-menu-item-value menu-item event))
		 *application-frame*))))
     :tester-definitive t
     ;; The pointer-documentation uses this, too
     :documentation
       ((object presentation context-type frame event window x y stream)
	(let ((documentation (getf (command-menu-item-options (third object)) :documentation)))
	  (if documentation
	      (write-string documentation stream)
	      (document-presentation-to-command-translator
		(find-presentation-translator 'command-menu-element-to-command
					      'global-command-table)
		presentation context-type frame event
		window x y stream)))))
    (object event)
  (extract-command-menu-item-value (third object) event))

(define-presentation-translator command-menu-element-to-sub-menu
    (command-menu-element command global-command-table
     :tester
       ((object)
	(let ((menu-item (third object)))
	  (and (eql (command-menu-item-type menu-item) ':menu)
	       (let ((comtab (find-command-table
			       (command-menu-item-value menu-item)
			       :errorp nil)))
		 (and comtab
		      (slot-value comtab 'menu)
		      ;; You might think that including the following in the
		      ;; tester is reasonable (that is, make the translator
		      ;; applicable only if the context's command table inherits
		      ;; from the command table that this menu item points to.)
		      ;; Unfortunately, that doesn't work because command table
		      ;; inheritance isn't the only way to get something into a
		      ;; command table.  The only alternative is to recursively
		      ;; walk over the sub-menu(s) to see if at least one command
		      ;; is applicable.
		      #+++ignore
		      (with-presentation-type-parameters (command context-type)
			(command-table-presentation-subtypep command-table comtab)))))))
     :tester-definitive t
     ;; The pointer-documentation uses this, too
     :documentation
       ((object stream)
	(write-string (first object) stream)
	(write-char #\Space stream)
	(write-string "Menu" stream)))
    (object window)
  (values
    (menu-execute-command-from-command-table
      (command-menu-item-value (third object))
      :associated-window window :cache t)))


0,,
References:
Main Index | Thread Index