A Menu by Name Package

If your application supports extensible or user-defined menus, 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 30-9 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 30-10, 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 30-10 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 86. 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 30-11 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 30-12 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 30-13 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 30-14 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 30-15 shows the Menu_Bind procedure that takes care of this.

Example 30-15 Keeping the accelerator display up to date

proc Menu_Bind { what sequence accText menuName label } {
   variable menu
   set m [MenuGet $menuName]
   if {[catch {$m index $label} index]} {
      error "$label not in menu $menuName"
   }
   bind $what $sequence [list MenuInvoke $m $index]
   $m entryconfigure $index -accelerator $accText
}
proc MenuInvoke {m index} {
   set state [$m entrycget $index -state]
   if {[string equal $state normal]} {
      $m invoke $index
   }
}

The Menu_Bind command uses the index operation to find out what menu entry has the given label. It sets up a binding for the key sequence that will invoke the menu operation, and 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.

The MenuInvoke procedure is used for the binding. We could use entrycget to fetch the command, and then bind directly to that. However, that wouldn't honor the state of the menu entry, which could be temporarily disabled. In addition, the invoke operation on the menu handles any special cases such as updating radiobutton variables associated with the entry.

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 <Control-q> Ctrl-Q Sampler Hello!