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