in reply to tk menu commands dont work while button pressed
#!/usr/bin/perl use warnings; use strict; use Tk; my $top = MainWindow->new; $top->geometry('100x100+100+100'); my $menu = $top->Menu( -type => 'menubar' ); $top->configure( -menu => $menu ); $menu->Cascade( -label => '~Selections', -tearoff => 1, -menuitems => [ [ Button => 'Level 1 choice 1', -command => [ \&printchoice, 'L1-C1' ] ], [ Button => 'Level 1 choice 2', -command => [ \&printchoice, 'L1-C2' ] ], [ Button => 'Level 1 choice 3', -command => [ \&printchoice, 'L1-C3' ] ], '', [ Cascade => 'Cascade 1', -tearoff => 0, -menuitems => [ [ Button => 'Cascade 1 Level 2 choice 1', -command => [ \&printchoice, 'C1-L2-C1' ] ], [ Button => 'Cascade 1 Level 2 choice 2', -command => [ \&printchoice, 'C1-L2-C2' ] ], [ Button => 'Cascade 1 Level 2 choice 3', -command => [ \&printchoice, 'C1-L2-C3' ] ], ] ], [ Cascade => 'Cascade 2', -tearoff => 0, -menuitems => [ [ Button => 'Cascade 2 Level 2 choice 1', -command => [ \&printchoice, 'C2-L2-C1' ] ], [ Button => 'Cascade 2 Level 2 choice 2', -command => [ \&printchoice, 'C2-L2-C2' ] ], [ Cascade => 'Cascade 3', -tearoff => 0, -menuitems => [ [ Button => 'Cascade 3 Level 3 choice 1', -command => [ \&printchoice, 'C3-L3-C1' ] ], [ Button => 'Cascade 3 Level 3 choice 2', -command => [ \&printchoice, 'C3-L3-C2' ] ], [ Button => 'Cascade 3 Level 3 choice 3', -command => [ \&printchoice, 'C3-L3-C3' ] ], [ Cascade => 'Cascade 4', -tearoff => 0, -menuitems => [ [ Button => 'Cascade 4 Level 4 choic +e 1', -command => [ \&printchoice, 'C4-L +4-C1' ] ], [ Button => 'Cascade 4 Level 4 choic +e 2', -command => [ \&printchoice, 'C4-L +4-C2' ] ], [ Button => 'Cascade 4 Level 4 choic +e 3', -command => [ \&printchoice, 'C4-L +4-C3' ] ], ] ] ] ], ] ], ] ); MainLoop; sub printchoice { my $choice = shift; print $choice, "\n"; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: tk menu commands dont work while button pressed
by mpage (Initiate) on Jan 23, 2009 at 21:22 UTC |