home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Menu / TraverseWithinMenu.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  1.3 KB  |  51 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Menu.pm.  Changes made here will be lost.
  2. package Tk::Menu;
  3.  
  4. # tkTraverseWithinMenu
  5. # This procedure implements keyboard traversal within a menu. It
  6. # searches for an entry in the menu that has "char" underlined. If
  7. # such an entry is found, it is invoked and the menu is unposted.
  8. #
  9. # Arguments:
  10. # w - The name of the menu widget.
  11. # char - The character to look for; case is
  12. # ignored. If the string is empty then
  13. # nothing happens.
  14. sub TraverseWithinMenu
  15. {
  16.  my $w = shift;
  17.  my $char = shift;
  18.  return unless (defined $char);
  19.  $char = "\L$char";
  20.  my $last = $w->index("last");
  21.  return if ($last eq "none");
  22.  for ($i = 0;$i <= $last;$i += 1)
  23.   {
  24.    my $label = eval {local $SIG{__DIE__};  $w->entrycget($i,"-label") };
  25.    next unless defined($label);
  26.    my $ul = $w->entrycget($i,"-underline");
  27.    if (defined $ul && $ul >= 0)
  28.     {
  29.      $label = substr("\L$label",$ul,1);
  30.      if (defined($label) && $label eq $char)
  31.       {
  32.        if ($w->type($i) eq 'cascade')
  33.         {
  34.          $w->postcascade($i);
  35.          $w->activate($i);
  36.          my $m2 = $w->entrycget($i,'-menu');
  37.          $m2->FirstEntry if (defined $m2);
  38.         }
  39.        else
  40.         {
  41.          $w->Unpost();  
  42.          $w->invoke($i);
  43.         }
  44.        return;
  45.       }
  46.     }
  47.   }
  48. }
  49.  
  50. 1;
  51.