CLIM mail archive


RE: Command tables/menus (CLIM 1.0)

>  From:       Curt Eggemeyer <>
>  This is a quickie how to question.  My situation is as follows:
>  I want each of my command-tables to appear as a single item on my
>  :command-menu pane.  When I click on one of them then a sub-menu of a
>  subset of the commands within that command-table to appear for selection.
>  I also want every command within all of my commands invokable from an
>  interactor pane. I know I can use add-menu-item-to-command-table or include the sub-command spec in the define-command-table :menu form, but that
>  means I have my menu specification separate from my command which seems
>  messy.  Is there a way to get something like the example below to do what
>  I want?  Is there something trivial I am missing?

I use "menu-choose-command-from-command-table" and
"execute-frame-command" quite often. Both are documented in the
manual. Maybe you could use that too.  There is some advantage in
writing an extra command for popping up a menu. It will allow you to
tie a menu also to a mouse gesture and every user gesture goes through a
command (I never use "menu-choose" for selecting operations, but use
commands instead).

I don't know whether this is the right way to do things, any comments?
cheers - Daniel

(defmacro execute-command-from-menu (frame
				     &optional (label "Choose a command")
					       (object nil))
  "Pops up a menu of a command table and executes a selected command"
  `(let ((command (menu-choose-command-from-command-table
		   :cache t
		   :default-style *pop-up-menu-font*
		   :associated-window (frame-top-level-window ,frame)
		   :label ,label)))
     (when command
       (if ,object
	   (execute-frame-command ,frame
				  ;; this builds a command object (cons of name + args)
				  (list (car command) ,object))
	 (execute-frame-command ,frame command)))

;; Example using this macro
(define-memolab-command (com-lab-exit-load-save-menu :menu "Exit/Load/Save..")
  (execute-command-from-menu *application-frame*
			     "Exit/Load/Save Menu"))

;; A command in the command table
(define-command (com-save-memolab-laboratory
		 :menu "SAVE Laboratory"
		 :command-table lab-exit-load-save-menu)
  (save-lab clim:*application-frame*)

;; .......

;; ----------------

;; Example of two different menus doing the same thing. In the first you can
;; click on an object and then select from the menu. In the second you first
;; select an object form a menu and then select a command.

;; pops up a menu of commands in a command-table
(define-memolab-command (com-direct-events-menu)
    ((obj 'lab-events :gesture :choice))
  (execute-command-from-menu *application-frame*
			     "Events Menu"

(defun object-and-operation-menu (stream object-list command-or-function
				  &optional (label "Make a Selection"))
  "takes a list of objects, lets the user select one and applies function"
  (let ((obj
	  `(,@(mapcar #'(lambda (obj)
			   (name-string obj)
			   :value obj))
	  ;; :cache t
	  :n-columns 3
	  :cell-align-x :left
	  :default-style *pop-up-menu-small-font*
	  :associated-window stream
	  :label label)
    (when obj
      (funcall command-or-function obj))))

;; makes a call to the command above
(define-command (com-display-events-then-direct-events-menu
		 :menu "DO something with an event"
		 :command-table lab-event-menu-table)
  (object-and-operation-menu (frame-top-level-window *application-frame*)
			     (lab-database-events (memolab-laboratory *application-frame*))
			     #'com-direct-events-menu  ;; <====
			     "Select an Event"))

Daniel K.Schneider, TECFA (Educational Technologies and Learning)
Faculte de Psychologie et des Sciences de l'Education, University of Geneva,
1211 Geneva 4 (Switzerland), Tel.(..41)22 705 7652, Fax. (..41) 22 20 29 27.

Internet:  (and various national nets)    | if reply
CSnet/ARPA:   (old style)      | does not
X400:       S=schneide;OU=divsun;O=unige;PRMD=switch;ADMD=arcom;C=ch | work,
uucp:       mcvax!cui!!shneider                       | try one
BITNET:     schneide@cgeuge51                                        | of
DECNET:     UGUN2A::SCHNEIDE (local Swiss)                           | these

Main Index | Thread Index