in reply to perl tk popup menu

No problem. Here ya go: 

#!/usr/bin/perl

use Tk;
use Tk::Menu;

# Create main window.
$mw = MainWindow->new();

# Create menu.
$menu = $mw->Menu();

# Add items to menu.
$menu->add('command', -label => 'One', -command => \&item1);
$menu->add('command', -label => 'Two', -command => \&item2);

# Set up binding so that, when the right mouse button (3)
# is clicked on the main window ($mw), &showmenu() is
# called and is given the x and y coordinates of the click.
$mw->bind('<3>', [\&showmenu, Ev('x'), Ev('y')]);

# Start the program, with the main window in the front.
$mw->focus();
MainLoop;

# Called when right mouse button is clicked on the main window.
sub showmenu {
  my ($self, $x, $y) = @_;
  $menu->post($x, $y);  # Show the popup menu
}

# Called when menu items are selected.
sub item1 { print "Item 1!\n" }
sub item2 { print "Item 2!\n" }

[download]

Update: Added comments (sorry, I was late for work).

Update2: If, by saying "... so you can right click anywhere and see that menu popup ...", you mean that even clicking on widgets in the window, the pop-up would be displayed, I don't think that's very easy. I'm pretty sure that bindings are not inherited by child widgets, and the click is not passed-through to the parent, either. I'm not certain about this, and I'm at work now so I can't test it. If not, you could probably write some sort of loop that would cycle through all the children of a widget (aka window) and either create a binding that would pass-through the click event, or just copy the bindings from the parent to the child. Not sure how feasable this would be. Anyone have any more info on this, or whether bindings are inherited or events passed through?

Update3: To answer my own question... According to the docs for Tk::bind and Tk::bindtags, the default set of tags for a widget includes the nearest Toplevel ancestor. So, yes, bindings should be inherited (at least, that's the way I read it).

bbfu
Seasons don't fear The Reaper.
Nor do the wind, the sun, and the rain.
We can be like they are.

Replies are listed 'Best First'.
Re: (bbfu) (here's an example) Re: perl tk popup menu
by Eradicatore (Monk) on Nov 09, 2001 at 03:35 UTC
    Great! Thank you so much. One additional quick question, although I think this question is more involved. It would seem to me that I could save memory by only creating one popup menu and dynamically setting the values in it based on where in my application the user right clicked.

    For example. Let's say I have 40 label widgets in a grid, and I want the user to be able to right click on any one of the label's and the menu would then contain the text from that label in the buttons of the menu. I can use the postcommand option easily enough to reconfigure the menu, but the problem would be knowing what label was under the mouse when the user right clicked. Is there a way to do that without making a big mess?

    Of course I could make a different menu for each label, and bind the menu just to the given label widget, but that would use more memory. I'd rather optimize for space than speed in this case, but seeing as I'm already doing perl and tk, maybe saving memory is a lost cause...
    Thanks for your help and any future info!
[reply]

      I'd say, especially if your menu will contain mostly the same stuff except for the label text, you should definately re-use the popup menu. Update: Though, if your menus are going to be completely different depending on where the user clicked, it would probably make more sense to pre-generate all the menus. Unless you have a lot of them. I guess, uh, it just depends. ;-)

      As for how to tell what label was under the mouse, just use the 'W' parameter to Ev(), like so: 

      # this is all documented under Tk::bind
$mw->bind('<3>', [\&callback, Ev('X'), Ev('Y'), Ev('W')]);

      [download]

      ...and it should pass you a reference to the widget that was clicked upon (as the fourth parameter).

      Update: Oh, and, uh, you'd have to alter the menu within the callback that shows it (just before posting) because I don't know of an easy way to pass an argument (ie, the clicked widget) to the postcommand() method.

      Update2: Uh, like this: :-) 

      #!/usr/bin/perl

use Tk;
use Tk::Menu;

$mw = MainWindow->new();

$menu = $mw->Menu(-tearoff => 0);
$menu->add('separator');
$menu->add('command', -label => 'One', -command => \&item1);
$menu->add('command', -label => 'Two', -command => \&item2);

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

$mw->bind('<3>', [\&showmenu, Ev('X'), Ev('Y'), Ev('W')]);
$mw->focus();
MainLoop;

sub showmenu {
  my ($self, $x, $y, $widget) = @_;
  my $label = $widget->cget('text');
  $menu->insert(0, 'command',
    -label => $label,
    -command => sub { print "Clicked $label.\n" },
  );
  $menu->post($x, $y);
  $menu->delete(0,0);
}

sub item1 { print "Item 1!\n" }
sub item2 { print "Item 2!\n" }

      [download]

      bbfu
      Seasons don't fear The Reaper.
      Nor do the wind, the sun, and the rain.
      We can be like they are.

[reply]
[d/l]
[select]
      I tried the example Perl code. In order to make it work, I had to make three changes:
    • change the hashbang line from #!/usr/bin/perl to #!/usr/bin/env perl
    • change the cget() call from cget('text') to cget('-text')
    • change the insert() call from insert(0,...) to insert(1,...)
[reply]

In Section Seekers of Perl Wisdom