Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re^3: How do you exit PERL TK menu without exiting the script too ?

by rcseege (Pilgrim)
on Sep 20, 2006 at 03:06 UTC ( [id://573841]=note: print w/replies, xml ) Need Help??


in reply to Re^2: How do you exit PERL TK menu without exiting the script too ?
in thread How do you exit PERL TK menu without exiting the script too ?

It must be because the MainLoop subroutine callled the Submit subroutine.

This is true. Consider that Tk, like other GUI toolkits is event driven - you set up the GUI components, and then you start up the Event processor using the MainLoop function, which processes events until the MainWindow has been destroyed. All Events are processed serially, so even when you change the condition that will terminate the event loop the condition will not be reevaluated until the current event is processed.

Any way around this?

Well, sure -- move that code outside of the subroutine, and after the MainLoop. ;-) As for determining what caused MainLoop to terminate (Cancel or Submit) GrandFather already provided the solution using my example.

The intent of that example was to try and make it clarify what was happening. Normally, when I'm doing something like this, I'm more likely to do something closer to what GrandFather showed in his first example. Here's an embellished version using DialogBox

use strict; use Tk; use Tk::DialogBox; use Tk::LabFrame; if (authenticateUser()) { print "protected statement called\n"; } sub authenticateUser { my ($user, $passwd); my $mw = MainWindow->new; my $dialog = $mw->DialogBox( -title => "Login", -buttons => [qw/Login Cancel/] ); my $labFrame = $dialog->add('LabFrame', -labelside => "acrosstop", -label => "Login Form" )->pack; ## Internal Frame for padding with Labeled Frame my $iFrame = $labFrame->Frame-> pack(qw/-padx 10 -pady 10/); $iFrame->Label(-text => "User: ")->grid( $iFrame->Entry(-textvariable => \$user) ); $iFrame->Label(-text => "Password: ")->grid( $iFrame->Entry( -show => '*', -textvariable => \$passwd ), -pady => 5 ); if ($dialog->Show() eq "Login") { ## Authenticate user - assume check passed print "$user/$passwd authenticated!\n"; return 1; } return 0 }

If you read through this example you'll notice that I don't call MainLoop anywhere. This is because DialogBox is handling it internally. It works using the waitVariable method documented in the widgets pod. waitVariable functions a lot like MainLoop except that it waits for a specified variable to be set before terminating the event loop. It's still the same basic idea, though. Here's the same script, but without the DialogBox. Note the use of waitVariable, which is crucial.

use strict; use Tk; use Tk::LabFrame; if (authenticateUser()) { print "protected statement called\n"; } sub authenticateUser { my ($user, $passwd, $button); my $mw = MainWindow->new; my $labFrame = $mw->LabFrame( -labelside => "acrosstop", -label => "Login Form" )->pack(qw/-side top -padx 10/); ## Internal Frame for padding with Labeled Frame my $iFrame = $labFrame->Frame-> pack(qw/-padx 10 -pady 10/); $iFrame->Label(-text => "User: ")->grid( $iFrame->Entry(-textvariable => \$user) ); $iFrame->Label(-text => "Password: ")->grid( $iFrame->Entry( -show => '*', -textvariable => \$passwd ), -pady => 5 ); my $buttons = $mw->Frame-> pack(qw/-side bottom -pady 5/); $buttons->Button( -text => "Login", -command => sub { $button = "Login"; } )->pack(qw/-side left -padx 10/); $buttons->Button( -text => "Cancel", -command => sub { $button = "Cancel"; } )->pack(qw/-side left -padx 10/); ## Prevents the script from moving past this point ## until the $button variable has been set. $mw->waitVariable(\$button); if ($button eq "Login") { ## Authenticate user - assume check passed print "$user/$passwd authenticated!\n"; return 1; } return 0 }
Rob

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (1)
As of 2024-04-16 16:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found