diff options
Diffstat (limited to 'library/ttk')
| -rw-r--r-- | library/ttk/notebook.tcl | 33 | ||||
| -rw-r--r-- | library/ttk/utils.tcl | 70 |
2 files changed, 65 insertions, 38 deletions
diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 325d75d..04abdbe 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -1,5 +1,5 @@ # -# $Id: notebook.tcl,v 1.5 2009/11/12 18:17:14 jenglish Exp $ +# $Id: notebook.tcl,v 1.6 2009/12/25 19:11:56 jenglish Exp $ # # Bindings for TNotebook widget # @@ -21,21 +21,26 @@ bind TNotebook <Destroy> { ttk::notebook::Cleanup %W } # ActivateTab $nb $tab -- # Select the specified tab and set focus. # -# If $tab was already the current tab, set the focus to the -# notebook widget. Otherwise, set the focus to the first -# traversable widget in the pane. The behavior is that the -# notebook takes focus when the user selects the same tab -# a second time. This mirrors Windows tab behavior. +# Desired behavior: +# + take focus when reselecting the currently-selected tab; +# + keep focus if the notebook already has it; +# + otherwise set focus to the first traversable widget +# in the newly-selected tab; +# + do not leave the focus in a deselected tab. # proc ttk::notebook::ActivateTab {w tab} { - if {[$w index $tab] eq [$w index current]} { - focus $w + set oldtab [$w select] + $w select $tab + set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled + + if {[focus] eq $w} { return } + if {$newtab eq $oldtab} { focus $w ; return } + + update idletasks ;# needed so focus logic sees correct mapped states + if {[set f [ttk::focusFirst $newtab]] ne ""} { + ttk::traverseTo $f } else { - $w select $tab - update idletasks ;# needed so focus logic sees correct mapped states - if {[set f [ttk::focusFirst [$w select]]] ne ""} { - tk::TabToWindow $f - } + focus $w } } @@ -102,6 +107,8 @@ proc ttk::notebook::enableTraversal {nb} { if {![info exists TLNotebooks($top)]} { # Augment $top bindings: # + bind $top <Control-Key-Next> {+ttk::notebook::TLCycleTab %W 1} + bind $top <Control-Key-Prior> {+ttk::notebook::TLCycleTab %W -1} bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1} bind $top <Shift-Control-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} catch { 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 -- |