PerlTk - Protocol WM_DELETE

Author

Protocol WM_DELETE_WINDOW problem

doleman

2006-11-11, 3:58 am

Hello, I an currently working on a Tk application for browsing
LDAP-servers. I have a mainwindow and some dialog for the settings. If
the dialog is open and i end the application (by pressing the
MainWindow OS-Quit button) the window is closed but some perl process
is still runnning. If i dont have the dialog open everything works
fine. I made a short programm which demonstrates the problem, it
contains 2 files named like below:

########################################
#################
# test.pl
########################################
#################
use Tk;
use WidgetDlg;

# Main
$mw =3D new MainWindow();
$mw->protocol( 'WM_DELETE_WINDOW', \&wm_Abandon );
$mw->title('Test');

$mw->Button(
-text =3D> "blah....",
-command =3D> \&Command
)->pack( -padx =3D> 2, -pady =3D> 2 );
MainLoop();

sub wm_Abandon {

if ( Exists($chldwindow) ) { $chldwindow->destroy }
$mw->destroy;
return
}
sub Command {
my ( $chldwindow, $retval );
$chldwindow =3D $mw->WidgetDlg();
$retval =3D $chldwindow->Show();
print "$retval\n";
}

########################################
##################
#WidgetDlg.pm
########################################
##################

package WidgetDlg;

use base qw ( Tk::Toplevel );

Construct Tk::Widget 'WidgetDlg';

sub Populate {
my ( $this, $args ) =3D @_;
my ( $button, $txtinput );

$this->SUPER::Populate($args)
; # appel de la m=E9thode Populate de la classe m=E8re

$this->{'text'} =3D '';
$this->{'button'} =3D '';

$this->transient( $this->Parent->toplevel );
$this->withdraw();
$this->protocol( 'WM_DELETE_WINDOW' =3D> sub { } );

$txtinput =3D $this->Entry( -textvariable =3D> \$this->{'text'} );
$txtinput->pack( -padx =3D> 2, -pady =3D> 2 );

$button =3D $this->Button(
-text =3D> 'Validate',
-command =3D> sub {
$this->{'button'} =3D 'Ok';
}
);

$button->pack( -padx =3D> 2, -pady =3D> 2 );
}

sub Wait {
my ($this) =3D @_;

$this->waitVariable( \$this->{'button'} );

$this->grabRelease();
$this->withdraw();
}
sub Show {
my ($this) =3D @_;

my ( $of, $og );

$of =3D $this->focusSave;
$og =3D $this->grabSave;

$this->Popup();

$this->grab();
$this->focus();

$this->Wait();

$of->();
$og->();

return $this->{'text'};
}

1;

########################################
#######################

If both the mainwindow and the dialog are open and you end the Programm
by pressing the OS-Quit button, the programm doesn=B4t end correctly.
Anyone got an idea what goes wrong? thanks

greets
Andrei

Jack D

2006-11-11, 9:59 pm

"doleman" <capulapeste@yahoo.com> wrote in message
news:1163237662.196659.44840@m73g2000cwd.googlegroups.com...

[snip ]

>If both the mainwindow and the dialog are open and you end the Programm
>by pressing the OS-Quit button, the programm doesn´t end correctly.

I'm not sure why your Wait subroutine doesn't respond to the MainWindow
deleting? It seems the package variable 'button' has to be updated to stop
the WaitVariable function. I have adjusted your code so it runs (and exits
properly) under use strict.

########################################
##################
#WidgetDlg.pm
########################################
##################
use Tk;
use strict;

package WidgetDlg;

use base qw ( Tk::Toplevel );

Construct Tk::Widget 'WidgetDlg';

sub Populate {
my ( $this, $args ) = @_;
my ( $button, $txtinput );

$this->SUPER::Populate($args)
; # appel de la méthode Populate de la classe mère

$this->{'text'} = '';
$this->{'button'} = '';

$this->transient( $this->Parent->toplevel );
$this->withdraw();
$this->protocol( 'WM_DELETE_WINDOW' => sub { } );

$txtinput = $this->Entry( -textvariable => \$this->{'text'} );
$txtinput->pack( -padx => 2, -pady => 2 );

$button = $this->Button(
-text => 'Validate',
-command => sub {
$this->{'button'} = 'Ok';
}
);

$button->pack( -padx => 2, -pady => 2 );
}

sub Wait {
my ($this) = @_;

$this->waitVariable( \$this->{'button'} );

$this->grabRelease();
$this->withdraw();
}
sub Show {
my ($this) = @_;

my ( $of, $og );

$of = $this->focusSave;
$og = $this->grabSave;

$this->Popup();

$this->grab();
$this->focus();

$this->Wait();

$of->();
$og->();

return $this->{'text'};
}

1;

package main;
########################################
#################
# test.pl
########################################
#################
use Tk;
#use WidgetDlg;

# Main
my $chldwindow;
my $mw = new MainWindow();
$mw->protocol( 'WM_DELETE_WINDOW', \&wm_Abandon );
$mw->title('Test');

$mw->Button(
-text => "blah....",
-command => \&Command
)->pack( -padx => 2, -pady => 2 );
MainLoop;

sub wm_Abandon {
# NOTE -This fixes the problem but is not the correct way to go about it
# you should provide a method to update this variable.
$chldwindow->{'button'}=1;
if ( Exists($chldwindow) ) { print "destroy child\n";$chldwindow->destroy }
$mw->destroy;
return;
}
sub Command {
$chldwindow = $mw->WidgetDlg();
my $retval = $chldwindow->Show();
print "$retval\n";
}

########################################
#######################

Jack

doleman

2006-11-12, 7:58 am

Thanx setting the button waitVariable to 1 solved the problem

Jack D schrieb:

> "doleman" <capulapeste@yahoo.com> wrote in message
> news:1163237662.196659.44840@m73g2000cwd.googlegroups.com...
>
> [snip ]
>
>
> I'm not sure why your Wait subroutine doesn't respond to the MainWindow
> deleting? It seems the package variable 'button' has to be updated to stop
> the WaitVariable function. I have adjusted your code so it runs (and exits
> properly) under use strict.
>
> ########################################
##################
> #WidgetDlg.pm
> ########################################
##################
> use Tk;
> use strict;
>
> package WidgetDlg;
>
> use base qw ( Tk::Toplevel );
>
> Construct Tk::Widget 'WidgetDlg';
>
> sub Populate {
> my ( $this, $args ) =3D @_;
> my ( $button, $txtinput );
>
> $this->SUPER::Populate($args)
> ; # appel de la m=E9thode Populate de la classe m=E8re
>
> $this->{'text'} =3D '';
> $this->{'button'} =3D '';
>
> $this->transient( $this->Parent->toplevel );
> $this->withdraw();
> $this->protocol( 'WM_DELETE_WINDOW' =3D> sub { } );
>
> $txtinput =3D $this->Entry( -textvariable =3D> \$this->{'text'} );
> $txtinput->pack( -padx =3D> 2, -pady =3D> 2 );
>
> $button =3D $this->Button(
> -text =3D> 'Validate',
> -command =3D> sub {
> $this->{'button'} =3D 'Ok';
> }
> );
>
> $button->pack( -padx =3D> 2, -pady =3D> 2 );
> }
>
> sub Wait {
> my ($this) =3D @_;
>
> $this->waitVariable( \$this->{'button'} );
>
> $this->grabRelease();
> $this->withdraw();
> }
> sub Show {
> my ($this) =3D @_;
>
> my ( $of, $og );
>
> $of =3D $this->focusSave;
> $og =3D $this->grabSave;
>
> $this->Popup();
>
> $this->grab();
> $this->focus();
>
> $this->Wait();
>
> $of->();
> $og->();
>
> return $this->{'text'};
> }
>
> 1;
>
>
>
> package main;
> ########################################
#################
> # test.pl
> ########################################
#################
> use Tk;
> #use WidgetDlg;
>
> # Main
> my $chldwindow;
> my $mw =3D new MainWindow();
> $mw->protocol( 'WM_DELETE_WINDOW', \&wm_Abandon );
> $mw->title('Test');
>
> $mw->Button(
> -text =3D> "blah....",
> -command =3D> \&Command
> )->pack( -padx =3D> 2, -pady =3D> 2 );
> MainLoop;
>
> sub wm_Abandon {
> # NOTE -This fixes the problem but is not the correct way to go about it
> # you should provide a method to update this variable.
> $chldwindow->{'button'}=3D1;
> if ( Exists($chldwindow) ) { print "destroy child\n";$chldwindow->destroy=
}
> $mw->destroy;
> return;
> }
> sub Command {
> $chldwindow =3D $mw->WidgetDlg();
> my $retval =3D $chldwindow->Show();
> print "$retval\n";
> }
>
>
> ########################################
#######################
>=20
> Jack

Sponsored Links