summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.old/lib/auto/Tk/focusPrev.al
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/auto/Tk/focusPrev.al')
-rw-r--r--Master/tlpkg/tlperl.old/lib/auto/Tk/focusPrev.al65
1 files changed, 65 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/auto/Tk/focusPrev.al b/Master/tlpkg/tlperl.old/lib/auto/Tk/focusPrev.al
new file mode 100644
index 00000000000..340feab598f
--- /dev/null
+++ b/Master/tlpkg/tlperl.old/lib/auto/Tk/focusPrev.al
@@ -0,0 +1,65 @@
+# NOTE: Derived from blib\lib\Tk.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package Tk;
+
+#line 571 "blib\lib\Tk.pm (autosplit into blib\lib\auto\Tk\focusPrev.al)"
+# focusPrev --
+# This procedure is invoked to move the input focus to the previous
+# window before a given one. "Previous" is defined in terms of the
+# window stacking order, with all the windows underneath a given
+# top-level (no matter how deeply nested in the hierarchy) considered.
+#
+# Arguments:
+# w - Name of a window: the procedure will set the focus
+# to the previous window before this one in the traversal
+# order.
+sub focusPrev
+{
+ my $w = shift;
+ my $cur = $w;
+ my @children;
+ my $i;
+ my $parent;
+ while (1)
+ {
+ # Collect information about the current window's position
+ # among its siblings. Also, if the window is a top-level,
+ # then reposition to just after the last child of the window.
+ if ($cur->toplevel() == $cur)
+ {
+ $parent = $cur;
+ @children = $cur->FocusChildren();
+ $i = @children;
+ }
+ else
+ {
+ $parent = $cur->parent();
+ @children = $parent->FocusChildren();
+ $i = lsearch(\@children,$cur);
+ }
+ # Go to the previous sibling, then descend to its last descendant
+ # (highest in stacking order. While doing this, ignore top-levels
+ # and their descendants. When we run out of descendants, go up
+ # one level to the parent.
+ while ($i > 0)
+ {
+ $i--;
+ $cur = $children[$i];
+ next if ($cur->toplevel() == $cur);
+ $parent = $cur;
+ @children = $parent->FocusChildren();
+ $i = @children;
+ }
+ $cur = $parent;
+ if ($cur == $w || $cur->FocusOK)
+ {
+ $cur->tabFocus;
+ return;
+ }
+ }
+
+}
+
+# end of Tk::focusPrev
+1;