12.2.1. Menubars the Clunky, Casual, Old-Fashioned Way

Here's one way to do it using Perl/Tk 8. We begin by creating a normal Menu and configuring it as the MainWindow's menubar:

use Tk 800.000;

my $mw = MainWindow->new;
$mw->configure(-menu => my $menubar = $mw->Menu);

Now create the cascade menubuttons. We save each menubutton's reference—an object of type Tk::Menu::Cascade—so we can add the requisite menu items later. (Note that unlike almost every other Perl/Tk object, a Tk::Menu::Cascade object is built from an array rather than a hash.) Each menubutton is assigned an identifying label that's displayed on the menubutton. The tilde character (~) represents the -underline character and is merely a convenience feature.

We already know the menu system handles a Toplevel menu specially. Since we didn't specify -tearoff => 0 when the menu was created, there's an implicit tearoff at index 0, meaning that the File, Edit, and Help cascades are menu item indexes 1, 2, and 3, respectively. Further, menubutton cascades are arranged from left to right rather than from top to bottom.

my $file = $menubar->cascade(-label => '~File');
my $edit = $menubar->cascade(-label => '~Edit');
my $help = $menubar->cascade(-label => '~Help');

Now create the menu items for the File menu. The New menu item, $new, is another cascade, whose menu we'll populate in short order. It's visually set apart from the other menu items by a separator: a thin horizontal rule. Command menu items accept callbacks and act like Buttons. Notice that for each label, we've explicitly used the -underline option rather than a ~, just to show that they both work. The -accelerator option displays a keyboard shortcut designed to activate a menu item. Note that we are responsible for adding the proper binding (See Chapter 15, "Anatomy of the MainLoop").

my $new = $file->cascade(
    -label       => 'New',
    -accelerator => 'Ctrl-n',
    -underline   => 0,
);
$file->separator;
$file->command(
    -label       => 'Open',
    -accelerator => 'Ctrl-o',
    -underline   => 0,
);
$file->separator;
$file->command(
    -label       => 'Save',
    -accelerator => 'Ctrl-s',
    -underline   => 0,
);
$file->command(
    -label       => 'Save As ...',
    -accelerator => 'Ctrl-a',
    -underline   => 1,
);
$file->separator;
$file->command(
    -label       => "Close",
    -accelerator => 'Ctrl-w',
    -underline   => 0,
    -command     => \&exit,
);
$file->separator;
$file->command(
    -label       => "Quit",
    -accelerator => 'Ctrl-q',
    -underline   => 0,
    -command     => \&exit,
);

Similarly, let's create the menu items for the Edit and Help menubuttons:

$edit->command(-label => 'Preferences ...');

$help->command(-label => 'Version', -command => sub {print "Version\n"});
$help->separator;
$help->command(-label => 'About',   -command => sub {print "About\n"});

Now it's time to populate the File/New cascade menu. The second and third menu items (the tearoff is the first) are checkbuttons created by iterating over a list of two-element anonymous arrays. Checkbuttons toggle between two values: an -onvalue and an -offvalue, which default to 1 and 0, respectively. We want each checkbutton in a known state, so we supply our own initialized variables. If -variable isn't specified, Perl/Tk uses a hidden, uninitialized instance variable.

my($motif, $bisque) = (1, 0);

foreach (['Strict Motif', \$motif], ['Bisque', \$bisque]) {
   $new->checkbutton(
        -label    => $_->[0],
        -variable => $_->[1],
    );
}

To get to the actual checkbutton variable, we can do something like this:

my $vr = $new->cget(-menu)->entrycget('Bisque', -variable);
$$vr = 1;

This statement says, get the Menu reference for $new and, using that reference, get the -variable option value for the menu item whose label is Bisque. Now $vr is a reference to $bisque, which we de-reference and set "on."

The fourth menu item is another command, and the fifth a separator:

$new->command(-label => 'Widget');
$new->separator;

The sixth File/New menu item is yet another cascade, but this time we explicitly create its menu without a tearoff. It's important to note that the new menu must be a child of the current menu.

This highlights another special feature of the Perl/Tk menu system: we are not forced to explicitly create menus; Perl/Tk does that automatically when the first menu item is created. It's because of this behavior that we are forced to create a menu manually:

my $new_image = $new->cascade(
    -label => 'Image',
    -menu  => $new->cget(-menu)->Menu(-tearoff => 0),
);

The File/New/Image menu item is a cascade, so populate its menu with a radiobutton for each Photo image type (See Chapter 17, "Images and Animations"). Like with checkbuttons, Perl/Tk uses an uninitialized instance variable if we don't supply one.

my $new_image_format = 'png';
foreach (qw/bmp ppm gif png jpg tif/) {
    $new_image->radiobutton(
        -label    => $_,
        -variable => \$new_image_format,
    );
}

Whew. That was a lot of work! If you're wondering why there isn't an easier way to manipulate such a common construct, then wonder no longer, because there is, and it's quite elegant. Once again, Perl/Tk has another unique option, -menuitems, which lets us specify all our menu items with a data structure.

12.2.2. Menubars the Slick, Sophisticated, New-Fashioned Way

In the following code, we create a menubar, add the menubutton cascades, and hide all the menu item details in subroutines. This is simple, modular, concise, and extremely cool.

use Tk 800.000;
use subs qw/edit_menuitems file_menuitems help_menuitems/;

my $mw = MainWindow->new;
$mw->configure(-menu => my $menubar = $mw->Menu);

my $file = $menubar->cascade(
    -label => '~File', -menuitems => file_menuitems);

my $edit = $menubar->cascade(
    -label => '~Edit', -menuitems => edit_menuitems);

my $help = $menubar->cascade(
    -label => '~Help', -menuitems => help_menuitems);

If you have lots of menubuttons, you might like this map approach, which produces an identical result. Here we feed map a code block and a list of anonymous arrays to work with. The code block prepends a tilde to the first element of each anonymous array and uses that as the menu item's -label option. The second element of each anonymous array is a subroutine call, which is invoked and returns a value for -menuitems.

map {$menubar->cascade( -label => '~' . $_->[0], -menuitems => $_->[1] )}
    ['File', file_menuitems],
    ['Edit', edit_menuitems],
    ['Help', help_menuitems];

Regardless of how we do it, the -menuitems option is key. Obviously, its value must be a Perl scalar; in fact, -menuitems expects an array reference and, within each element of the array, yet another array reference to a list of options that describe one menu item. We thus have a list of lists. For example, here's a definition for one command menu item, with the label "Preferences ...":

sub edit_menuitems {
    [
      ['command', 'Preferences ...'],
    ];
}

The first element of a menu item definition is the type of menu item (cascade, checkbutton, command, or radiobutton), and the second element is its -label value. These two values are required, but any other valid menu item option(s) can follow. In the case of a command menu item, we normally include a -command callback option and sometimes -underline (but that can be tilde-specified as part of the label), -accelerator, and so on.

Here are the Help command menu item definitions, including their callbacks. The null string between the Version and About menu items generates a separator. (-menuitems treats any array element that's not an array reference as a separator.)

sub help_menuitems {
    [
      ['command', 'Version', -command => sub {print "Version\n"}],
      '',
      ['command', 'About',   -command => sub {print "About\n"}],
    ];
}

Obviously, -menuitems must be powerful enough to generate the complex File menu shown in Figure 12-1. Let's examine the code:

 1   sub file_menuitems {
 2
 3      # Create the menu items for the File menu.
 4  
 5      my($motif, $bisque) = (1, 0);
 6      my $new_image_format = 'png';
 7  
 8      [
 9        [qw/cascade ~New   -accelerator Ctrl-n -menuitems/ =>
10         [
11           ['checkbutton', 'Strict Motif', -variable => \$motif],
12           ['checkbutton', 'Bisque',       -variable => \$bisque],
13           [qw/command Widget/], '',
14           [qw/cascade Image -tearoff 0 -menuitems/ =>
15             [
16               map ['radiobutton', $_, -variable => \$new_image_format],
17                   qw/bmp ppm gif png jpg tif/,
18             ],
19           ],
20         ],
21       ],                                                      '',
22       [qw/command ~Open  -accelerator Ctrl-o/],               '',
23       [qw/command ~Save  -accelerator Ctrl-s/],
24       [qw/command/, 'S~ave As ...', qw/-accelerator Ctrl-a/], '',
25       [qw/command ~Close -accelerator Ctrl-w/],               '',
26       [qw/command ~Quit  -accelerator Ctrl-q -command/ => \&exit],
27     ];
28 
29   } # end file_menuitems

First, lines 8 through 27 encompass the array reference passed to -menuitems. Lines 22 through 26 define five command menu items (Open, Save, Save As, Close, and Quit) and three separators; we needn't go over this again. Lines 9 through 21 define the New menu item cascade and all its children. Let's look at the code more closely.

Line 5 declares and initializes the lexical variables used by the checkbuttons. The variables manage to survive past the end of the subroutine call because the checkbuttons keep references to them. Indeed, they'll never be destroyed until the checkbuttons go away and release the last reference.

Similarly, line 6 declares and initializes the default image format variables for the radiobuttons.

Line 9 declares the New cascade, the second File menu item (the tearoff is the first). Since cascades are menus that have their own menu items, we nest another -menuitems option, defined by lines 10 through 20.

Lines 11 though 19 define the menu items for the File/New menu. The first is the implicit tearoff, followed by the Strict Motif and Bisque checkbuttons (lines 11 and 12), the Widget command menu item, and a separator (line 13).

Line 14 generates the Image cascade, but its menu has no tearoff. Once again, we nest another -menuitems option, and lines 15 through 18 populate the menu.

Lines 16 and 17 define the radiobutton menu items for the File/New/Image menu, using the cool and concise map idiom.

If you've been paying close attention, you might be wondering if it's possible to specify a -menuitems option for the menubar itself; after all, the menubar is really just a menu filled with cascade menu items. As it happens, we can. First, delete the previous File/Edit/Help creation code and make these changes (shown here in bold) to our code:

use Tk 800.000;
use subs qw/edit_menuitems file_menuitems help_menuitems menubar_menuitems/;

my $mw = MainWindow->new;
$mw->configure(-menu => my $menubar = $mw->Menu(-menuitems => menubar_menuitems));

Then add subroutine menubar_menuitems, which returns a list of menubar cascades:

sub menubar_menuitems {

    [
      map ['cascade',  $_->[0], -menuitems => $_->[1]],
          ['~File', file_menuitems],
          ['~Edit', edit_menuitems],
          ['~Help', help_menuitems],
    ];

}

We can even go one more potentially ludicrous step and generate everything—menubar, menus, and menu items—from a single data structure. In this new version, all we've done is take the map construct and paste the File, Edit, and Help -menuitems definitions in place of a subroutine call. Gee, looks almost like assembly code.

use Tk 800.000;
use subs qw/menubar_etal/;
use strict;

my $mw = MainWindow->new;
$mw->configure(-menu => my $menubar = $mw->Menu(-menuitems => menubar_etal));

MainLoop;

sub menubar_etal {

    [
      map ['cascade',  $_->[0], -menuitems => $_->[1]],

          ['~File',
            [
              [qw/cascade ~New   -accelerator Ctrl-n -menuitems/ =>
                [
                  ['checkbutton', 'Strict Motif'],
                  ['checkbutton', 'Bisque'],
                  [qw/command Widget/], '',
                  [qw/cascade Image -tearoff 0 -menuitems/ =>
                    [
                      map ['radiobutton', $_],
                          qw/bmp ppm gif png jpg tif/,
                    ],
                  ],
                ],
              ],                                                      '',
              [qw/command ~Open  -accelerator Ctrl-o/],               '',
              [qw/command ~Save  -accelerator Ctrl-s/],
              [qw/command/, 'S~ave As ...', qw/-accelerator Ctrl-a/], '',
              [qw/command ~Close -accelerator Ctrl-w/],               '',
              [qw/command ~Quit  -accelerator Ctrl-q -command/ => \&exit],
            ],
          ],

          ['~Edit',
            [
              ['command', 'Preferences ...'],
            ],
          ],


          ['~Help',
            [
              ['command', 'Version', -command => sub {print "Version\n"}],
              '',
              ['command', 'About',   -command => sub {print "About\n"}],
            ],
          ],


    ];

} # end menubar_etal

The only things missing are the variables specifying the initial checkbutton and radiobutton values. We can make them file lexicals (globals) and include a -variable option, as we did previously. Or maybe limit their scope to some other block and pass references to them as formal parameters when calling menubar_etal. Or we can just use the default instance variables provided by Perl/Tk. All we need to know is how to access them.

It's easy because, once we have a reference to a Menu widget, we can entrycget and entryconfigure any menu item. Here we fetch the File Menu from the menubar cascade, the New Menu from the File cascade, and the Image Menu from the New cascade, and initialize the variables:

my $file_menu = $menubar->entrycget('File', -menu);
my $new_menu = $file_menu->entrycget('New', -menu);
my $image_menu = $new_menu->entrycget('Image', -menu);

my $motif = $new_menu->entrycget('Strict Motif', -variable);
$$motif = 1;
my $bisque = $new_menu->entrycget('Bisque', -variable);
$$bisque = 0;
my $new_image_format = $image_menu->entrycget('png', -variable);
$$new_image_format = 'png';