home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / focusPrev.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  1.6 KB  |  62 lines
  1. # NOTE: Derived from blib\lib\Tk.pm.  Changes made here will be lost.
  2. package Tk;
  3.  
  4. # focusPrev --
  5. # This procedure is invoked to move the input focus to the previous
  6. # window before a given one. "Previous" is defined in terms of the
  7. # window stacking order, with all the windows underneath a given
  8. # top-level (no matter how deeply nested in the hierarchy) considered.
  9. #
  10. # Arguments:
  11. # w - Name of a window: the procedure will set the focus
  12. # to the previous window before this one in the traversal
  13. # order.
  14. sub focusPrev
  15. {
  16.  my $w = shift;
  17.  my $cur = $w;
  18.  my @children;
  19.  my $i;
  20.  my $parent;
  21.  while (1)
  22.   {
  23.    # Collect information about the current window's position
  24.    # among its siblings. Also, if the window is a top-level,
  25.    # then reposition to just after the last child of the window.
  26.    if ($cur->toplevel() == $cur)
  27.     {
  28.      $parent = $cur;
  29.      @children = $cur->FocusChildren();
  30.      $i = @children;
  31.     }
  32.    else
  33.     {
  34.      $parent = $cur->parent();
  35.      @children = $parent->FocusChildren();
  36.      $i = lsearch(\@children,$cur);
  37.     }
  38.    # Go to the previous sibling, then descend to its last descendant
  39.    # (highest in stacking order. While doing this, ignore top-levels
  40.    # and their descendants. When we run out of descendants, go up
  41.    # one level to the parent.
  42.    while ($i > 0)
  43.     {
  44.      $i--;
  45.      $cur = $children[$i];
  46.      next if ($cur->toplevel() == $cur);
  47.      $parent = $cur;
  48.      @children = $parent->FocusChildren();
  49.      $i = @children;
  50.     }
  51.    $cur = $parent;
  52.    if ($cur == $w || $cur->FocusOK)
  53.     {
  54.      $cur->Tk::focus;
  55.      return;
  56.     }
  57.   }
  58.  
  59. }
  60.  
  61. 1;
  62.