home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Menu / Unpost.al < prev   
Encoding:
Text File  |  1997-08-10  |  2.3 KB  |  74 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Menu.pm.  Changes made here will be lost.
  2. package Tk::Menu;
  3.  
  4. # Unpost --
  5. # This procedure unposts a given menu, plus all of its ancestors up
  6. # to (and including) a menubutton, if any. It also restores various
  7. # values to what they were before the menu was posted, and releases
  8. # a grab if there's a menubutton involved. Special notes:
  9. # 1. It's important to unpost all menus before releasing the grab, so
  10. # that any Enter-Leave events (e.g. from menu back to main
  11. # application) have mode NotifyGrab.
  12. # 2. Be sure to enclose various groups of commands in "catch" so that
  13. # the procedure will complete even if the menubutton or the menu
  14. # or the grab window has been deleted.
  15. #
  16. # Arguments:
  17. # menu - Name of a menu to unpost. Ignored if there
  18. # is a posted menubutton.
  19. sub Unpost
  20. {
  21.  my $menu = shift;
  22.  my $mb = $Tk::postedMb;
  23.  
  24.  # Restore focus right away (otherwise X will take focus away when
  25.  # the menu is unmapped and under some window managers (e.g. olvwm)
  26.  # we'll lose the focus completely).
  27.  
  28.  eval {local $SIG{__DIE__}; $Tk::focus->focus() } if (defined $Tk::focus);
  29.  undef $Tk::focus;
  30.  
  31.  # Unpost menu(s) and restore some stuff that's dependent on
  32.  # what was posted.
  33.  eval {local $SIG{__DIE__}; 
  34.    if (defined $mb)
  35.      {
  36.       $menu = $mb->cget("-menu");
  37.       $menu->unpost();
  38.       $Tk::postedMb = undef;
  39.       $mb->configure("-cursor",$Tk::cursor);
  40.       $mb->configure("-relief",$Tk::relief)
  41.      }
  42.     elsif (defined $Tk::popup)
  43.      {
  44.       $Tk::popup->unpost();
  45.       undef $Tk::popup;
  46.      }
  47.     elsif (defined $menu && ref $menu && $menu->overrideredirect)
  48.      {
  49.       # We're in a cascaded sub-menu from a torn-off menu or popup.
  50.       # Unpost all the menus up to the toplevel one (but not
  51.       # including the top-level torn-off one) and deactivate the
  52.       # top-level torn off menu if there is one.
  53.       while (1)
  54.        {
  55.         $parent = $menu->parent;
  56.         last if (!$parent->IsMenu || !$parent->ismapped);
  57.         $parent->postcascade("none");
  58.         last if (!$parent->overrideredirect);
  59.         $menu = $parent
  60.        }
  61.       $menu->unpost()
  62.      }
  63.   };
  64.  warn "$@" if ($@);
  65.  # Release grab, if any.
  66.  if (defined $menu && ref $menu)
  67.   {
  68.    my $grab = $menu->grabCurrent;
  69.    $grab->grabRelease if (defined $grab);
  70.   }
  71. }
  72.  
  73. 1;
  74.