diff options
Diffstat (limited to 'library/ttk/utils.tcl')
-rw-r--r-- | library/ttk/utils.tcl | 70 |
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 -- |