notebook.tcl 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199
  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. set mnemonic [string toupper [string index $label $underline]]
  77. if {$mnemonic ne "" && $mnemonic eq $key} {
  78. return $tab
  79. }
  80. }
  81. return ""
  82. }
  83. # +++ Toplevel keyboard traversal.
  84. #
  85. # enableTraversal --
  86. # Enable keyboard traversal for a notebook widget
  87. # by adding bindings to the containing toplevel window.
  88. #
  89. # TLNotebooks($top) keeps track of the list of all traversal-enabled
  90. # notebooks contained in the toplevel
  91. #
  92. proc ttk::notebook::enableTraversal {nb} {
  93. variable TLNotebooks
  94. set top [winfo toplevel $nb]
  95. if {![info exists TLNotebooks($top)]} {
  96. # Augment $top bindings:
  97. #
  98. bind $top <Control-Next> {+ttk::notebook::TLCycleTab %W 1}
  99. bind $top <Control-Prior> {+ttk::notebook::TLCycleTab %W -1}
  100. bind $top <Control-Tab> {+ttk::notebook::TLCycleTab %W 1}
  101. bind $top <Control-Shift-Tab> {+ttk::notebook::TLCycleTab %W -1}
  102. catch {
  103. bind $top <Control-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
  104. }
  105. if {[tk windowingsystem] eq "aqua"} {
  106. bind $top <Option-Key> \
  107. +[list ttk::notebook::MnemonicActivation $top %K]
  108. } else {
  109. bind $top <Alt-Key> \
  110. +[list ttk::notebook::MnemonicActivation $top %K]
  111. }
  112. bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
  113. }
  114. lappend TLNotebooks($top) $nb
  115. }
  116. # TLCleanup -- <Destroy> binding for traversal-enabled toplevels
  117. #
  118. proc ttk::notebook::TLCleanup {w} {
  119. variable TLNotebooks
  120. if {$w eq [winfo toplevel $w]} {
  121. unset -nocomplain -please TLNotebooks($w)
  122. }
  123. }
  124. # Cleanup -- <Destroy> binding for notebooks
  125. #
  126. proc ttk::notebook::Cleanup {nb} {
  127. variable TLNotebooks
  128. set top [winfo toplevel $nb]
  129. if {[info exists TLNotebooks($top)]} {
  130. set index [lsearch -exact $TLNotebooks($top) $nb]
  131. set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
  132. }
  133. }
  134. # EnclosingNotebook $w --
  135. # Return the nearest traversal-enabled notebook widget
  136. # that contains $w.
  137. #
  138. # BUGS: this only works properly for tabs that are direct children
  139. # of the notebook widget. This routine should follow the
  140. # geometry manager hierarchy, not window ancestry, but that
  141. # information is not available in Tk.
  142. #
  143. proc ttk::notebook::EnclosingNotebook {w} {
  144. variable TLNotebooks
  145. set top [winfo toplevel $w]
  146. if {![info exists TLNotebooks($top)]} { return }
  147. while {$w ne $top && $w ne ""} {
  148. if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
  149. return $w
  150. }
  151. set w [winfo parent $w]
  152. }
  153. return ""
  154. }
  155. # TLCycleTab --
  156. # toplevel binding procedure for Control-Tab / Control-Shift-Tab
  157. # Select the next/previous tab in the nearest ancestor notebook.
  158. #
  159. proc ttk::notebook::TLCycleTab {w dir} {
  160. set nb [EnclosingNotebook $w]
  161. if {$nb ne ""} {
  162. CycleTab $nb $dir
  163. return -code break
  164. }
  165. }
  166. # MnemonicActivation $nb $key --
  167. # Alt-Key binding procedure for mnemonic activation.
  168. # Scan all notebooks in specified toplevel for a tab with the
  169. # the specified mnemonic. If found, activate it and return TCL_BREAK.
  170. #
  171. proc ttk::notebook::MnemonicActivation {top key} {
  172. variable TLNotebooks
  173. foreach nb $TLNotebooks($top) {
  174. if {[set tab [MnemonicTab $nb $key]] ne ""} {
  175. ActivateTab $nb [$nb index $tab]
  176. return -code break
  177. }
  178. }
  179. }