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

RE: Command tables/menus (CLIM 1.0)

>  From:       Curt Eggemeyer <curt@eraserhead.jpl.nasa.gov>
>  
>  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
				     command-table
				     &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
		   ,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*
			     'lab-exit-load-save-menu
			     "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*
			     'lab-events-table
			     "Events Menu"
			     obj))


(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
	 (menu-choose
	  `(,@(mapcar #'(lambda (obj)
			  (list
			   (name-string obj)
			   :value obj))
		      object-list))
	  ;; :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:   schneide@divsun.unige.ch  (and various national nets)    | if reply
CSnet/ARPA: schneide%divsun.unige.ch@relay.cs.net   (old style)      | does not
X400:       S=schneide;OU=divsun;O=unige;PRMD=switch;ADMD=arcom;C=ch | work,
uucp:       mcvax!cui!divsun.unige.ch!shneider                       | try one
BITNET:     schneide@cgeuge51                                        | of
DECNET:     UGUN2A::SCHNEIDE (local Swiss)                           | these
Main Index | Thread Index