File: autoraise

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (46 lines) | stat: -rwxr-xr-x 1,076 bytes parent folder | download | duplicates (5)
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
#!/usr/local/bin/perl -w

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;