home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Toplevel.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.8 KB  |  69 lines
  1. # Copyright (c) 1995-1997 Nick Ing-Simmons. All rights reserved.
  2. # This program is free software; you can redistribute it and/or
  3. # modify it under the same terms as Perl itself.
  4. package Tk::Toplevel; 
  5. require Tk::Frame;
  6. require Tk::Wm;
  7. use AutoLoader;
  8. @ISA = qw(Tk::Wm Tk::Frame);
  9.  
  10. Construct Tk::Widget 'Toplevel';
  11.  
  12. sub Tk_cmd { \&Tk::toplevel }
  13.  
  14. sub CreateArgs
  15. {
  16.  my ($package,$parent,$args) = @_;
  17.  my @result = $package->SUPER::CreateArgs($parent,$args);
  18.  my $screen = delete $args->{-screen};                     
  19.  push(@result, '-screen' => $screen) if (defined $screen);
  20.  return @result;
  21. }
  22.  
  23. sub Populate
  24. {
  25.  my ($cw,$arg) = @_;
  26.  $cw->SUPER::Populate($arg);
  27.  $cw->ConfigSpecs('-title',[METHOD,undef,undef,$cw->class]);
  28. }
  29.  
  30. 1;
  31. __END__
  32.  
  33. sub Icon
  34. {
  35.  require Tk::Toplevel;
  36.  my ($top,%args) = @_;
  37.  my $icon  = $top->iconwindow;
  38.  my $state = $top->state;                 
  39.  if ($state ne 'withdrawn')
  40.   {
  41.    $top->withdraw; 
  42.    $top->update;    # Let attributes propogate
  43.   }
  44.  unless (defined $icon)
  45.   {
  46.    $icon  = Tk::Toplevel->new($top,'-borderwidth' => 0,'-class'=>'Icon');
  47.    $icon->withdraw;                        
  48.    # Fake Populate 
  49.    my $lab  = $icon->Component('Label' => 'icon');
  50.    $lab->pack('-expand'=>1,'-fill' => 'both');
  51.    $lab->DisableButtonEvents;              
  52.    $icon->DisableButtonEvents;             
  53.    $icon->ConfigSpecs(DEFAULT => ['DESCENDANTS']);
  54.    # Now do tail of InitObject
  55.    $icon->ConfigDefault(\%args);
  56.    # And configure that new would have done
  57.    $top->iconwindow($icon);                
  58.   }
  59.  $icon->configure(%args);
  60.  $icon->idletasks; # Let size request propogate
  61.  $icon->geometry($icon->ReqWidth . "x" . $icon->ReqHeight); 
  62.  $icon->update;    # Let attributes propogate
  63.  $top->deiconify if ($state eq 'normal');
  64.  $top->iconify   if ($state eq 'iconic');
  65. }
  66.  
  67.  
  68.  
  69.