Re: Tk! (entrycget w/ 'active')

[eserte]

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.

[halfcountplus]

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?

[eserte]

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.