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

Re: More Pull-Down Questions

>      ... I can use a (CLIM:MAKE-PANE 'CLIM:MENU-BAR  ...) form in the
>    frame definition.
>
>    This works fine, except that it draws some items in a weird way.
>    Specifically, if you give the pane background and foreground inks it draws
>    items which have full-blown pull-down-menus under them just fine.  However
>    items in the menu-bar that are simply commands get drawn in the regular
>    "default" back/foreground colors.  [...]
>
>If you could, could you send me a little test frame that does this?  I
>dunno if Genera's home-grown menu bars will do the right thing, and it
>would be nice to fix any bugs that might be there.

Scott

Below is the example code.  It brings up a simple frame with a menu bar
containing three items: a simple "Quit" command and two pulldown menus.
The menubar is drawn as red on blue.

The bug was that the items for the pulldowns were drawn as expected but the
"Quit" command was drawn as black on white (i.e. the defaults).

1] It turns out this bug has been fixed in the most recent Allegro/Clim
(the platform on which I'm working).

2] I posted this result here on the list (i.e. rather than just to Scott)
because --except for the possible color problem-- it is a simple working
example of the pulldown/cascading menus which I thought others might find
useful.  

Nichael

(P.S. Have a happy turkey.)

---<snip>------<snip>------<snip>------<snip>------<snip>------<snip>---
;;; -*- Syntax: Common-lisp; Package: USER -*-

(in-package :user)

;;;************************************************************************
;;; Simple example of pulldown/cascading menus.
;;; (Note: In the real world much of this might want to be macro-ized.)
;;;************************************************************NLC-11/23/9
;;;
;;; Items in the first pulldown menu.
;;;
(clim:define-command-table pulldown-command-table-1)

(clim:define-command (pulldown-item-1-A :command-table pulldown-command-table-1) ()
  (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-1 "Item 1-A"
				     :command 'pulldown-item-1-A)
(clim:define-command (pulldown-item-1-B :command-table pulldown-command-table-1) ()
  (clim:beep) (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-1 "Item 1-B"
				     :command 'pulldown-item-1-B)
(clim:define-command (pulldown-item-1-C :command-table pulldown-command-table-1) ()
  (clim:beep) (clim:beep) (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-1 "Item 1-C"
				     :command 'pulldown-item-1-C)

;;;
;;; Items in the second pulldown menu.
;;;
(clim:define-command-table pulldown-command-table-2)

(clim:define-command (pulldown-item-2-A :command-table pulldown-command-table-2) ()
  (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-2 "Item 2-A"
				     :command 'pulldown-item-2-A)

(clim:define-command (pulldown-item-2-B :command-table pulldown-command-table-2) ()
  (clim:beep) (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-2 "Item 2-B"
				     :command 'pulldown-item-2-B)

(clim:define-command (pulldown-item-2-C :command-table pulldown-command-table-2) ()
  (clim:beep) (clim:beep) (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-2 "Item 2-C"
				     :command 'pulldown-item-2-C)

;;; Sub-menu item
(clim:define-command-table pulldown-command-table-2-D)

(clim:define-command (pulldown-item-2-D-i :command-table pulldown-command-table-2-D) ()
  (clim:beep)) 

(clim:add-menu-item-to-command-table 'pulldown-command-table-2-D "Item 2-D-i"
				     :command 'pulldown-item-2-D-i)
(clim:define-command (pulldown-item-2-D-ii :command-table pulldown-command-table-2-D) ()
  (clim:beep) (clim:beep))

(clim:add-menu-item-to-command-table 'pulldown-command-table-2-D "Item 2-D-ii"
				     :command 'pulldown-item-2-D-ii)
(clim:define-command (pulldown-item-2-D-iii :command-table pulldown-command-table-2-D) ()
  (clim:beep) (clim:beep) (clim:beep)) 
(clim:add-menu-item-to-command-table 'pulldown-command-table-2-D "Item 2-D-iii"
				     :command 'pulldown-item-2-D-iii)

;;; Add the Sub-menu item to the parent pulldown
(clim:add-menu-item-to-command-table 'pulldown-command-table-2 "SubMenu 2-D"
				     :menu 'pulldown-command-table-2-D)


;;;
;;; Frame and main command table.
;;;
(clim:define-application-frame my-frame ()
  ()
  (:menu-bar nil)
  (:panes
   (my-bar (clim:make-pane 'clim:menu-bar
			   :command-table 'my-command-table
			   :background clim:+blue+
			   :foreground clim:+red+))
   (display :application))
  (:layouts
   (default (clim:vertically ()
	      my-bar
	      (clim:outlining ()
		display))))
  (:command-table my-command-table)
  )

;;; The frame's command-table needs to inherit from everybody.
(clim:define-command-table my-command-table :inherit-from (pulldown-command-table-1
							   pulldown-command-table-2
							   pulldown-command-table-2-D
							   ))

;;;
;;; Add simple command and pulldown menus to the frame's command-table's
;;; menu.
;;;
(define-my-frame-command (com-quit :menu t) ()
  (clim:frame-exit clim::*application-frame*))

(clim:add-menu-item-to-command-table 'my-command-table "PullDown 1" 
				     :menu 'pulldown-command-table-1)
(clim:add-menu-item-to-command-table 'my-command-table "PullDown 2" 
				     :menu 'pulldown-command-table-2)

;;;
;;; Simple Launcher function.
;;;
(defvar *MY-FRAME* nil)

(defun my-frame (&key (FORCE-NEW? nil))
  (and FORCE-NEW?
       (setq *MY-FRAME* nil))
  (let ((FRAME (or *MY-FRAME*
		   (setf *MY-FRAME*
		     (clim::make-application-frame 'my-frame
						   :width 500
						   :height 300)))))
    (mp:process-run-function "my-frame" #'clim:run-frame-top-level FRAME)))

;;; (my-frame)
Main Index | Thread Index