#!/usr/bin/perl use warnings; use strict; use Tk; my $mw=MainWindow->new; $mw->title('Menu Test'); my $menubar=$mw->Menu(-type=>'menubar'); $mw->configure(-menu=>$menubar); my $menu=$menubar->cascade(-label=>'~Menu'); my $menu_file=$menu->cascade(-label=>'~File', -tearoff=>0,); $menu_file->command( -label=>'~Open', -accelerator=>'Control+o', -command=>[\&print_it, 'Open']); $menu_file->command( -label=>'~Save', -accelerator=>'Control+s', -command=>[\&print_it, 'Save']); my $menu_edit=$menu->cascade(-label=>'~Edit'); $menu_edit->command( -label=>'C~ut', -accelerator=>'Control+x', -command=>[\&print_it, 'Cut']); $menu_edit->command( -label=>'~Copy', -accelerator=>'Control+c', -command=>[\&print_it, 'Copy']); my $exit=$mw->Button(-text=>'Exit', -command=>[$mw=>'destroy']); $mw->bind('',[\&print_it, 'Open']); $mw->bind('',[\&print_it, 'Save']); $mw->bind('',[\&print_it, 'Cut']); $mw->bind('',[\&print_it, 'Copy']); $exit->pack; MainLoop; sub print_it{ my $name=ref($_[0]) ? shift : ''; my $message=shift; print "message: '$message' ...\n"; }