1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
#!/usr/local/bin/perl -w
# This is the old method, nowadays one would
# use
# $mw->attributes(-topmost => 1)
# instead.
use Tk;
$mw = MainWindow->new;
$hello = $mw->Button(-text => 'Hello, world', -command => sub {print STDOUT "Hello, world\n"; mkTopLevel($mw);});
$hello->pack;
$bye = $mw->Button(-text => 'Goodbye', -command => sub {print STDOUT "Goodbye, cruel world!\n"; exit;});
$bye->pack;
MainLoop;
sub unobscure
{
my $w = shift;
my $s = shift;
return unless $w == $w->toplevel;
my $g = $w->grab('current'); # sorry Tk-b6 form ... would be Tk->grab('current');
return unless defined($g);
print "$w $s\n";
if ($w == $g)
{
$g->raise($g->MainWindow) if ($s !~ /Unobscured$/);
}
else
{
$g->raise if ($s !~ /FullyObscured$/);
}
}
sub mkTopLevel {
my $main = shift;
my $topLevelWin = $main->Toplevel();
# raise if obscured
$topLevelWin->bind('all',"<Visibility>", [\&unobscure, Ev('s')]);
my $cancel = $topLevelWin->Button(
"-text" => "Bye",
"-command" =>
sub { print "bye\n"; $topLevelWin->destroy; }
);
$cancel->pack(-side => 'top');
grab $topLevelWin;
}
1;
|
