#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $top = MainWindow->new;

$top->geometry('200x100');

my $text;
my $top_label = $top->Label( -textvariable => \$text )->pack;

my $menu = $top->Menu(
     -type    => 'menubar',
     -tearoff => 0
);

$top->configure( -menu => $menu );

my %menucommand = (
   Save      => { cmd => [ \&callback, 'Save'    ], acc => 'Ctrl+S' },
   'Save As' => { cmd => [ \&callback, 'Save As' ], acc => 'Ctrl+A' },
   ASCII     => { cmd => [ \&callback, 'ASCII'   ] },
   Hex       => { cmd => [ \&callback, 'Hex'     ] },
   Binary    => { cmd => [ \&callback, 'Binary'  ] },
   Open      => { cmd => [ \&callback, 'Open'    ] },
   Close     => { cmd => [ \&callback, 'Close'   ] },
   Exit      => { cmd => [ \&callback, 'Exit'    ] },
   Enter     => { cmd => [ \&callback, 'Enter'   ] },
   'Go Nuts' => { cmd => [ \&callback, 'Go Nuts' ] },
   Quit      => { cmd => [ \&callback, 'Quit'    ], acc => 'Ctrl+Q' },
   Stop      => { cmd => [ \&callback, 'Stop'    ] },
   Go        => { cmd => [ \&callback, 'Go'      ] },
   Up        => { cmd => [ \&callback, 'Up'      ] },
   Down      => { cmd => [ \&callback, 'Down'    ] },
);

addmenu( $menu, 'Save', 'Save', 'Save As', 'Quit' );
addmenu( $menu, 'Show source', qw/ASCII Hex Binary/ );
addmenu( $menu, 'Default Menu', '' );

$top->Button(
     -text    => 'This menu',
     -command => sub {
         $menu->delete('end');
         addmenu( $menu, 'This menu', qw/Enter Exit Stop Go/ );
     }
)->pack;

$top->Button(
     -text    => 'That menu',
     -command => sub {
         $menu->delete('end');
         addmenu( $menu, 'That menu', qw/Up Down Quit/, 'Go Nuts' );
     }
)->pack;

MainLoop;

sub callback {
     $text = "$_[0] was chosen!";
}

sub addmenu {
     my ( $menu, $label, @options ) = @_;
     my $sub_menu = $menu->cascade(
         -label   => $label,
         -tearoff => 0
     );

     for my $option (@options) {
         next unless defined $menucommand{$option};
         $sub_menu->command(
             -label       => $option,
             -command     => $menucommand{$option}{cmd},
             -accelerator => $menucommand{$option}{acc} || '',
         );
     }
}