Re: Simple ok/cancel routine

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 <[email protected] 
>> <mailto:[email protected]>> 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();
>> }
>