summaryrefslogtreecommitdiffstats
path: root/library/ttk/utils.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/ttk/utils.tcl')
-rw-r--r--library/ttk/utils.tcl70
1 files changed, 45 insertions, 25 deletions
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index 9f3d12d..a67b868 100644
--- a/library/ttk/utils.tcl
+++ b/library/ttk/utils.tcl
@@ -1,22 +1,52 @@
#
-# $Id: utils.tcl,v 1.7 2008/12/07 21:24:12 jenglish Exp $
+# $Id: utils.tcl,v 1.8 2009/12/25 19:11:56 jenglish Exp $
#
# Utilities for widget implementations.
#
### Focus management.
#
+# See also: #1516479
+#
## ttk::takefocus --
# This is the default value of the "-takefocus" option
-# for widgets that participate in keyboard navigation.
+# for ttk::* widgets that participate in keyboard navigation.
+#
+# NOTES:
+# tk::FocusOK (called by tk_focusNext) tests [winfo viewable]
+# if -takefocus is 1, empty, or missing; but not if it's a
+# script prefix, so we have to check that here as well.
#
-# See also: tk::FocusOK
#
proc ttk::takefocus {w} {
expr {[$w instate !disabled] && [winfo viewable $w]}
}
+## ttk::GuessTakeFocus --
+# This routine is called as a fallback for widgets
+# with a missing or empty -takefocus option.
+#
+# It implements the same heuristics as tk::FocusOK.
+#
+proc ttk::GuessTakeFocus {w} {
+ # Don't traverse to widgets with '-state disabled':
+ #
+ if {![catch {$w cget -state} state] && $state eq "disabled"} {
+ return 0
+ }
+
+ # Allow traversal to widgets with explicit key or focus bindings:
+ #
+ if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} {
+ return 1;
+ }
+
+ # Default is nontraversable:
+ #
+ return 0;
+}
+
## ttk::traverseTo $w --
# Set the keyboard focus to the specified window.
#
@@ -38,36 +68,26 @@ proc ttk::clickToFocus {w} {
}
## ttk::takesFocus w --
-# Test if the widget can take keyboard focus:
-#
-# + widget is viewable, AND:
-# - if -takefocus is missing or empty, return 0, OR
-# - if -takefocus is 0 or 1, return that value, OR
-# - append the widget name to -takefocus and evaluate it
-# as a script.
+# Test if the widget can take keyboard focus.
#
-# See also: tk::FocusOK
-#
-# Note: This routine doesn't implement the same fallback heuristics
-# as tk::FocusOK.
+# See the description of the -takefocus option in options(n)
+# for details.
#
proc ttk::takesFocus {w} {
-
- if {![winfo viewable $w]} { return 0 }
-
- if {![catch {$w cget -takefocus} takefocus]} {
+ if {![winfo viewable $w]} {
+ return 0
+ } elseif {[catch {$w cget -takefocus} takefocus]} {
+ return [GuessTakeFocus $w]
+ } else {
switch -- $takefocus {
- 0 -
- 1 { return $takefocus }
- "" { return 0 }
+ "" { return [GuessTakeFocus $w] }
+ 0 { return 0 }
+ 1 { return 1 }
default {
- set value [uplevel #0 $takefocus [list $w]]
- return [expr {$value eq 1}]
+ return [expr {[uplevel #0 $takefocus [list $w]] == 1}]
}
}
}
-
- return 0
}
## ttk::focusFirst $w --