Posted to tcl by patthoyts at Mon Apr 28 14:31:12 GMT 2008view raw

  1. # Replace the standard notebook tab with one that includes a close
  2. # button.
  3. # In future versions of ttk this will be supported more directly when
  4. # the identify command will be able to identify parts of the tab.
  5.  
  6. namespace eval ::ButtonNotebook {
  7. }
  8.  
  9. # Tk 8.6 has the Visual Styles element engine on windows. If this is
  10. # available we use it to get proper windows close buttons.
  11. #
  12. proc ::ButtonNotebook::CreateElements {} {
  13. if {[lsearch -exact [ttk::style element names] close] == -1} {
  14. if {[catch {
  15. # WINDOW WP_SMALLCLOSEBUTTON (19)
  16. # WINDOW WP_MDICLOSEBUTTON (20)
  17. # WINDOW WP_MDIRESTOREBUTTON (22)
  18. #ttk::style element create close vsapi \
  19. # WINDOW 20 {disabled 4 {active pressed} 3 active 2 {} 1}
  20. ttk::style element create close vsapi \
  21. EXPLORERBAR 2 {disabled 4 {active pressed} 3 active 2 {} 1}
  22. ttk::style element create detach vsapi \
  23. WINDOW 22 {disabled 4 {active pressed} 3 active 2 {} 1}
  24. }]} then {
  25. CreateImageElements
  26. }
  27. }
  28. }
  29.  
  30. proc ::ButtonNotebook::CreateImageElements {} {
  31. # Create two image based elements to provide buttons to close the
  32. # tabs or to detach a tab and turn it into a toplevel.
  33. namespace eval ::img {}
  34. set imgdir [file join [file dirname [info script]] images]
  35. image create photo ::img::close -file [file join $imgdir xhn.gif]
  36. image create photo ::img::closepressed -file [file join $imgdir xhd.gif]
  37. image create photo ::img::closeactive -file [file join $imgdir xhu.gif]
  38. image create photo ::img::detach -file [file join $imgdir dhn.gif]
  39. image create photo ::img::detachup -file [file join $imgdir dhu.gif]
  40. image create photo ::img::detachdown -file [file join $imgdir dhd.gif]
  41. if {[lsearch -exact [ttk::style element names] close] == -1} {
  42. if {[catch {
  43. ttk::style element create close image \
  44. [list ::img::close \
  45. {active pressed !disabled} ::img::closepressed \
  46. {active !disabled} ::img::closeactive] \
  47. -border 3 -sticky {}
  48. ttk::style element create detach image \
  49. [list ::img::detach \
  50. {active pressed !disabled} ::img::detachdown \
  51. {active !disabled} ::img::detachup] \
  52. -border 3 -sticky {}
  53. } err]} { puts stderr $err }
  54. }
  55. }
  56.  
  57. proc ::ButtonNotebook::Init {{pertab 0}} {
  58. CreateElements
  59.  
  60. # This places the buttons on the right end of the tab area -- but in
  61. # Tk 8.5 we cannot identify these elements.
  62. if {!$pertab} {
  63. ttk::style layout ButtonNotebook {
  64. ButtonNotebook.client -sticky nswe
  65. ButtonNotebook.close -side right -sticky ne
  66. ButtonNotebook.detach -side right -sticky ne
  67. }
  68. }
  69.  
  70. # This places the button elements on each tab which uses quite a
  71. # lot of space but we can identify the elements. Changes to the
  72. # widget state affect all the button elements though.
  73. if {$pertab} {
  74. ttk::style layout ButtonNotebook {
  75. ButtonNotebook.client -sticky nswe
  76. }
  77. ttk::style layout ButtonNotebook.Tab {
  78. ButtonNotebook.tab -sticky nswe -children {
  79. ButtonNotebook.padding -side top -sticky nswe -children {
  80. ButtonNotebook.focus -side top -sticky nswe -children {
  81. ButtonNotebook.label -side left -sticky {}
  82. ButtonNotebook.close -side left -sticky {}
  83. }
  84. }
  85. }
  86. }
  87. }
  88.  
  89. if {$::ttk::currentTheme eq "xpnative"} {
  90. ttk::style configure ButtonNotebook.Tab -width -8
  91. }
  92. bind TNotebook <ButtonPress-1> {+::ButtonNotebook::Press %W %x %y}
  93. bind TNotebook <ButtonRelease-1> {+::ButtonNotebook::Release %W %x %y %X %Y}
  94. bind TNotebook <<ThemeChanged>> [namespace code [list Init $pertab]]
  95. }
  96.  
  97. # Hook in some event extras:
  98. # set the state to pressed if button down over a button element.
  99. proc ::ButtonNotebook::Press {w x y} {
  100. set e [$w identify $x $y]
  101. if {[string match "*close" $e] || [string match "*detach" $e]} {
  102. $w state pressed
  103. } else {
  104. upvar #0 [namespace current]::$w state
  105. set state(drag) 1
  106. set state(drag_index) [$w index @$x,$y]
  107. set state(drag_from_x) $x
  108. set state(draw_from_y) $y
  109. }
  110. }
  111.  
  112. # On release, do the button action if any.
  113. proc ::ButtonNotebook::Release {w x y rootX rootY} {
  114. $w state !pressed
  115. set e [$w identify $x $y]
  116. set index [$w index @$x,$y]
  117. if {[string match "*close" $e]} {
  118. $w forget $index
  119. event generate $w <<NotebookClosedTab>>
  120. } elseif {[string match "*detach" $e]} {
  121. Detach $w $index
  122. } else {
  123. upvar #0 [namespace current]::$w state
  124. if {[info exists state(drag)] && $state(drag)} {
  125. set dropwin [winfo containing $rootX $rootY]
  126. if {$dropwin eq {}} {
  127. Detach $w $state(drag_index)
  128. } elseif {$dropwin eq $w && $index != $state(drag_index)} {
  129. Move $w $state(drag_index) $index
  130. }
  131. unset state
  132. }
  133. }
  134. unset -nocomplain [namespace current]::$w
  135. }
  136.  
  137. # Move a tab from old index to new index position.
  138. proc ::ButtonNotebook::Move {notebook old_index new_index} {
  139. set tab [lindex [$notebook tabs] $old_index]
  140. set title [$notebook tab $old_index -text]
  141. $notebook forget $old_index
  142. if {[string is integer -strict $new_index]} {
  143. incr new_index -1
  144. if {$new_index < 0} {set new_index 0}
  145. if {$new_index > [llength [$notebook tabs]]} { set new_index end }
  146. } else {
  147. set new_index end
  148. }
  149. $notebook insert $new_index $tab -text $title
  150. }
  151.  
  152. # Turn a tab into a toplevel (must be a tk::frame)
  153. proc ::ButtonNotebook::Detach {notebook index} {
  154. set tab [lindex [$notebook tabs] $index]
  155. set title [$notebook tab $index -text]
  156. $notebook forget $index
  157. wm manage $tab
  158. wm title $tab $title
  159. wm protocol $tab WM_DELETE_WINDOW \
  160. [namespace code [list Attach $notebook $tab $index]]
  161. event generate $tab <<DetachedTab>>
  162. }
  163.  
  164. # Attach a toplevel to the notebook
  165. proc ::ButtonNotebook::Attach {notebook tab {index end}} {
  166. set title [wm title $tab]
  167. wm forget $tab
  168. if {[catch {
  169. if {[catch {$notebook insert $index $tab -text $title} err]} {
  170. $notebook add $tab -text $title
  171. }
  172. $notebook select $tab
  173. } err]} {
  174. puts stderr "AttachWindow: $err"
  175. wm manage $w
  176. wm title $w $title
  177. }
  178. }
  179. proc ::ButtonNotebook::Test {} {
  180. variable tabtest
  181. set dlg [toplevel .test[incr tabtest]]
  182. wm title $dlg "Notebook test"
  183. wm withdraw $dlg
  184. set nb [ttk::notebook $dlg.nb -style ButtonNotebook]
  185. frame $nb.page0 -background red -width 100 -height 100
  186. frame $nb.page1 -background blue -width 100 -height 100
  187. frame $nb.page2 -background green -width 100 -height 100
  188. $nb add $nb.page0 -text One
  189. $nb add $nb.page1 -text Two
  190. $nb add $nb.page2 -text Three
  191.  
  192. grid $dlg.nb -sticky news
  193. grid rowconfigure $dlg 0 -weight 1
  194. grid columnconfigure $dlg 0 -weight 1
  195.  
  196. bind TNotebook <Motion> {puts stderr [%W identify %x %y]}
  197. bind $dlg <Control-F2> {console show}
  198. console show
  199. wm geometry $dlg 320x240
  200. wm deiconify $dlg
  201. focus $dlg
  202. }
  203.  
  204. ::ButtonNotebook::Init 1
  205. ::ButtonNotebook::Test; tkwait window .