home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Menubutton / Post.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  1.8 KB  |  65 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Menubutton.pm.  Changes made here will be lost.
  2. package Tk::Menubutton;
  3.  
  4. # Post --
  5. # Given a menubutton, this procedure does all the work of posting
  6. # its associated menu and unposting any other menu that is currently
  7. # posted.
  8. #
  9. # Arguments:
  10. # w - The name of the menubutton widget whose menu
  11. # is to be posted.
  12. # x, y - Root coordinates of cursor, used for positioning
  13. # option menus. If not specified, then the center
  14. # of the menubutton is used for an option menu.
  15. sub Post
  16. {
  17.  my $w = shift;
  18.  my $x = shift;
  19.  my $y = shift;
  20.  return if ($w->cget("-state") eq "disabled");
  21.  return if (defined $Tk::postedMb && $w == $Tk::postedMb);
  22.  my $menu = $w->cget("-menu");
  23.  return unless (defined($menu) && $menu->index('last') ne 'none');
  24.  
  25.  my $wpath = $w->PathName;
  26.  my $mpath = $menu->PathName;
  27.  unless (index($mpath,"$wpath.") == 0)
  28.   {
  29.    die "Cannot post $mpath : not a descendant of $wpath";
  30.   }
  31.  
  32.  my $cur = $Tk::postedMb;
  33.  if (defined $cur)
  34.   {
  35.    Tk::Menu->Unpost(undef); # fixme
  36.   }
  37.  $Tk::cursor = $w->cget("-cursor");
  38.  $Tk::relief = $w->cget("-relief");
  39.  $w->configure("-cursor","arrow");
  40.  $w->configure("-relief","raised");
  41.  $Tk::postedMb = $w;
  42.  $Tk::focus = $w->focusCurrent;
  43.  $menu->activate("none");
  44.  # If this looks like an option menubutton then post the menu so
  45.  # that the current entry is on top of the mouse. Otherwise post
  46.  # the menu just below the menubutton, as for a pull-down.
  47.  if ($w->cget("-indicatoron") == 1 && defined($w->cget("-textvariable")))
  48.   {
  49.    if (!defined($y))
  50.     {
  51.      $x = $w->rootx+$w->width/2;
  52.      $y = $w->rooty+$w->height/2
  53.     }
  54.    $menu->PostOverPoint($x,$y,$menu->FindName($w->cget("-text")))
  55.   }
  56.  else
  57.   {
  58.    $menu->post($w->rootx,$w->rooty+$w->height);
  59.   }
  60.  $menu->Enter();
  61.  $w->grab("-global")
  62. }
  63.  
  64. 1;
  65.