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

Is there a way to change the cursor to an hourglass while a sub routine runs and then goes back to the normal one when the sub finishes.
I've looked at perl in a nutshell and the Tk tutorial but they haven't helped much.

20040819 Edit by ysth: change title from: Cusor in TK

Replies are listed 'Best First'.
Re: Cursor in TK
by Plankton (Vicar) on Aug 19, 2004 at 16:18 UTC 
    $ perldoc Tk::Widget

    [download]
    ...
    $widget->Busy?(?-recurse => 1?-option = value>?)? This method configures a -cursor option for $widget and (if -recurse = 1> is specified) all its descendants. The cursor to be set may be passed as -cursor = cursor> or defaults to ’watch’. Additional configure options are applied to $widget only. It also adds a special tag ’Busy’ to the bindtags of the widgets so configured so that KeyPress, KeyRelease, ButtonPress and ButtonRelease events are ignored (with press events generating a call to bell). It then acquires a local grab for $widget. The state of the wid- gets and the grab is restored by a call to $widget->Unbusy.

    Plankton: 1% Evil, 99% Hot Gas.
[reply]
[d/l]
      Thank you worked first time
[reply]
Re: Cursor in TK
by eserte (Deacon) on Aug 19, 2004 at 16:38 UTC 
    $top->Busy(-recurse => 1);
# call your subroutine
$top->Unbusy;

    [download]
    If your subroutine may die, then it's better to have the subroutine call in an eval { }, otherwise your application will stay unresponsive. With newer Perl/Tks (>=804) you can use this shortcut instead: 
    $top->Busy(\&your_subroutine, -recurse => 1);

    [download]
[reply]
[d/l]
[select]
Re: Cursor in TK
by roju (Friar) on Aug 19, 2004 at 16:19 UTC
    If http://www.perltk.org/ptknews/5390.htm is to be believed, then it's as simple as, 
    $top->Busy;
call_you_sub_here();
$top->Unbusy;

    [download]

    I haven't tested it however, so YMMV

    Update: Tested with ActiveState 5.8.3 and the default Tk, and it works for me.

    use Tk;
my $mw = MainWindow->new;
$mw->Button(-text => "Goodbye World!", -command =>sub{exit})->pack;
$mw->Button(-text => "Act busy!",
            -command =>sub{$mw->Busy; sleep 1;$mw->Unbusy;})
   ->pack;
MainLoop;

    [download]

[reply]
[d/l]
[select]
      A combination of yours and the answer before and its working just fine.
[reply]

Back to Seekers of Perl Wisdom