I am trying to define a sequences of buttons in Perl with Tkx through a loop; the text and actions of each button is defined in an array of hash tables.
However, no matter what button I click on only the action of the last button is triggered.
This is the code I use.
use strict;
use Tkx;
my #Buttons = (
{ 'descr'=> "Button #0", 'cmd'=> sub { print "TODO: to implement (button #0)\n\n"; } },
{ 'descr'=> "Button #1", 'cmd'=> sub { print "TODO: to implement (button #1)\n\n"; } }
);
my %Widg;
$Widg{"."}= Tkx::widget->new(".");
$Widg{"."}->g_wm_title("List of buttons");
$Widg{"."}->g_wm_minsize(350, 300);
Tkx::font_create("H4", -family => "Helvetica", -size => 8);
$Widg{".fButton"} = $Widg{"."}->new_ttk__frame( -padding => "2 2 5 5");
$Widg{".fButton"}->g_grid(-row => 1, -sticky => "w");
my $id=-1;
foreach my $rh_measure (#Buttons) {
++$id;
$Widg{".fButton.bRun$id"}=$Widg{".fButton"}->new_ttk__button(-text => $rh_measure->{'descr'}, -command => sub { &wrapper($id); });
$Widg{".fButton.bRun$id"}->g_grid( -row => $id, -column => 1, -sticky => "w");
}
Tkx::MainLoop;
sub wrapper {
my $id=shift;
print "Process command for button #$id\n";
&{$Buttons[$id]->{'cmd'}}();
}
Actually, you just have to call the command via reference and the argument not being referenced.
$Widg{".fButton.bRun$id"}=$Widg{".fButton"}->new_ttk__button(-text => $rh_measure->{'descr'}, -command => [\&wrapper, $id]);
Related
The code below creates Perl/Tk buttons filled with each event's details from the hash %events. Is there a way to format the text inside the buttons so that it appears in aligned columns in the manner printf prints it out on line 16.
use strict;
use Tk;
my %events;
$events{"Jazz Fest"}{city} = "New Orleans";
$events{"Jazz Fest"}{state} = "LA";
$events{"Jazz Fest"}{date} = "June 6th, 2023";
$events{"Lollapalooza"}{city} = "Chicago";
$events{"Lollapalooza"}{state} = "IL";
$events{"Lollapalooza"}{date} = "July 25th, 2023";
$events{"Blues Fest"}{city} = "Chicago";
$events{"Blues Fest"}{state} = "IL";
$events{"Blues Fest"}{date} = "Augsut 4th, 2023";
my %data;
foreach my $event (sort keys %events) {
printf("%-15.15s %-20.20s %-2.2s %18.18s\n", $event, $events{$event}{city}, $events{$event}{state}, $events{$event}{date});
$data{$event} = sprintf("%-15.15s %-20.20s %-2.2s %18.18s", $event, $events{$event}{city}, $events{$event}{state}, $events{$event}{date});
}
my $data;
my $mw = MainWindow->new;
$mw->title("Event Clipboard Copy");
$mw->label("Pick Event Details to Copy.");
for(sort keys %data){
my $text = $data{$_};
$mw->Button( -text => $text, -anchor => 'w', -command => sub {
Clipboard->copy( $text );
}
)->pack( -fill => 'x' );
}
MainLoop;
To align the columns, set font of each button to "Courier" (or another monospaced font). There are at least two ways to do this:
when creating the button
assign the button to a variable and then call configure on it.
#Setting font when creating the button
$mw->Button( -text => $text, -anchor => 'w', -font => [-family => 'Courier'], -command => sub {
#Calling configure on the button
my $button = $mw->Button(-text => $text, -anchor => 'w', -command => sub {
...
}->pack( -fill => 'x' );
$button->configure(-font => [-family => 'Courier']);
Here's how it looks with font set to Courier
And without setting font:
I am using the perl Tk interface where I want to have a button test_1 and upon clicking on this button I would like a variable $varchoice to be defined as test_1. If I press on the button test_2, the variable $varchoice should be defined as test_2.
Before is the snippet of code in which I attempted to accomplish this:
$budget_frame->Button(-text => 'test_1',-command => sub{$varchoice=budget_plot_1()})->pack(-side => "left");
$budget_frame->Button(-text => 'test_2',-command => sub{$varchoice=budget_plot_2()})->pack(-side => "left");
sub budget_plot_1()
{
print "plotting 1\n";
my $var=1;
return $var;
}
sub budget_plot_2()
{
print "plotting 2\n";
my $var=2;
return $var;
}
How do I tweak this code to get the desired results?
Your program seems to work fine. Here is an example of how I tested it:
use feature qw(say);
use strict;
use warnings;
use Tk;
my $budget_frame = MainWindow->new(-title=>"Button test");
my $varchoice;
$budget_frame->Button(
-text => 'test_1',
-command => sub{ $varchoice = budget_plot_1() }
)->pack(-side => "left");
$budget_frame->Button(
-text => 'test_2',
-command => sub{ $varchoice = budget_plot_2() }
)->pack(-side => "left");
MainLoop;
say "Value of \$varchoice = $varchoice";
sub budget_plot_1()
{
print "plotting 1\n";
return "test_1";
}
sub budget_plot_2()
{
print "plotting 2\n";
return "test_2";
}
Output:
Value of $varchoice = test_1
Given this Perl/Tkx code fragment:
#itemList = ({'attrib1' => 'name1', 'attrib2' => 'value1'},
{'attrib1' => 'name2', 'attrib2' => 'value2'});
$row = 0;
foreach $item (#itemList) {
push(#btn_list, new_ttk__button(-text => $item->{'attrib1'}, -command => sub {do_something($item->{'attrib2'});}));
$btn_list[-1]->g_grid(-column => 0, -row => $row);
$row++;
}
(In the real program #itemList is populated from a user editable config file.)
I do see two buttons labeled 'name1' and 'name2'. But when I click on either button it seems that the parameter that is passed to the callback is always $itemList[1]->{'attrib2'}; i.e. 'attrib2' of the last element of the #itemList array. What I would like is to have the first button call do_something($itemList[0]->{'attrib2'} and the second call do_something($itemList[1]->{'attrib2'}.
What am I doing wrong, please and thank you?
You have encountered a subtle feature of for loops in Perl. First the solution: use my in the for loop. Then $item will be able to create a proper closure in the anonymous sub you declare later in the loop.
for my $item (#itemlist) {
push(#btn_list, new_ttk__button(
-text => $item->{'attrib1'},
-command => sub {do_something($item->{'attrib2'});}));
$btn_list[-1]->g_grid(-column => 0, -row => $row);
$row++;
}
Further explanation: Perl implicitly localizes the subject variable of a for loop. If you don't use my in the for loop, the loop will be using a localized version of a package variable. That makes your code equivalent to:
package main;
$main::item = undef;
#itemList = ({'attrib1' => 'name1', 'attrib2' => 'value1'},
{'attrib1' => 'name2', 'attrib2' => 'value2'});
$row = 0;
foreach (#itemList) {
local $main::item = $_;
push(#btn_list, new_ttk__button(
-text => $main::item->{'attrib1'},
-command => sub {do_something($main::item->{'attrib2'});}));
$btn_list[-1]->g_grid(-column => 0, -row => $row);
$row++;
}
# at the end of the loop, value of $main::item restored to undef
Your anonymous subs still refer to the $main::item package variable, whatever value that variable holds at the time that those subroutines are invoked, which is probably undef.
Shorter solution: use strict
Additional proof-of-concept. Try to guess what the following program outputs:
#foo = ( { foo => 'abc', bar => 123 },
{ foo => 'def', bar => 456 } );
my #fn;
foreach $foo (#foo) {
push #fn, sub { "42" . $foo->{bar} . "\n" };
}
foreach my $foo (#foo) {
push #fn, sub { "19" . $foo->{foo} . "\n" };
}
print $_->() for #fn;
Here's the answer:
42
42
19abc
19def
in perl Tk I want to ask how to get the calling widget when using the -command option.
I have a dialog widget that is dynamically created by a previously unknown number of entries. There are Entry-widget and next to each a button where one can browse possible (useful) strings for the Entry.
Therefore, if the button next to the 2nd Entry is pressed, the result should be stored in the 2nd Entry and so on.
The code looks as follows.
my $count = 0;
my #name = ();
my #val = ();
my #edit = ();
my #button = ();
my $fr = $wind->Frame->pack;
foreach ( #outputs ) {
$name[$count] = helper::trim($_);
$val[$count] = '';
$fr->Label(-text => $name[$count])->grid(-row => $count, -column => 0, -sticky => 'w');
$edit[$count] = $fr->Entry(-textvariable => \$val[$count], -width => 30)->grid(-row => $count, -column => 1);
$button[$count] = $fr->Button(-width => 20, -text => 'Select',
-command => sub { &select(\$val[$count], \$edit[$count]); }
)->grid(-row => $count, -column => 2);
$count++;
}
However, since &select is called after the complete dialog box was built $count is always on the last value and I don't get the info, which button I have pressed. Lines as
-command => sub { &select(\#val, \#edit, $count); }
also didn't work.
Is there some way to get the widget that called the sub-routine (so I can store necessary infos somehow in the respective button) or use the actual value (of $count here) in such a call?
Best regards.
inside the callback:
my $caller = $Tk::widget;
For example in the following script:
use Tk;
my $mw = new MainWindow;
my $t = $mw->Scrolled("Text")->pack;
my $popup = $mw->Menu(
-menuitems => [
[
Button => 'Copy Selected',
-state => "disabled",
-command => sub {$t->clipboardColumnCopy}
],
]
);
$t->menu($popup);
MainLoop;
How do I tell when selection happens so that I can use the following code
$popup->entryconfigure(1, -state=>'normal');
to change the menu item state?
UPDATE:
Big thanks to #Chas and #gbacon :)
I think maybe I can also combine the two good answers:
$t->bind(
"<Button1-ButtonRelease>",
sub {
local $#;
my $state = defined eval { $t->SelectionGet } ?
"normal" : "disable";
$popup->entryconfigure(1, -state => $state)
}
);
I don't know Tk very well, but this is an answer (but maybe not the right answer):
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
my $mw = new MainWindow;
my $t = $mw->Text->pack;
my $popup = $mw->Menu(
-menuitems => [
[ Button => 'Copy Selected', -state => "disabled", -command => sub {$t->clipboardColumnCopy} ],
]
);
$t->menu($popup);
$t->bind(
"<Button1-ButtonRelease>",
sub {
my $text = $t->getSelected;
if (length $text) {
$popup->entryconfigure(1, -state => 'normal');
} else {
$popup->entryconfigure(1, -state => 'disabled');
}
}
);
MainLoop;
A few changes produce the behavior you want. The code below watches <ButtonPress-1> which may clear the selection and if so disables Copy Selected. For <ButtonPress-3>, it enables the menu item if a selection is present.
my $copySelectedLabel = "Copy Selected";
my $popup = $mw->Menu(
-menuitems => [
[
Button => $copySelectedLabel,
-state => "disabled",
-command => sub {$t->clipboardColumnCopy}
],
]
);
sub maybeEnableCopySelected {
local $#;
$popup->entryconfigure($copySelectedLabel, -state => "normal")
if defined eval { $t->SelectionGet };
}
sub maybeDisableCopySelected {
local $#;
$popup->entryconfigure($copySelectedLabel, -state => "disabled")
unless defined eval { $t->SelectionGet };
}
$t->bind('<ButtonPress-1>' => \&maybeDisableCopySelected);
$t->bind('<ButtonPress-3>' => \&maybeEnableCopySelected);
$t->menu($popup);