Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Perl tk gui freezes after pop up list is launched.

by john.tm (Scribe)
on Nov 29, 2015 at 08:09 UTC ( [id://1148798]=perlquestion: print w/replies, xml ) Need Help??

john.tm has asked for the wisdom of the Perl Monks concerning the following question:

Hi

I have created a GUI for users to run a few scripts from. When a button is selected to run a script a selection box is created and then the script continues fine.

The issue is that if the users clicks the mouse on the main GUI by mistake it freezes and that goes into a non responsive mode, until you put focus back on the selection box. (This of course may freak out the users).

The only way that i have got round this so far is to withdraw and then deiconify the mainwindow in the sub call. But this leaves the user with no GUI for a couple of seconds until the selection box appears. (Am I being too fussy).

The reason i call the script from the GUI and don't just use a sub call in the main GUI, is that i have 11 different buttons that all call scripts that have about 800 lines of code which as i am new to Perl it gets a bit confusing. So I find it easier this way.

Scripts below are just a test sample of the scenario. main gui dashboard
use warnings; use strict; use Tk ; my $mw = MainWindow->new(); $mw->geometry("500x300+50+50"); my $main_frame = $mw->Frame( -relief => 'ridge')->pack(-side => 'top', + -fill => 'x'); my $left_frame = $main_frame->Frame(-relief => 'ridge')->pack(-side => + 'left', -fill => 'y'); my $right_frame = $main_frame->Scrolled("Text", -scrollbars => 'se') ->pack(-expand => 1, -fill => 'both'); my $button1 = $left_frame->Button(-text => "button 1", -command => [\&run_freeze], -relief => 'ridge')- +>pack(-fill => 'x'); my $Close_button = $left_frame->Button(-text => "Exit", -command => [$mw => 'destroy'], -relief => 'ridge' +)->pack(-fill => 'x'); MainLoop; sub run_freeze { open (freeze_script, '-|', 'G:\\opscripts\freeze.pl') or die "\nUn +able to start freeze.pl\n"; ##$mw->withdraw; my $first_line = "processing freeze ........\n"; $right_frame->delete("1.0", 'end'); $right_frame->insert( 'end', $first_line ); my $freeze_line; while (defined ($freeze_line =<freeze_script>) ) { $right_frame->insert( 'end', $freeze_line ); $right_frame->update(); $right_frame->see('end'); ## $mw -> deiconify; } }
script that starts with a selection box
#!/usr/bin/perl use strict; use warnings; use Tk; use Tk::BrowseEntry; my $mw = MainWindow->new(); $mw->geometry("300x200"); my $yyyy; $yyyy="" if(!$yyyy); my $mmm; $mmm="" if(!$mmm); my $dd; $dd="" if(!$dd); my $browseEntryyear = $mw ->BrowseEntry( -label => 'Select year :', -relief => 'ridge', -state => 'readonly', -autolistwidth => '1', -justify => 'right', -buttontakefocus => 1, -textv +ariable => \$yyyy, -relief => 'ridge') -> pack( -ipadx => 15, -side => 'top', -anchor => +'e', -expand => 1); $browseEntryyear -> insert('end', qw(2013 2014 2015 2016 2017 2018 + 2019 2020)); my $browseEntrymonth = $mw ->BrowseEntry( -label => 'Select Month :', -state => 'readonly', -autolistwidth => '1', -justify => 'right', -butto +ntakefocus => 1, -textvariable => \$mmm, -relief => 'ridge') -> pack( -ipadx => 15, -side => 'top', -anchor => +'e', -expand => 1); $browseEntrymonth -> insert('end', qw(Jan Feb Mar Apr May Jun Jul +Aug Sep Oct Nov Dec)); my $browseEntryday = $mw ->BrowseEntry( -label => 'Select Day :', -state => 'readonly', -a +utolistwidth => '1', -justify => 'right', -buttontakefocus => 1, -text +variable => \$dd, -relief => 'ridge') -> pack(-ipadx => 15, -side => 'top', -anchor => ' +e',-expand => 1); $browseEntryday -> insert('end', qw(01 02 03 04 05 06 07 08 09 10 +11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31)); my $but = $mw -> Button(-text => " Enter ", -command =>[$mw => 'destroy'], -relief => 'raised' +, -activebackground => "darkgreen", )->pack(-side => "right",-expand => 1); my $closebutton = $mw->Button(-text => " Quit ", -command => [$mw => 'exit'], -relief => 'raised', +-activebackground => "red", )->pack(-side => "left",-expand => 1); $mw->repeat( 900, sub { if( $yyyy =~ m/\d\d\d\d/ and $mmm =~ m/[A-Z][A-z]*/ and $dd =~ + m/\d\d/ ){ $but->configure( -state => 'normal' ); } else{ $but->configure( -state => 'disabled' ); } } ); MainLoop; print " selected Year = $yyyy\n"; print " selected Month = $mmm\n"; print " selected Day = $dd\n"; # script continues on using varaibles above and display stdout in the +main gui textframe

Replies are listed 'Best First'.
Re: Perl tk gui freezes after pop up list is launched.
by kcott (Archbishop) on Nov 29, 2015 at 12:35 UTC

    G'day john.tm,

    I was unable to reproduce the problem you describe.

    I'm using Perl 5.22.0 and Tk 804.033 on Mac OS X 10.10.3

    I stored your freeze script in pm_1148798_freeze.pl. I changed the shebang line from #!/usr/bin/perl to #!/usr/bin/env perl. Otherwise, the code is unaltered.

    I stored your main script in pm_1148798_main.pl. I added the shebang line #!/usr/bin/env perl. I changed G:\\opscripts\freeze.pl to pm_1148798_freeze.pl. Otherwise, the code is unaltered.

    I tried this a few times without being able to freeze anything. Here's a sample run:

    1. $ pm_1148798_main.pl
    2. Main GUI appeared. I clicked on "button 1" and Freeze GUI appeared. I clicked in Main GUI: it came to the front. I clicked in Freeze GUI: it came to the front. No freezing at this point.
    3. I selected year 2016. I brought Main to the fore; then Freeze to the fore. No freezing. Year still showing as 2016.
    4. I selected Month May. I brought Main to the fore; then Freeze to the fore. No freezing. Year still showing as 2016 and Month as May.
    5. I selected Day 25. "Enter" button now enabled. I brought Main to the fore; then Freeze to the fore. No freezing. Year still showing as 2016, Month as May and Day as 25.
    6. I clicked on Enter. Freeze GUI gone; Main GUI now showing:
      processing freeze ........ selected Year = 2016 selected Month = May selected Day = 25
    7. I clicked Exit. Main GUI gone. Command line prompt returns. No error or warning messages were displayed.

    If you require further help, please provide a similar step-by-step description. This should include exactly what you mean by "freezing": unresponsive buttons; drop-down lists not displaying; window stuck in the background; etc. It should also include how what you see deviates from what you expect.

    — Ken

        I wasn't aware of that OS-specific issue. Thanks for the heads-up.

        Using modules, instead of piping output from another GUI, was my first thought. My intent was to identify the issue and (hopefully) provide a better solution. Being unable to reproduce the problem rather put paid to that plan.

        — Ken

Re: Perl tk gui freezes after pop up list is launched. [platform-independent solution]
by kcott (Archbishop) on Nov 30, 2015 at 06:58 UTC

    As you can see from earlier posts your problem is OS-specific, which is why I couldn't reproduce the problem. Luckily, I enjoy playing around with Tk, so here's a solution that (I believe) should work on both MSWin and *nix platforms.

    This has just one script (pm_1148798_main_tk_with_mod.pl) which uses modules for each of your scripts:

    #!/usr/bin/env perl use warnings; use strict; use Tk; my %script_mod_for = ( Freeze => 'Pm_1148798_freeze_tk_mod', Dummy => 'Pm_1148798_dummy_tk_mod', ); my $mw = MainWindow::->new(); $mw->geometry("500x300+50+50"); my $script_F = $mw->Frame->pack(-side => 'bottom', -fill => 'x'); my $button_F = $mw->Frame->pack(-side => 'left', -fill => 'y'); my $text_ST = $mw->Scrolled('Text', -scrollbars => 'se' )->pack(-expand => 1, -fill => 'both'); my @script_buttons; push @script_buttons, $button_F->Button(-text => $_, -command => [ \&show_script_gui, $_, $script_mod_for{$_}, $script_F, $text_ST, \@script_buttons ])->pack(-fill => 'x') for keys %script_mod_for; $button_F->Button(-text => 'Exit', -command => sub { exit } )->pack(-fill => 'x'); MainLoop; sub show_script_gui { my ($script, $mod, $script_F, $text_ST, $script_buttons) = @_; $text_ST->insert(end => "Running script: $script\n"); eval "require $mod"; $_->configure(-state => 'disabled') for @$script_buttons; $mod->run($script_F, $text_ST, $script_buttons); }

    Here's the module for your Freeze script (Pm_1148798_freeze_tk_mod.pm).

    package Pm_1148798_freeze_tk_mod; use strict; use warnings; require Tk::BrowseEntry; sub run { my ($class, $script_F, $text_ST, $script_buttons) = @_; my ($yyyy, $mmm, $dd) = ('') x 3; my @years = 2013 .. 2020; my @months = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}; my @days = map { sprintf '%02d', $_ } 1 .. 31; my $temp_F = $script_F->Frame->pack; my $done_B; my %common_be_opts = ( -state => 'readonly', -autolistwidth => '1', -justify => 'right', -buttontakefocus => 1, -browsecmd => sub { $done_B->configure( -state => $yyyy && $mmm && $dd ? 'normal' : 'disabled' ) } ); my %be_pack_opts = ( -ipadx => 15, -side => 'top', -anchor => 'e', -expand => 1 ); my $y_BE = $temp_F->BrowseEntry(%common_be_opts, -label => 'Select Year', -textvariable => \$yyyy )->pack(%be_pack_opts); $y_BE->insert(end => @years); my $m_BE = $temp_F->BrowseEntry(%common_be_opts, -label => 'Select Month', -textvariable => \$mmm )->pack(%be_pack_opts); $m_BE->insert(end => @months); my $d_BE = $temp_F->BrowseEntry(%common_be_opts, -label => 'Select Day', -textvariable => \$dd )->pack(%be_pack_opts); $d_BE->insert(end => @days); $done_B = $temp_F->Button(-text => 'Done', -state => 'disabled', -command => sub { $text_ST->insert(end => "Selected day: $dd\n" . "Selected month: $mmm\n" . "Selected year: $yyyy\n" ); $temp_F->destroy; $script_F->configure(-height => 1); $_->configure(-state => 'normal') for @$script_buttons; })->pack; } 1;

    And here's a module for a Dummy script (Pm_1148798_dummy_tk_mod.pm). This is just intended to show that pm_1148798_main_tk_with_mod.pl can handle multiple modules.

    package Pm_1148798_dummy_tk_mod; use strict; use warnings; sub run { my ($class, $script_F, $text_ST, $script_buttons) = @_; my $temp_F = $script_F->Frame->pack; $temp_F->Label(-text => 'Dummy Frame for Testing Purposes')->pack; $temp_F->Button(-text => 'Done', -command => sub { $temp_F->destroy; $script_F->configure(-height => 1); $_->configure(-state => 'normal') for @$script_buttons; })->pack; $text_ST->insert(end => "Dummy line 1\n"); $text_ST->insert(end => "Dummy line 2\n"); } 1;

    Here's the output from one instance of the script using multiple modules:

    Running script: Dummy Dummy line 1 Dummy line 2 Running script: Freeze Selected day: 05 Selected month: Jul Selected year: 2015 Running script: Dummy Dummy line 1 Dummy line 2 Running script: Dummy Dummy line 1 Dummy line 2 Running script: Freeze Selected day: 06 Selected month: Nov Selected year: 2018

    You'll note that once you start either Freeze or Dummy, you must complete it before starting another: those buttons are disabled during a run and only enabled on completion; [Exit] is always enabled so you can quit prematurely if you want.

    Also note where I've used use and require. Modules are only loaded on demand.

    The overriding intent here was to show the script-module interaction. I've excluded most of the pretty GUI stuff: colours, borders, etc. I haven't gone overboard on validation either: currently, you can select 31st February.

    Another alternative, similar to your original with two windows, would be Tk::Toplevel (possibly also using Tk::grab). I'll leave you to investigate this option if you so desire.

    Documentation for all widgets (and a few other things, such as geometry managers) are linked from the Tk distro page.

    — Ken

Re: Perl tk gui freezes after pop up list is launched.
by Anonymous Monk on Nov 29, 2015 at 09:47 UTC
      my post is on Nov 29, 2015 at 08:09 UTC #1148798=perlquestion title Perl tk gui freezes after pop up list is launched. not the post you are referencing Re: Perl/Tk freezes while waiting the data to arrive on mysql server

        my post is ... not the post you are referencing

        Why would I link your question instead of an answer?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1148798]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (5)
As of 2024-04-19 16:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found