notebook.tcl (5619B)
1 # 2 # Bindings for TNotebook widget 3 # 4 5 namespace eval ttk::notebook { 6 variable TLNotebooks ;# See enableTraversal 7 } 8 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 } 16 } 17 bind TNotebook <Destroy> { ttk::notebook::Cleanup %W } 18 19 # ActivateTab $nb $tab -- 20 # Select the specified tab and set focus. 21 # 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. 28 # 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 33 34 if {[focus] eq $w} { return } 35 if {$newtab eq $oldtab} { focus $w ; return } 36 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 42 } 43 } 44 45 # Press $nb $x $y -- 46 # ButtonPress-1 binding for notebook widgets. 47 # Activate the tab under the mouse cursor, if any. 48 # 49 proc ttk::notebook::Press {w x y} { 50 set index [$w index @$x,$y] 51 if {$index ne ""} { 52 ActivateTab $w $index 53 } 54 } 55 56 # CycleTab -- 57 # Select the next/previous tab in the list. 58 # 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]}] 65 } 66 if {$select != $current} { 67 ActivateTab $w $select 68 } 69 } 70 } 71 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 "" 76 # 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 85 } 86 } 87 return "" 88 } 89 90 # +++ Toplevel keyboard traversal. 91 # 92 93 # enableTraversal -- 94 # Enable keyboard traversal for a notebook widget 95 # by adding bindings to the containing toplevel window. 96 # 97 # TLNotebooks($top) keeps track of the list of all traversal-enabled 98 # notebooks contained in the toplevel 99 # 100 proc ttk::notebook::enableTraversal {nb} { 101 variable TLNotebooks 102 103 set top [winfo toplevel $nb] 104 105 if {![info exists TLNotebooks($top)]} { 106 # Augment $top bindings: 107 # 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 <Control-Shift-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} 112 catch { 113 bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} 114 } 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] 121 } 122 bind $top <Destroy> {+ttk::notebook::TLCleanup %W} 123 } 124 125 lappend TLNotebooks($top) $nb 126 } 127 128 # TLCleanup -- <Destroy> binding for traversal-enabled toplevels 129 # 130 proc ttk::notebook::TLCleanup {w} { 131 variable TLNotebooks 132 if {$w eq [winfo toplevel $w]} { 133 unset -nocomplain -please TLNotebooks($w) 134 } 135 } 136 137 # Cleanup -- <Destroy> binding for notebooks 138 # 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] 145 } 146 } 147 148 # EnclosingNotebook $w -- 149 # Return the nearest traversal-enabled notebook widget 150 # that contains $w. 151 # 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. 156 # 157 proc ttk::notebook::EnclosingNotebook {w} { 158 variable TLNotebooks 159 160 set top [winfo toplevel $w] 161 if {![info exists TLNotebooks($top)]} { return } 162 163 while {$w ne $top && $w ne ""} { 164 if {[lsearch -exact $TLNotebooks($top) $w] >= 0} { 165 return $w 166 } 167 set w [winfo parent $w] 168 } 169 return "" 170 } 171 172 # TLCycleTab -- 173 # toplevel binding procedure for Control-Tab / Control-Shift-Tab 174 # Select the next/previous tab in the nearest ancestor notebook. 175 # 176 proc ttk::notebook::TLCycleTab {w dir} { 177 set nb [EnclosingNotebook $w] 178 if {$nb ne ""} { 179 CycleTab $nb $dir 180 return -code break 181 } 182 } 183 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. 188 # 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 195 } 196 } 197 }