| If your application supports extensible or user-defined menus, then it can be tedious to expose all the details of the Tk menus. The examples in this section create a little package that lets users refer to menus and entries by name. In addition, the package keeps keystroke accelerators for menus consistent with bindings. The Menu_Setup procedure initializes the package. It creates a frame to hold the set of menu buttons, and it initializes some state variables: the frame for the menubuttons and a counter used to generate widget pathnames. All the global state for the package is kept in the array called menu. The Menu procedure creates a menubutton and a menu. It records the association between the text label of the menubutton and the menu that was created for it. This mapping is used throughout the rest of the package so that the client of the package can refer to the menu by its label (e.g., File) as opposed to the internal Tk pathname, (e.g., .top.menubar.file.menu). Example 27-8 A simple menu by name package. proc Menu_Setup { menubar } { global menu frame $menubar pack $menubar -side top -fill x set menu(menubar) $menubar set menu(uid) 0 } proc Menu { label } { global menu if [info exists menu(menu,$label)] { error "Menu $label already defined" } # Create the menubutton and its menu set name $menu(menubar).mb$menu(uid) set menuName $name.menu incr menu(uid) set mb [menubutton $name -text $label -menu $menuName] pack $mb -side left menu $menuName -tearoff 1 # Remember the name to menu mapping set menu(menu,$label) $menuName } These procedures are repeated in Example 27-9, except that they use the Tk 8.0 menu bar mechanism. The rest of the procedures in the package are the same with either version of menu bars. Example 27-9 Using the Tk 8.0 menu bar facility. proc Menu_Setup { menubar } { global menu menu $menubar # Associated menu with its main window set top [winfo parent $menubar] $top config -menu $menubar set menu(menubar) $menubar set menu(uid) 0 } proc Menu { label } { global menu if [info exists menu(menu,$label)] { error "Menu $label already defined" } # Create the cascade menu set menuName $menu(menubar).mb$menu(uid) incr menu(uid) menu $menuName -tearoff 1 $menu(menubar) add cascade -label $label -menu $menuName # Remember the name to menu mapping set menu(menu,$label) $menuName } Once the menu is set up, the menu array is used to map from a menu name, like File, to the Tk widget name such as .menubar.mb3. Even though this can be done with a couple of lines of Tcl code, the mapping is put inside the MenuGet procedure to hide the implementation. MenuGet uses return -code error if the menu name is unknown, which changes the error reporting slightly as shown in Example 6-19 on page 80. If the user specifies a bogus menu name, the undefined variable error is caught and a more informative error is raised instead. MenuGet is private to the package, so it does not have an underscore in its name. Example 27-10 MenuGet maps from name to menu. proc MenuGet {menuName} { global menu if [catch {set menu(menu,$menuName)} m] { return -code error "No such menu: $menuName" } return $m } The procedures Menu_Command, Menu_Check, Menu_Radio, and Menu_Separator are simple wrappers around the basic menu commands. They use MenuGet to map from the menu label to the Tk widget name. Example 27-11 Adding menu entries. proc Menu_Command { menuName label command } { set m [MenuGet $menuName] $m add command -label $label -command $command } proc Menu_Check { menuName label var {command {}}} { set m [MenuGet $menuName] $m add check -label $label -command $command \ -variable $var } proc Menu_Radio {menuName label var {val {}} {command {}}} { set m [MenuGet $menuName] if {[string length $val] == 0} { set val $label } $m add radio -label $label -command $command \ -value $val -variable $var } proc Menu_Separator { menuName } { [MenuGet $menuName] add separator } Creating a cascaded menu also requires saving the mapping between the label in the cascade entry and the Tk pathname for the submenu. This package imposes a restriction that different menus, including submenus, cannot have the same label. Example 27-12 A wrapper for cascade entries. proc Menu_Cascade { menuName label } { global menu set m [MenuGet $menuName] if [info exists menu(menu,$label)] { error "Menu $label already defined" } set sub $m.sub$menu(uid) incr menu(uid) menu $sub -tearoff 0 $m add cascade -label $label -menu $sub set menu(menu,$label) $sub } Creating the sampler menu with this package looks like this: Example 27-13 Using the menu by name package. Menu_Setup .menubar Menu Sampler Menu_Command Sampler Hello! {puts "Hello, World!"} Menu_Check Sampler Boolean foo {puts "foo = $foo"} Menu_Separator Sampler Menu_Cascade Sampler Fruit Menu_Radio Fruit apple fruit Menu_Radio Fruit orange fruit Menu_Radio Fruit kiwi fruit Menu Accelerators  | The final touch on the menu package is to support accelerators in a consistent way. A menu entry can display another column of information that is assumed to be a keystroke identifier to remind users of a binding that also invokes the menu entry. However, there is no guarantee that this string is correct, or that if the user changes the binding that the menu will be updated. Example 27-14 shows the Menu_Bind procedure that takes care of this. |
Example 27-14 Keeping the accelerator display up to date. proc Menu_Bind { what sequence menuName label } { global menu set m [MenuGet $menuName] if [catch {$m index $label}index] { error "$label not in menu $menuName" } set command [$m entrycget $index -command] bind $what $sequence $command $m entryconfigure $index -accelerator $sequence } The Menu_Bind command uses the index operation to find out what menu entry has the given label. It gets the command for that entry with entrycget and uses this command in a binding. It updates the display of the accelerator using the entryconfigure operation. This approach has the advantage of keeping the keystroke command consistent with the menu command, as well as updating the display. To try Menu_Bind, add an empty frame to the sampler example, and bind a keystroke to it and one of the menu commands, like this: frame .body -width 100 -height 50 pack .body ; focus .body Menu_Bind .body <space> Sampler Hello! | 
