mpage has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I have an application which will make a menu popup when you click button 1 which contains commands to do stuff...but I want it to disappear when button 1 is released. The effect I want is that while holding down the B1 you can drag your mouse down the list of commands and let go over one of them to initiate it and if you let go anywhere else (i.e. not over a menu command) the menu disappears. I bind B1-ButtonRelease to do an unpost() on the menu which is fine but while holding the button down the commands under the mouse wont activate...any ideas? Here's my code: 

#!/usr/bin/env perl
use Tk;
our $mw = MainWindow->new();
$mw->geometry('750x500');


$mw->Label(-text => 'Label 1')->pack();
$mw->Label(-text => 'Label 2')->pack();
$mw->Label(-text => 'Label 3')->pack();




$menu = $mw->Menu(-tearoff => 0);

$menu->add('separator');
$menu->add('command', -label => 'One', -command => \&item1);
$menu->add('command', -label => 'Two', -command => \&item2);
$mw->bind('<3>',                \&WorkspaceRightClick,        Ev('X'), Ev('Y'), Ev('W'));
$mw->bind('<B3-ButtonRelease>', \&WorkspaceRightClickRelease, Ev('X'), Ev('Y'), Ev('W'));

sub WorkspaceRightClick {
  my ($self, $x, $y, $widget) = @_;
  my $label = $widget->cget('-text');
  print "LABEL OF WIDGET UNDER ME IS $label\n";

  $menu->insert(1, 'command',
		-label => $label,
		-command => sub { print "Clicked $label.\n" },
	       );

  $menu->post($x, $y);
  $menu->delete(0,0);
}
sub WorkspaceRightClickRelease {
  my ($self, $x, $y, $widget) = @_;
  $menu->unpost();
}
sub item1 { print "Item 1!\n" }
sub item2 { print "Item 2!\n" }

MainLoop;
NOTE : if you comment out the ButtonRelease binding you can see the commands work .. but not while holding down the mouse..
  • Comment on tk menu commands dont work while button pressed

Replies are listed 'Best First'.
Re: tk menu commands dont work while button pressed
by Sandy (Curate) on Jan 23, 2009 at 22:04 UTC

    Believe it or not, the answer is really simple

    Try 

      $menu->Post($x, $y);

    [download]
    instead of 
      $menu->post($x, $y);

    [download]
    According to the Mastering Perl/Tk book (Steve Lidie & Nancy Walsh):
    The post and Post Methods

    The lower-level mechanism is the Menu post method, which posts a menu at a specific screen coordinate. The Post method works like post, but additioinally activates a specific menu item.

    I tried... it worked.

[reply]
[d/l]
[select]
      Sweet! Just like you say, thanks. Matt
[reply]
Re: tk menu commands dont work while button pressed
by zentara (Cardinal) on Jan 23, 2009 at 20:56 UTC
    I'm not sure what you are after, and I'm not the best at Tk menus. Maybe a cascade? 
    #!/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";
}

    [download]
    I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]
[d/l]
      I dont have any preference whether the new menu is a normal or cascade or whatever...I do need it to appear where the mouse is clicked, however...In my real application I'm binding the right click to a button somewhere in that frame...when pointing at the button the right click brings up a context-sensitive menu ...so I bind it to *that* button to bring up its special menu...if somehow I can have it bring up a cascade that's fine too...but when I modify to have the menu include a cascade like : 

      $menu->add('separator');
$menu->add('command', -label => 'One', -command => \&item1);
$menu->add('command', -label => 'Two', -command => \&item2);
$menu->add('cascade', 
       -label => 'Selections',
       );

      [download]

      it has the cascade item labeled "Selections" but holding down the button and dragging over it doesnt do what your cascade example does....can you modify yours somehow to have it create the cascade at the mouse x,y while holding down the mouse click and disappearing when release... matt
[reply]
[d/l]

Back to Seekers of Perl Wisdom