Cancel close of mainwindow in Tk on Windows

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

I am looking for a way to popup a dialog when a user presses the 'x' button to close a mainwindow of a Tk app on Windows.
I want to intercept the OnDestroy call and popup a dialog with an option to cancel which will prevent the destroy call and allow the program to continue. Any ideas?

use Tk;

my $mw = MainWindow->new( -title=> "Cancel Test");
    example();
MainLoop;

sub example {
    $mw->OnDestroy(sub{
        $response = $mw->messageBox(-icon => 'question', -message => '
+Really Exit?', -title => 'Continue?', -type => 'OkCancel', -default =
+> 'Ok');
        print "Reply:$response\n";
        $mw->break if $response eq 'Cancel';})
}
[download]

Comment on Cancel close of mainwindow in Tk on Windows Download Code

Replies are listed 'Best First'.
Re: Cancel close of mainwindow in Tk on Windows by Anonymous Monk on Oct 11, 2007 at 23:18 UTC
Hi, jdporter answered this a couple of days ago. You can handle the WM_DELETE_WINDOW protocol: `use Tk; use Tk::Dialog; my $mw = new MainWindow; $mw->Button( -text => "Exit", -command => \&confirm_exit )->pack; $mw->protocol( WM_DELETE_WINDOW => \&confirm_exit ); my $exit_dlg = $mw->Dialog( -text => "Really exit?", -buttons => [qw(Y +es No)], -default_button => 'Yes' ); MainLoop; warn "exited MainLoop\n"; sub confirm_exit { my $yn = $exit_dlg->Show; $yn =~ /y/i or return; warn "destroying MainWindow\n"; $mw->destroy; }` [download] A word spoken in Mind will reach its own level, in the objective world, by its own weight , I tried it and it does the trick. Thanks jdporter. J.C.	[reply] [d/l]
Re^2: Cancel close of mainwindow in Tk on Windows by cadphile (Beadle) on Oct 11, 2007 at 23:55 UTC
J.C.'s/jdporter's solution is much simpler than mine... I think I'll clean up and simplify my own code a bit...! Thanks!!	[reply]
Re: Cancel close of mainwindow in Tk on Windows by cadphile (Beadle) on Oct 11, 2007 at 23:49 UTC
You can do something like this in the button definition: Read more... (649 Bytes) You need then a subroutine to create a popup window, and receive the arguments passed above, and then return either 1 or 0, depending on the results of the the query. Note that you should probably do additional things, like make the popup do a toplevel grab, so that it has grabbed the input focus, bind <RETURN> to the default function, which would be NO presumably, then make the toplevel do a wait... Here's a stripped down version of this that could work. In my code, I pass the affirmative and negative response strings to the generic popup subroutine, so I can call it with a variety of queries. This is pared down code from the actual source that I copied it from, so hopefully it's sufficient in itself, but you may need to add tweaks here and there, for padding, fonts, window features, etc. The toplevel window is in `$topLevel`: Read more... (4 kB) Hope this may be useful for you... Cheers! Cadphile...	[reply] [d/l] [select]