"Fossies" - the Fresh Open Source Software Archive 
Member "Tk-804.036/examples/autoraise" (15 Nov 2013, 1174 Bytes) of package /linux/misc/Tk-804.036.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #!/usr/local/bin/perl -w
2
3 # This is the old method, nowadays one would
4 # use
5 # $mw->attributes(-topmost => 1)
6 # instead.
7
8 use Tk;
9
10 $mw = MainWindow->new;
11 $hello = $mw->Button(-text => 'Hello, world', -command => sub {print STDOUT "Hello, world\n"; mkTopLevel($mw);});
12 $hello->pack;
13 $bye = $mw->Button(-text => 'Goodbye', -command => sub {print STDOUT "Goodbye, cruel world!\n"; exit;});
14 $bye->pack;
15 MainLoop;
16
17 sub unobscure
18 {
19 my $w = shift;
20 my $s = shift;
21 return unless $w == $w->toplevel;
22 my $g = $w->grab('current'); # sorry Tk-b6 form ... would be Tk->grab('current');
23 return unless defined($g);
24 print "$w $s\n";
25 if ($w == $g)
26 {
27 $g->raise($g->MainWindow) if ($s !~ /Unobscured$/);
28 }
29 else
30 {
31 $g->raise if ($s !~ /FullyObscured$/);
32 }
33 }
34
35 sub mkTopLevel {
36 my $main = shift;
37 my $topLevelWin = $main->Toplevel();
38
39 # raise if obscured
40 $topLevelWin->bind('all',"<Visibility>", [\&unobscure, Ev('s')]);
41
42 my $cancel = $topLevelWin->Button(
43 "-text" => "Bye",
44 "-command" =>
45 sub { print "bye\n"; $topLevelWin->destroy; }
46 );
47 $cancel->pack(-side => 'top');
48 grab $topLevelWin;
49 }
50
51 1;