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

I always think i've found something that doesn't work because it doesn't work for me and then i learn better. Hopefully nothing has changed!

Today's frustration is using 'active' as an index in Tk::Menu.

I have a menu which is a list of files, and i want to bind keys so that multiple actions are available when an entry is active, distinct from the command which would be invoked by clicking the entry. I thought the way to do this would be (something like) this:
#!/usr/bin/perl use strict; use Tk; my $MW = MainWindow->new; my $menu = $MW -> Menu(-type=>'menubar',-tearoff=>0); $MW -> configure(-menu=>$menu); $MW -> bind("<Key-F1>"=>[\&printentry]); my $MM = $menu -> cascade(-label=>'menu',-underline=>0,-tearoff=>0); my $one = $MM -> command(-label=>'one',-command=>sub{}); my $two = $MM -> command(-label=>'two',-command=>sub{}); my $three = $MM -> command(-label=>'three',-command=>sub{}); MainLoop; sub printentry { my $whM = $menu->entrycget('active','-label'); print "active:$whM\t"; }
The problem:


Using a key would seem to be the only way to go, because if you move off the menu and click anything the menu disappears or their is no real active entry. Unfortunately, the binding only works when the first level cascade is active (highlighted), before it is clicked, and never when any cascade is in use. More unfortunately, 'active' never returns a value even if "one" is highlighted (active).

Considering this, the use of 'active' as the index, which is documented, can never actually apply (except on "one" "two" "three"; but then it doesn't...) Ie, if you substitute '0' or '1' or '2' for 'active', you will get a value. nb. if it did work, i believe ->configure could be used to get the same information from the active cascade (entrycget cannot) SO PLEASE DON'T TELL ME "$menu isn't $MM" ETC.

Replies are listed 'Best First'.
Re: Tk! (entrycget w/ 'active')
by eserte (Deacon) on Mar 08, 2008 at 13:44 UTC
    I think that Tk's Clone implementation causes problems here. Every menu in Tk has one or more clones which spring off in various situations, e.g. if using the tearoff feature or probably also when simply popping up the menu.

    So you need to bind and operate on clones, too. Here's a hack which seems to work:

    ... my $clone; $MW->Walk(sub { if ($_[0]->isa("Tk::Menu") && $_[0]->Master +Menu eq $MM->menu) { $clone = $_[0] }}); $clone -> bind("<Key-F1>"=> \&printentry); ... sub printentry { my $menu = shift; warn $menu->index('active'); }
    You need Tk804.028, MasterMenu is not available before. Or just look into Tk/Menu.pm for the MasterMenu implementation, it's pure perl.

    Alternatively you can create a class binding for F1, so it would apply to all menus and no fiddling with clones is necessary. Note that you have to use the supplied argument to get to the right menu in the bindings' callbacks.

      I was too lazy to upgrade from the fedora 7 standard (Tk804.027) but the class binding works! However, $menu->entrycget('active',-label) still won't work all by itself, and $menu->index('active') doesn't either. PLUS of course entrycget can only be applied to a Menu and not a cascade (who would have thot they should be different?)

      So this rather different version does work, it seems simpler to me than getting into these "clone" things:
      #!/usr/bin/perl use warnings; use strict; use Tk; my $MW = MainWindow->new; my $menu = $MW -> Menu(-type=>'menubar',-tearoff=>0); $MW -> configure(-menu=>$menu); $MW -> bind('Tk::Menu',"<Key-F1>"=>[\&printentry]); # the class bindin +g my %MM = (); my %MC = (); my %ME = (); $MM{one} = $MW -> Menu(-tearoff=>0); $MC{one} = $menu -> cascade(-menu=>$MM{one},-label=>'one',-underline=> +0,-tearoff=>0); $ME{Ia} = $MM{one} -> command(-label=>'Ia',-command=>sub{exit}); $ME{Ib} = $MM{one} -> command(-label=>'Ib',-command=>sub{exit}); $ME{Ic} = $MM{one} -> command(-label=>'Ic',-command=>sub{exit}); $MM{two} = $MW -> Menu(-tearoff=>0); $MC{two} = $menu -> cascade(-menu=>$MM{two},-label=>'two',-underline=> +0,-tearoff=>0); $ME{IIa} = $MM{two} -> command(-label=>'IIa',-command=>sub{exit}); $ME{IIb} = $MM{two} -> command(-label=>'IIb',-command=>sub{exit}); $ME{IIc} = $MM{two} -> command(-label=>'IIc',-command=>sub{exit}); my $label; my %name=(); $menu -> bind('<<MenuSelect>>' => sub { # works only on "Menu" $label = undef; # NOT "cascade" my $this = $Tk::event->W; Tk::catch {$label = $this->entrycget('active',-label)}; }); my $x; foreach $x (keys %MM) { $MM{$x} -> bind('<<MenuSelect>>' => sub { $name{$x} = undef; my $that = $Tk::event->W; Tk::catch {$name{$x} = $that->entrycget('active',-labe +l)}; }); } MainLoop; sub printentry { print "hello $label\t$name{$label}\n" }
      The core of the solution is <<MenuSelect>>, which gets a promising single reference in Tk::Menu,

      Whenever a menu's active entry is changed, a <<MenuSelect>> virtual event is sent to the menu. The active item can then be queried from the menu, and an action can be taken, such as setting context-sensitive help text for the entry.

      Oh really! Not with the aforementioned $menu->index('active') it can't -- that just returns "none". But the people who wrote the O'Reilly Perl/Tk book managed; lucky for me a page on this comes up as a web sample because i don't have the book. That's where i got the four lines of the sub with <<MenuSelect>> in it.

      My question now for anyone who has stuck with me thus far and understands better what is going on is:

      What does $Tk::event->W do?
        Look into the Tk::bind documentation:
        'W' The window to which the event was reported (the $widget field fro +m the event) - as an perl/Tk object. Valid for all event types.
Re: Tk! (entrycget w/ 'active')
by Anonymous Monk on Mar 08, 2008 at 13:22 UTC
    The Key-F1 binding doesn't work on win32 when the menu is showing. Binding Key-a calls printentry, but also turns off the menu, and doesn't print a label. perl/Tk is fun like that.