notebook.tcl 5.4 KB

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