in reply to How to PopUp a 'Status' window in Perl/Tk

There are alot of ways to do what you want. Basically you need to test for some condiition(i.e. a finished flag), then close the window. Usually you use a timer to do this, but there are other ways. Also, if you call "PoP-It" more than once, you will be gaining memory-size with each call, since you destroy (then recreate) $tp. Only create $tp once, and call withdraw and deiconify on it to reuse the widget.
sub AddItem { my $tp = $mw->Toplevel( -title => ' AddItem' ); # ->pack(-fill => 'both'); my $tpfrm = $tp->Frame( -background => '#22cc00', )->pack(-side => 'top', -fill => 'x'); my $tplbl = $tpfrm->Label( -text => 'Working...', -background => 'white', -foreground => 'black' )->pack(-side => 'top', -padx => 10); # my $tpbtn = $tpfrm->Button( # -text => 'Close', # -command => [$tp => 'destroy'], # )->pack(-side => 'top', -padx => 10, -pady => 5); #start a timer to simulate some working being done my $count = 0; my $timer = $mw->repeat(1000,sub{ $count++; if($count == 5){ $tp->withdraw } }); }

I'm not really a human, but I play one on earth. flash japh

Replies are listed 'Best First'.
Re^2: How to PopUp a 'Status' window in Perl/Tk
by ozboomer (Friar) on Aug 27, 2005 at 13:51 UTC
    ?!?! I must not be expressing myself well.

    These examples are all good... but a basic point is being missed. In these examples, the AddItem sub{} is controlling when the 'Working' message window is to be destroyed. The real problem is that the... 'activity'... that's going on that needs to be monitored is running *outside* of the context of the current process. This means the 'mainline' Perl/Tk program doesn't know when the 'activity' is terminated.

    As I understand it, when MainLoop is called, everything is basically 'sitting still' until (in this case) a 'button press event' happens. When that event comes from the 'Pop It!' button, the AddItem sub{} is called, which creates a new window that shows a 'Working' message. Effectively at the same time, a new process is spawned... and everything in the current process goes back to 'sleep', until another event occurs.

    The 'full and complete' way to do what I want would be to use Win32::Process::Create(...$cmd...) and set-up something with signals... and when the spawned process terminates, if would issue a signal to its parent process -- that would be the 'event' that is trapped and the 'Working' message window would be destroyed.

    ...but I'm trying to shortcut all that work somehow (I don't even know if such a thing is possible, although I would expect it would be)... and I'm not sure how to do it. In 'normal' (non-event-driven programming), simply including 'system($cmd)' in the code would mean the main program would pause, the system() task would complete and control would be returned to the main program again... but this doesn't happen here.

    Perhaps the simplest way is to forget about spawning another process and just include the code from the command -line version I have into the Tk version -- Ugh. More maintenance dramas...

    John

      This means the 'mainline' Perl/Tk program doesn't know when the 'activity' is terminated.

      You have a basic design flaw, and you probably should consider a different approach. Even if the process is ouside the AddItem sub, you will have to somehow detect that the thing has ended and set a flag, or something.

      I'm not using Windows, and the Win32::ProcessCreate idea is what you are after. Also IPC::Run is supposed to work on windows, which would allow you to run the process thru IPC, then monitor it's STDOUT, and wait to detect something which signals the "end condition". Then you can set a flag.

      Perhaps the simplest way is to forget about spawning another process and just include the code from the command -line version I have into the Tk version -- Ugh. More maintenance dramas...

      You can also run the process through threads, and use threads:shared to signal back to the main thread that the thread has finished running the code.


      I'm not really a human, but I play one on earth. flash japh
Re^2: How to PopUp a 'Status' window in Perl/Tk
by ozboomer (Friar) on Aug 28, 2005 at 12:54 UTC
    Well, given the practicalities involved with this project, I've made an executive decision(!)...

    I'll use the idea that has been suggested of updating a progress bar on a pop-up window... and just get it to run a 'resonable time' (which I'll determine by a few test runs), after which I'll check if the file I'm expecting to see has been created. If it's not there or some other error occurs, I'll deal with that AFTER the 'Working' pop-up has gone.

    As this program I'm building is just a 'make-do' thing until some other people fix-up the problems we've reported in their software, what I've described will probably be sufficient; it doesn't have to be 'perfect'(!)... and it certainly doesn't justify all the development/debugging required for IPC/process communications.

    Many thanks for all your assistance, folks... I appreciate it a lot.

    BTW... The final sample code I'll further massage follows:

    use strict; use Tk; use Tk::ProgressBar; # WHY is this required, given the prior line? # If it's not included I get warnings!? my $MAXTIME = 10; my $mw = MainWindow->new; # Main window my $top = $mw->Frame( -background => '#239867', -borderwidth => 2, )->pack(-fill => 'both'); my $lbltxt = $top->Label( -text => 'Just some text', -background => 'white', )->pack(-side => 'right', -padx => 10); my $GoBtn = $top->Button( -text => ' Pop It! ', -command => \&AddItemNew )->pack(-side => 'left', -padx => 10, -pady => 5); my $DoneBtn = $top->Button( -text => ' Exit ', -command => \&Cleanup )->pack(-side => 'right', -padx => 10, -pady => 5); $mw->focus; # Ensure we're talking to the main window MainLoop; # Run the program, watching for events # ---- sub Cleanup { $mw->destroy; } # ---- sub AddItem { my $tp = $mw->Toplevel( -title => ' AddItem' ); # ->pack(-fill => 'both'); my $tpfrm = $tp->Frame( -background => '#22cc00', )->pack(-side => 'top', -fill => 'x'); my $tplbl = $tpfrm->Label( -text => 'Working...', -background => 'white', -foreground => 'black' )->pack(-side => 'top', -padx => 10); my $tpbtn = $tpfrm->Button( -text => 'Close', -command => [$tp => 'destroy'], )->pack(-side => 'top', -padx => 10, -pady => 5); } # ---- sub AddItemNew { my $tp = $mw->Toplevel( -title => ' AddItem' ); # ->pack(-fill => 'both'); my $tpfrm = $tp->Frame( -background => '#22cc00', )->pack(-side => 'top', -fill => 'x'); my $tplbl = $tpfrm->Label( -text => 'Working...', -background => 'white', -foreground => 'black' )->pack(-side => 'top', -padx => 10); $GoBtn->configure(-state => "disabled"); my $progress = $tpfrm->ProgressBar( -width => 20, -length => 100, -anchor => 'w', -state => 'disabled', -value => 0, -from => 0, -to => $MAXTIME-1, -blocks => 1, -colors => [0, 'blue'] )->pack(); for (0..$MAXTIME-1) { $progress->value($_); $progress->update(); sleep 1; } $tp->withdraw; $GoBtn->configure(-state => "normal"); }
      Sometimes you just have to be practical. :-)

      I'm not really a human, but I play one on earth. flash japh