Tk Dialog Manipulation

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

My problem is this: I have a callback that can take a several seconds to execute and the feedback is strongly in favor of some notice that the program is doing something. After a couple hours I came up with this horrible bit of code:

use strict;
use warnings;

use Tk;

my $top = new MainWindow;
$top->Button( -text => 'Start LongTime.exe', -command => \&longtime )
    ->pack;
my $diag = $top->Dialog( -text => 'Working...', -buttons => [] );

MainLoop;

sub longtime {
    $diag->after( 100,
        sub {
            system('longtime.exe');
            $diag->{selected_button} = 1
        } );
    $diag->Show();
}
[download]

Which works, but I'm hoping there's a way that's slightly more kosher. (I know threading would help, but restructuring the code to that extent is off in the future)

Comment on Tk Dialog Manipulation Download Code

Replies are listed 'Best First'.
Re: Tk Dialog Manipulation by cmv (Chaplain) on Oct 26, 2007 at 01:30 UTC
The easiest (but not so flashy) solution is to simply tell the window manager to change the mouse icon to an hourglass right before your system call, then right after you change it back. This is the cheap-and-dirty solution that I mostly use.	[reply]
Re: Tk Dialog Manipulation by zentara (Cardinal) on Oct 26, 2007 at 13:16 UTC
Your solution has a few problems, but if it works for your purposes, that is all that matters. One problem, is that if you click the "StartLongTime.exe" button while it's already running, it will run again when the first run is finished. So you can use the Busy method there. Also, the Dialog does grabs, centers, and needs the funky "selected_button=1" to destroy it. It also is created in the main program, it is better to isolate it in the longtime sub. I would switch to a more flexible toplevel, like this: `#!/usr/bin/perl use strict; use warnings; use Tk; my $top = new MainWindow; $top->Button( -text => 'Start LongTime.exe', -command => \&longtime ) ->pack; MainLoop; sub longtime { $top->Busy(-recurse => 1); my $tl = $top->Toplevel(); $tl->overrideredirect(1); $tl->geometry('300x100+100+100'); $tl->title( "Toplevel" ); $tl->Label( -text => "Working",-bg=>'lightyellow' ) ->pack(-expand=>1,-fill=>'both'); $tl->after(10,sub{ system('longtime.exe'); $tl->destroy(); $top->Unbusy(-recurse =>1); }); }` [download] I'm not really a human, but I play one on earth. Cogito ergo sum a bum	[reply] [d/l]