"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;