Index Value of a Button Widget in Perl/Tk

D

doni

Hi,

Can anyone point me how can I retrieve the index value or any value to
indicate that a specific button is selected. Can anyone let me know
how can I proceed with this.
Actuall, based upon the selected button I want to pass the command to
a specific subroutine for carrying out specific logic. But right now,
any selected button will pass the control to the same subroutine

Thanks,
doni

Here is the test code.

#!/usr/bin/perl

use strict;
use Tk;

my @received_hello; my @sending_rupd; my @changing_l2; my
@received_nreg; my @received_nreg_new;
my @sending_nreg_ack; my @received_nd; my @received_nd_ack; my
@sending_nd; my @removing_l2;

my $mw = MainWindow->new;
$mw->configure(-title => 'Test Tool', -background => 'white', -width
=> "700", -height => "500");

my $lbox1 = $mw->Scrolled('Listbox', -scrollbars => 'osoe');
$lbox1->configure(-height => 8, -width => 20);
$lbox1->configure(-selectmode => 'browse');
$lbox1->pack(-anchor => 'e');

my $btn1 = $mw->Button(-text => "RFROUTED",
-command => \&rfrouted_button)->pack(-side =>
'right', -anchor => 'e');
my $btn2 = $mw->Button(-text => "GWD",
-command => \&gwd_button)->pack(-side =>
'right', -anchor => 'e');
my $btn3 = $mw->Button(-text => "Exit",
-command => sub{exit})->pack(-side => 'right', -
anchor => 'e', -after => $btn1);
my $fr = $mw->Frame(-background => 'cyan')->pack(-side => 'top', -
fill => 'x');
my $t = $mw->Scrolled("Text")->pack(-side => 'bottom', -fill =>
'both', -expand => '1');
MainLoop();

sub rfrouted_button {
repack();
foreach (qw/rcvd_hello sendg_rupd chng_l2 rcvd_nreg rcvd_nreg_new
sendg_nreg_ack rcvd_nd rcvd_nd_ack sendg_nd rmvg_l2/) {
##### Any selected button passes control to rcvd_hello
subroutine
$fr->Button(-text => $_, -command => \&rcvd_hello, -width =>
'12')->pack(-anchor => 'e');
}
}

sub gwd_button {
repack();
foreach (qw/new_device route_update/) {
$fr->Button(-text => $_, -width => '12')->pack(-anchor =>
'w');
no_of_times(@new_device);
}
}

sub repack {
$btn1->packForget();
$btn2->packForget();
$lbl1->packForget();
$lbl2->packForget();
}

sub rcvd_hello {
my @list = ("00:13:50:00:05:19", "00:13:50:00:05:bd",
"00:13:50:00:04:f9", "00:13:50:00:05:cb");
$lbox1->insert('end', @list);
$lbox1->bind('<<ListboxSelect>>',
sub{ display_lb_curselection($lbox1) });
}

sub display_lb_curselection {
my $lbox1 = shift;
my @cs = $lbox1->curselection();
my $selection = $lbox1->selectionSet(@cs);
print "Current choices: ", $selection;
print "\n";
}
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,982
Messages
2,570,190
Members
46,736
Latest member
zacharyharris

Latest Threads

Top