notebook.tcl 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201
  1. #
  2. # Bindings for TNotebook widget
  3. #
  4. namespace eval ttk::notebook {
  5. variable TLNotebooks ;# See enableTraversal
  6. }
  7. bind TNotebook <Button-1> { ttk::notebook::Press %W %x %y }
  8. bind TNotebook <Right> { ttk::notebook::CycleTab %W 1; break }
  9. bind TNotebook <Left> { ttk::notebook::CycleTab %W -1; break }
  10. bind TNotebook <Control-Tab> { ttk::notebook::CycleTab %W 1; break }
  11. bind TNotebook <Control-Shift-Tab> { ttk::notebook::CycleTab %W -1; break }
  12. catch {
  13. bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break }
  14. }
  15. bind TNotebook <Destroy> { ttk::notebook::Cleanup %W }
  16. # ActivateTab $nb $tab --
  17. # Select the specified tab and set focus.
  18. #
  19. # Desired behavior:
  20. # + take focus when reselecting the currently-selected tab;
  21. # + keep focus if the notebook already has it;
  22. # + otherwise set focus to the first traversable widget
  23. # in the newly-selected tab;
  24. # + do not leave the focus in a deselected tab.
  25. #
  26. proc ttk::notebook::ActivateTab {w tab} {
  27. set oldtab [$w select]
  28. $w select $tab
  29. set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled
  30. if {[focus] eq $w} { return }
  31. if {$newtab eq $oldtab} { focus $w ; return }
  32. update idletasks ;# needed so focus logic sees correct mapped states
  33. if {[set f [ttk::focusFirst $newtab]] ne ""} {
  34. ttk::traverseTo $f
  35. } else {
  36. focus $w
  37. }
  38. }
  39. # Press $nb $x $y --
  40. # Button-1 binding for notebook widgets.
  41. # Activate the tab under the mouse cursor, if any.
  42. #
  43. proc ttk::notebook::Press {w x y} {
  44. set index [$w index @$x,$y]
  45. if {$index ne ""} {
  46. ActivateTab $w $index
  47. }
  48. }
  49. # CycleTab --
  50. # Select the next/previous tab in the list.
  51. #
  52. proc ttk::notebook::CycleTab {w dir} {
  53. set current [$w index current]
  54. if {$current >= 0} {
  55. set tabCount [$w index end]
  56. set select [expr {($current + $dir) % $tabCount}]
  57. set step [expr {$dir > 0 ? 1 : -1}]
  58. while {[$w tab $select -state] ne "normal" && ($select != $current)} {
  59. set select [expr {($select + $step) % $tabCount}]
  60. }
  61. if {$select != $current} {
  62. ActivateTab $w $select
  63. }
  64. }
  65. }
  66. # MnemonicTab $nb $key --
  67. # Scan all tabs in the specified notebook for one with the
  68. # specified mnemonic. If found, returns path name of tab;
  69. # otherwise returns ""
  70. #
  71. proc ttk::notebook::MnemonicTab {nb key} {
  72. set key [string toupper $key]
  73. foreach tab [$nb tabs] {
  74. set label [$nb tab $tab -text]
  75. set underline [$nb tab $tab -underline]
  76. if {$underline >= 0} {
  77. set mnemonic [string toupper [string index $label $underline]]
  78. if {$mnemonic ne "" && $mnemonic eq $key} {
  79. return $tab
  80. }
  81. }
  82. }
  83. return ""
  84. }
  85. # +++ Toplevel keyboard traversal.
  86. #
  87. # enableTraversal --
  88. # Enable keyboard traversal for a notebook widget
  89. # by adding bindings to the containing toplevel window.
  90. #
  91. # TLNotebooks($top) keeps track of the list of all traversal-enabled
  92. # notebooks contained in the toplevel
  93. #
  94. proc ttk::notebook::enableTraversal {nb} {
  95. variable TLNotebooks
  96. set top [winfo toplevel $nb]
  97. if {![info exists TLNotebooks($top)]} {
  98. # Augment $top bindings:
  99. #
  100. bind $top <Control-Next> {+ttk::notebook::TLCycleTab %W 1}
  101. bind $top <Control-Prior> {+ttk::notebook::TLCycleTab %W -1}
  102. bind $top <Control-Tab> {+ttk::notebook::TLCycleTab %W 1}
  103. bind $top <Control-Shift-Tab> {+ttk::notebook::TLCycleTab %W -1}
  104. catch {
  105. bind $top <Control-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
  106. }
  107. if {[tk windowingsystem] eq "aqua"} {
  108. bind $top <Option-Key> \
  109. +[list ttk::notebook::MnemonicActivation $top %K]
  110. } else {
  111. bind $top <Alt-Key> \
  112. +[list ttk::notebook::MnemonicActivation $top %K]
  113. }
  114. bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
  115. }
  116. lappend TLNotebooks($top) $nb
  117. }
  118. # TLCleanup -- <Destroy> binding for traversal-enabled toplevels
  119. #
  120. proc ttk::notebook::TLCleanup {w} {
  121. variable TLNotebooks
  122. if {$w eq [winfo toplevel $w]} {
  123. unset -nocomplain -please TLNotebooks($w)
  124. }
  125. }
  126. # Cleanup -- <Destroy> binding for notebooks
  127. #
  128. proc ttk::notebook::Cleanup {nb} {
  129. variable TLNotebooks
  130. set top [winfo toplevel $nb]
  131. if {[info exists TLNotebooks($top)]} {
  132. set index [lsearch -exact $TLNotebooks($top) $nb]
  133. set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
  134. }
  135. }
  136. # EnclosingNotebook $w --
  137. # Return the nearest traversal-enabled notebook widget
  138. # that contains $w.
  139. #
  140. # BUGS: this only works properly for tabs that are direct children
  141. # of the notebook widget. This routine should follow the
  142. # geometry manager hierarchy, not window ancestry, but that
  143. # information is not available in Tk.
  144. #
  145. proc ttk::notebook::EnclosingNotebook {w} {
  146. variable TLNotebooks
  147. set top [winfo toplevel $w]
  148. if {![info exists TLNotebooks($top)]} { return }
  149. while {$w ne $top && $w ne ""} {
  150. if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
  151. return $w
  152. }
  153. set w [winfo parent $w]
  154. }
  155. return ""
  156. }
  157. # TLCycleTab --
  158. # toplevel binding procedure for Control-Tab / Control-Shift-Tab
  159. # Select the next/previous tab in the nearest ancestor notebook.
  160. #
  161. proc ttk::notebook::TLCycleTab {w dir} {
  162. set nb [EnclosingNotebook $w]
  163. if {$nb ne ""} {
  164. CycleTab $nb $dir
  165. return -code break
  166. }
  167. }
  168. # MnemonicActivation $nb $key --
  169. # Alt-Key binding procedure for mnemonic activation.
  170. # Scan all notebooks in specified toplevel for a tab with the
  171. # the specified mnemonic. If found, activate it and return TCL_BREAK.
  172. #
  173. proc ttk::notebook::MnemonicActivation {top key} {
  174. variable TLNotebooks
  175. foreach nb $TLNotebooks($top) {
  176. if {[set tab [MnemonicTab $nb $key]] ne ""} {
  177. ActivateTab $nb [$nb index $tab]
  178. return -code break
  179. }
  180. }
  181. }