home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Toplevel / Icon.al < prev   
Encoding:
Text File  |  1997-08-10  |  1.2 KB  |  39 lines
  1. # NOTE: Derived from blib\lib\Tk\Toplevel.pm.  Changes made here will be lost.
  2. package Tk::Toplevel;
  3.  
  4. sub Icon
  5. {
  6.  require Tk::Toplevel;
  7.  my ($top,%args) = @_;
  8.  my $icon  = $top->iconwindow;
  9.  my $state = $top->state;                 
  10.  if ($state ne 'withdrawn')
  11.   {
  12.    $top->withdraw; 
  13.    $top->update;    # Let attributes propogate
  14.   }
  15.  unless (defined $icon)
  16.   {
  17.    $icon  = Tk::Toplevel->new($top,'-borderwidth' => 0,'-class'=>'Icon');
  18.    $icon->withdraw;                        
  19.    # Fake Populate 
  20.    my $lab  = $icon->Component('Label' => 'icon');
  21.    $lab->pack('-expand'=>1,'-fill' => 'both');
  22.    $lab->DisableButtonEvents;              
  23.    $icon->DisableButtonEvents;             
  24.    $icon->ConfigSpecs(DEFAULT => ['DESCENDANTS']);
  25.    # Now do tail of InitObject
  26.    $icon->ConfigDefault(\%args);
  27.    # And configure that new would have done
  28.    $top->iconwindow($icon);                
  29.   }
  30.  $icon->configure(%args);
  31.  $icon->idletasks; # Let size request propogate
  32.  $icon->geometry($icon->ReqWidth . "x" . $icon->ReqHeight); 
  33.  $icon->update;    # Let attributes propogate
  34.  $top->deiconify if ($state eq 'normal');
  35.  $top->iconify   if ($state eq 'iconic');
  36. }
  37.  
  38. 1;
  39.