home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Wm / Popup.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  866 b   |  41 lines
  1. # NOTE: Derived from blib\lib\Tk\Wm.pm.  Changes made here will be lost.
  2. package Tk::Wm;
  3.  
  4. sub Popup
  5. {
  6.  my $w = shift;
  7.  $w->configure(@_) if @_;
  8.  $w->idletasks;
  9.  my ($mw,$mh) = ($w->reqwidth,$w->reqheight);
  10.  my ($rx,$ry,$rw,$rh) = (0,0,0,0);
  11.  my $base    = $w->cget('-popover');
  12.  my $outside = 0;
  13.  if (defined $base)
  14.   {
  15.    if ($base eq 'cursor')
  16.     {
  17.      ($rx,$ry) = $w->pointerxy;
  18.     }
  19.    else
  20.     {
  21.      $rx = $base->rootx; 
  22.      $ry = $base->rooty; 
  23.      $rw = $base->Width; 
  24.      $rh = $base->Height;
  25.     }
  26.   }
  27.  else
  28.   {
  29.    my $sc = $w->parent->toplevel;
  30.    $rx = -$sc->vrootx;
  31.    $ry = -$sc->vrooty;
  32.    $rw = $w->screenwidth;
  33.    $rh = $w->screenheight;
  34.   }
  35.  my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh);
  36.  ($X,$Y)    = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh);
  37.  $w->Post($X,$Y);
  38. }
  39.  
  40. 1;
  41.