Reworked ActivateTab focus selection logic

([Bug 2917688], also fixes [Bug 2546779]).

3 files changed, 71 insertions, 38 deletions

diff --git a/ChangeLog b/ChangeLog
index 61e528d..f314bd8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2009-12-25  Joe English  <jenglish@users.sourceforge.net>
+
+	* library/ttk/utils.tcl, library/notebook.tcl:
+	Reworked ActivateTab focus selection logic ([Bug 2917688],
+	also fixes [Bug 2546779]).
+
 2009-12-25  Donal K. Fellows  <dkf@users.sf.net>
 
 	* doc/option.n: [Bug 2914943]: Correct the first example.
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 --