summaryrefslogtreecommitdiffstats
path: root/library/ttk/notebook.tcl
blob: d2edddc8c01b529aa0a0708ca11337ed144ef0a9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
#
# $Id: notebook.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
#
# Bindings for TNotebook widget
#

namespace eval ttk::notebook {
    variable TLNotebooks ;# See enableTraversal
}

bind TNotebook <ButtonPress-1>		{ ttk::notebook::Press %W %x %y }
bind TNotebook <Key-Right>		{ ttk::notebook::CycleTab %W  1; break }
bind TNotebook <Key-Left>		{ ttk::notebook::CycleTab %W -1; break }
bind TNotebook <Control-Key-Tab>	{ ttk::notebook::CycleTab %W  1; break }
bind TNotebook <Control-Shift-Key-Tab>	{ ttk::notebook::CycleTab %W -1; break }
catch {
bind TNotebook <Control-ISO_Left_Tab>	{ ttk::notebook::CycleTab %W -1; break }
}
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.
#
proc ttk::notebook::ActivateTab {w tab} {
    if {[$w index $tab] eq [$w index current]} {
	focus $w
    } else {
    	$w select $tab
	update ;# needed so focus logic sees correct mapped/unmapped states
	if {[set f [ttk::focusFirst [$w select]]] ne ""} {
	    tk::TabToWindow $f
	}
    }
}

# ttk::focusFirst $w --
#	Return the first descendant of $w, in preorder traversal order,
#	that can take keyboard focus, "" if none do.
#
# See also: tk_focusNext
#
proc ttk::focusFirst {w} {
    if {[ttk::takesFocus $w]} {
	return $w
    }
    foreach child [winfo children $w] {
	if {[set c [ttk::focusFirst $child]] ne ""} {
	    return $c
	}
    }
    return ""
}

# Press $nb $x $y --
#	ButtonPress-1 binding for notebook widgets.
#	Activate the tab under the mouse cursor, if any.
#
proc ttk::notebook::Press {w x y} {
    set index [$w index @$x,$y]
    if {$index ne ""} {
	ActivateTab $w $index
    }
}

# CycleTab --
#	Select the next/previous tab in the list.
#
proc ttk::notebook::CycleTab {w dir} {
    if {[$w index end] != 0} {
	set current [$w index current]
	set select [expr {($current + $dir) % [$w index end]}]
	while {[$w tab $select -state] != "normal" && ($select != $current)} {
	    set select [expr {($select + $dir) % [$w index end]}]
	}
	if {$select != $current} {
	    ActivateTab $w $select
	}
    }
}

# MnemonicTab $nb $key --
#	Scan all tabs in the specified notebook for one with the 
#	specified mnemonic. If found, returns path name of tab;
#	otherwise returns ""
#
proc ttk::notebook::MnemonicTab {nb key} {
    set key [string toupper $key]
    foreach tab [$nb tabs] {
	set label [$nb tab $tab -text]
	set underline [$nb tab $tab -underline]
	set mnemonic [string toupper [string index $label $underline]]
	if {$mnemonic ne "" && $mnemonic eq $key} {
	    return $tab
	}
    }
    return ""
}

# +++ Toplevel keyboard traversal.
#

# enableTraversal --
#	Enable keyboard traversal for a notebook widget
#	by adding bindings to the containing toplevel window.
#
#	TLNotebooks($top) keeps track of the list of all traversal-enabled 
#	notebooks contained in the toplevel 
#
proc ttk::notebook::enableTraversal {nb} {
    variable TLNotebooks

    set top [winfo toplevel $nb]

    if {![info exists TLNotebooks($top)]} {
	# Augment $top bindings:
	#
	bind $top <Control-Key-Tab> 	     {+ttk::notebook::TLCycleTab %W  1}
	bind $top <Shift-Control-Key-Tab>    {+ttk::notebook::TLCycleTab %W -1}
	catch {
	bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
	}
	bind $top <Alt-KeyPress> \
	    +[list ttk::notebook::MnemonicActivation $top %K]
	bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
    }

    lappend TLNotebooks($top) $nb
}

# TLCleanup -- <Destroy> binding for traversal-enabled toplevels
#
proc ttk::notebook::TLCleanup {w} {
    variable TLNotebooks
    if {$w eq [winfo toplevel $w]} {
	unset -nocomplain -please TLNotebooks($w)
    }
}

# Cleanup -- <Destroy> binding for notebooks
#
proc ttk::notebook::Cleanup {nb} {
    variable TLNotebooks
    set top [winfo toplevel $nb]
    if {[info exists TLNotebooks($top)]} {
	set index [lsearch -exact $TLNotebooks($top) $nb]
        set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
    }
}

# EnclosingNotebook $w -- 
#	Return the nearest traversal-enabled notebook widget
#	that contains $w.
#
# BUGS: this only works properly for tabs that are direct children
#	of the notebook widget.  This routine should follow the
#	geometry manager hierarchy, not window ancestry, but that
#	information is not available in Tk.
#
proc ttk::notebook::EnclosingNotebook {w} {
    variable TLNotebooks

    set top [winfo toplevel $w]
    if {![info exists TLNotebooks($top)]} { return }

    while {$w ne $top  && $w ne ""} {
	if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
	    return $w
	}
	set w [winfo parent $w]
    }
    return ""
}

# TLCycleTab --
#	toplevel binding procedure for Control-Tab / Shift-Control-Tab
#	Select the next/previous tab in the nearest ancestor notebook. 
#
proc ttk::notebook::TLCycleTab {w dir} {
    set nb [EnclosingNotebook $w]
    if {$nb ne ""} {
	CycleTab $nb $dir
	return -code break
    }
}

# MnemonicActivation $nb $key --
#	Alt-KeyPress binding procedure for mnemonic activation.
#	Scan all notebooks in specified toplevel for a tab with the
#	the specified mnemonic.  If found, activate it and return TCL_BREAK.
#
proc ttk::notebook::MnemonicActivation {top key} {
    variable TLNotebooks
    foreach nb $TLNotebooks($top) {
	if {[set tab [MnemonicTab $nb $key]] ne ""} {
	    ActivateTab $nb [$nb index $tab]
	    return -code break
	}
    }
}