Mark msysGit as obsolete
[msysgit.git] / mingw / lib / tk8.5 / ttk / notebook.tcl
blobd424b6c7b8244a155216d8ffe183749480254590
2 # Bindings for TNotebook widget
5 namespace eval ttk::notebook {
6 variable TLNotebooks ;# See enableTraversal
9 bind TNotebook <ButtonPress-1> { ttk::notebook::Press %W %x %y }
10 bind TNotebook <Key-Right> { ttk::notebook::CycleTab %W 1; break }
11 bind TNotebook <Key-Left> { ttk::notebook::CycleTab %W -1; break }
12 bind TNotebook <Control-Key-Tab> { ttk::notebook::CycleTab %W 1; break }
13 bind TNotebook <Control-Shift-Key-Tab> { ttk::notebook::CycleTab %W -1; break }
14 catch {
15 bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break }
17 bind TNotebook <Destroy> { ttk::notebook::Cleanup %W }
19 # ActivateTab $nb $tab --
20 # Select the specified tab and set focus.
22 # Desired behavior:
23 # + take focus when reselecting the currently-selected tab;
24 # + keep focus if the notebook already has it;
25 # + otherwise set focus to the first traversable widget
26 # in the newly-selected tab;
27 # + do not leave the focus in a deselected tab.
29 proc ttk::notebook::ActivateTab {w tab} {
30 set oldtab [$w select]
31 $w select $tab
32 set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled
34 if {[focus] eq $w} { return }
35 if {$newtab eq $oldtab} { focus $w ; return }
37 update idletasks ;# needed so focus logic sees correct mapped states
38 if {[set f [ttk::focusFirst $newtab]] ne ""} {
39 ttk::traverseTo $f
40 } else {
41 focus $w
45 # Press $nb $x $y --
46 # ButtonPress-1 binding for notebook widgets.
47 # Activate the tab under the mouse cursor, if any.
49 proc ttk::notebook::Press {w x y} {
50 set index [$w index @$x,$y]
51 if {$index ne ""} {
52 ActivateTab $w $index
56 # CycleTab --
57 # Select the next/previous tab in the list.
59 proc ttk::notebook::CycleTab {w dir} {
60 if {[$w index end] != 0} {
61 set current [$w index current]
62 set select [expr {($current + $dir) % [$w index end]}]
63 while {[$w tab $select -state] != "normal" && ($select != $current)} {
64 set select [expr {($select + $dir) % [$w index end]}]
66 if {$select != $current} {
67 ActivateTab $w $select
72 # MnemonicTab $nb $key --
73 # Scan all tabs in the specified notebook for one with the
74 # specified mnemonic. If found, returns path name of tab;
75 # otherwise returns ""
77 proc ttk::notebook::MnemonicTab {nb key} {
78 set key [string toupper $key]
79 foreach tab [$nb tabs] {
80 set label [$nb tab $tab -text]
81 set underline [$nb tab $tab -underline]
82 set mnemonic [string toupper [string index $label $underline]]
83 if {$mnemonic ne "" && $mnemonic eq $key} {
84 return $tab
87 return ""
90 # +++ Toplevel keyboard traversal.
93 # enableTraversal --
94 # Enable keyboard traversal for a notebook widget
95 # by adding bindings to the containing toplevel window.
97 # TLNotebooks($top) keeps track of the list of all traversal-enabled
98 # notebooks contained in the toplevel
100 proc ttk::notebook::enableTraversal {nb} {
101 variable TLNotebooks
103 set top [winfo toplevel $nb]
105 if {![info exists TLNotebooks($top)]} {
106 # Augment $top bindings:
108 bind $top <Control-Key-Next> {+ttk::notebook::TLCycleTab %W 1}
109 bind $top <Control-Key-Prior> {+ttk::notebook::TLCycleTab %W -1}
110 bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1}
111 bind $top <Shift-Control-Key-Tab> {+ttk::notebook::TLCycleTab %W -1}
112 catch {
113 bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
115 if {[tk windowingsystem] eq "aqua"} {
116 bind $top <Option-KeyPress> \
117 +[list ttk::notebook::MnemonicActivation $top %K]
118 } else {
119 bind $top <Alt-KeyPress> \
120 +[list ttk::notebook::MnemonicActivation $top %K]
122 bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
125 lappend TLNotebooks($top) $nb
128 # TLCleanup -- <Destroy> binding for traversal-enabled toplevels
130 proc ttk::notebook::TLCleanup {w} {
131 variable TLNotebooks
132 if {$w eq [winfo toplevel $w]} {
133 unset -nocomplain -please TLNotebooks($w)
137 # Cleanup -- <Destroy> binding for notebooks
139 proc ttk::notebook::Cleanup {nb} {
140 variable TLNotebooks
141 set top [winfo toplevel $nb]
142 if {[info exists TLNotebooks($top)]} {
143 set index [lsearch -exact $TLNotebooks($top) $nb]
144 set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
148 # EnclosingNotebook $w --
149 # Return the nearest traversal-enabled notebook widget
150 # that contains $w.
152 # BUGS: this only works properly for tabs that are direct children
153 # of the notebook widget. This routine should follow the
154 # geometry manager hierarchy, not window ancestry, but that
155 # information is not available in Tk.
157 proc ttk::notebook::EnclosingNotebook {w} {
158 variable TLNotebooks
160 set top [winfo toplevel $w]
161 if {![info exists TLNotebooks($top)]} { return }
163 while {$w ne $top && $w ne ""} {
164 if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
165 return $w
167 set w [winfo parent $w]
169 return ""
172 # TLCycleTab --
173 # toplevel binding procedure for Control-Tab / Shift-Control-Tab
174 # Select the next/previous tab in the nearest ancestor notebook.
176 proc ttk::notebook::TLCycleTab {w dir} {
177 set nb [EnclosingNotebook $w]
178 if {$nb ne ""} {
179 CycleTab $nb $dir
180 return -code break
184 # MnemonicActivation $nb $key --
185 # Alt-KeyPress binding procedure for mnemonic activation.
186 # Scan all notebooks in specified toplevel for a tab with the
187 # the specified mnemonic. If found, activate it and return TCL_BREAK.
189 proc ttk::notebook::MnemonicActivation {top key} {
190 variable TLNotebooks
191 foreach nb $TLNotebooks($top) {
192 if {[set tab [MnemonicTab $nb $key]] ne ""} {
193 ActivateTab $nb [$nb index $tab]
194 return -code break