ATTN: Phillip Bradey RE: Tk Options
#!/bin/perl -w
package Application {
use Moose;
use Tk;
require Tk::BrowseEntry;
use feature 'say';
use feature 'state';
use feature 'switch';
use namespace::autoclean;
has '_mw' => (
is => 'rw',
isa => 'Tk::MainWindow',
);
has '_packdirs' => (
is => 'rw',
isa => 'ArrayRef',
required => 1,
default => sub { [] },
);
has '_top' => (
is => 'rw',
isa => 'Tk::Widget',
);
sub _build_mw {
my ($self) = @_;
my $numWidgets = 4;
$self->_mw(MainWindow->new(-title => "Tk Options"));
my $ft1 = $self->_mw->Frame(
-borderwidth => 2,
-relief => 'groove',
)->pack(
-side => 'top',
-fill => 'y',
);
my $f1 = $ft1->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $f2 = $ft1->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $f3 = $ft1->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $f4 = $ft1->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $ft2 = $self->_mw->Frame(
-borderwidth => 2,
-relief => 'groove',
)->pack(
-side => 'bottom',
-fill => 'y',
);
my $f5 = $ft2->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $f6 = $ft2->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
-fill => 'x'
);
my $f7 = $ft2->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $f8 = $ft2->Frame(
-borderwidth => 2,
-relief => 'groove'
)->pack(
-side => 'left',
);
my $i = 0;
my $lbl1 = $f1->Label(-text => 'Configuration 1')->pack(-ipady
=> 5);
my $lbl2 = $f2->Label(-text => 'Configuration 2')->pack(-ipady
=> 5);
my $lbl3 = $f3->Label(-text => 'Configuration 3')->pack(-ipady
=> 5);
my $lbl4 = $f4->Label(-text => 'Configuration 4')->pack(-ipady
=> 5);
my $lbl5 = $f5->Label(-text => 'Configuration 5')->pack(-ipady
=> 5);
my $lbl6 = $f6->Label(-text => 'Configuration 6')->pack(-ipady
=> 5);
my $lbl7 = $f7->Label(-text => 'Configuration 7')->pack(-ipady
=> 5);
my $lbl8 = $f8->Label(-text => 'Configuration 8')->pack(-ipady
=> 5);
foreach (0..$numWidgets)
{
$self->_packdirs->[$_] = 'Skip';
my $be1 = $f1->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be2 = $f2->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be3 = $f3->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be4 = $f4->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be5 = $f5->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be6 = $f6->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be7 = $f7->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
my $be9 = $f8->BrowseEntry(-label => "Setting $_:",
-choices => ["On", "Off", "Skip"],
-variable => \$self->_packdirs->[$_], -browsecmd =>
\&repack)
->pack(-ipady => 5);
}
my $btn1 = $f1->Button(-text => 'Commence New Process
1')->pack(-ipady => 5);
my $btn2 = $f2->Button(-text => 'Commence New Process
2')->pack(-ipady => 5);
my $btn3 = $f3->Button(-text => 'Commence New Process
3')->pack(-ipady => 5);
my $btn4 = $f4->Button(-text => 'Commence New Process
4')->pack(-ipady => 5);
my $btn5 = $f5->Button(-text => 'Commence New Process
5')->pack(-ipady => 5);
my $btn6 = $f6->Button(-text => 'Commence New Process
6')->pack(-ipady => 5);
my $btn7 = $f7->Button(-text => 'Commence New Process
7')->pack(-ipady => 5);
my $btn8 = $f8->Button(-text => 'Commence New Process
8')->pack(-ipady => 5);
$self->_top($self->_mw->Toplevel(-title => "output window"));
my $c;
my $idx = 0;
foreach (@{$self->_packdirs})
{
my $b = $self->_top->Button(-text => "Open Folder ${idx}",
-font => "Courier 20 bold")->pack(-side => 'bottom', -fill => 'both',
-expand => 1);
$idx++;
}
MainLoop;
}
sub main {
my ($self) = @_;
$self->_build_mw;
}
__PACKAGE__->meta->make_immutable;
}
my $app = Application->new->main unless caller;
1;
Great. This is also available as a Public Gist upon GitHub. The url
for the Gist is
https://gist.github.com/jmcveigh/48c71a3b555eea631a00c13e9162c433
Click link above for the source code response regarding options in Tk.
Okay.
Warm Regards,
Jason McVeigh
Jeff Hobbs wrote:
I believe <Return> may be the default action, where <Space> is what
you need to press to get the right action. You’ll see OS X behave the
same way with its core ok/cancel boxes.
On Jun 14, 2016, at 10:29 AM, Philip Brady <phil.br...@hotmail.co.uk
<mailto:phil.br...@hotmail.co.uk>> wrote:
I'm writing a perl script using Tk and have had some success but I
wish to have a very simple subroutine to ask the user a question and
get a response 'ok' or 'cancel'.
My routine follows but it doesn't quite work as expected.
It's fine if I mouse click on 'ok' or simply press the return key -
it correctly returns 'ok'.
If I clink 'cancel' it correctly returns 'cancel'.
Unfortunately, if I tab to 'cancel' then press return it returns 'ok'
rather than the desired 'cancel'.
I'd appreciate any advice on fixing this.
regards
Phil
The code is:
#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::Dialog;
use Tk::DialogBox;
my $main=MainWindow->new();
my $X=CheckOk('Some old question');
print "Response was $X\n";
exit 0;
sub CheckOk{
(my $question)=@_;
my $box=$main->DialogBox(
-buttons => ['ok','cancel'],
-default_button => "ok");
$box-> add("Label",
-text => "$question ")->pack;
$box -> Show();
}
