Posted to tcl by patthoyts at Tue Dec 29 23:14:13 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 \
  23. EXPLORERBAR 2 {disabled 4 {active pressed} 3 active 2 {} 1}
  24. ttk::style element create detach vsapi \
  25. WINDOW 22 {disabled 4 {active pressed} 3 active 2 {} 1}
  26. }]} then {
  27. # No XP element engine - use images...
  28. CreateImageElements
  29. }
  30. }
  31. }
  32.  
  33. proc ::ButtonNotebook::CreateImageElements {} {
  34. # Create two image based elements to provide buttons to close the
  35. # tabs or to detach a tab and turn it into a toplevel.
  36. namespace eval ::img {}
  37. set imgdir [file join [file dirname [info script]] images]
  38. image create photo ::img::close -file [file join $imgdir xhn.gif]
  39. image create photo ::img::closepressed -file [file join $imgdir xhd.gif]
  40. image create photo ::img::closeactive -file [file join $imgdir xhu.gif]
  41. image create photo ::img::detach -file [file join $imgdir dhn.gif]
  42. image create photo ::img::detachup -file [file join $imgdir dhu.gif]
  43. image create photo ::img::detachdown -file [file join $imgdir dhd.gif]
  44. if {[lsearch -exact [ttk::style element names] close] == -1} {
  45. if {[catch {
  46. ttk::style element create close image \
  47. [list ::img::close \
  48. {active user3} ::img::close \
  49. {active pressed !disabled} ::img::closepressed \
  50. {active !disabled} ::img::closeactive] \
  51. -border 3 -sticky {}
  52. ttk::style element create detach image \
  53. [list ::img::detach \
  54. {active pressed !disabled} ::img::detachdown \
  55. {active !disabled} ::img::detachup] \
  56. -border 3 -sticky {}
  57. } err]} { puts stderr $err }
  58. }
  59. }
  60.  
  61. proc ::ButtonNotebook::Init {{pertab 0}} {
  62. CreateElements
  63.  
  64. # This places the buttons on the right end of the tab area -- but in
  65. # Tk 8.5 we cannot identify these elements.
  66. if {!$pertab} {
  67. ttk::style layout ButtonNotebook {
  68. ButtonNotebook.client -sticky nswe
  69. ButtonNotebook.close -side right -sticky ne
  70. ButtonNotebook.detach -side right -sticky ne
  71. }
  72. }
  73.  
  74. # This places the button elements on each tab which uses quite a
  75. # lot of space but we can identify the elements. Changes to the
  76. # widget state affect all the button elements though.
  77. if {$pertab} {
  78. ttk::style layout ButtonNotebook {
  79. ButtonNotebook.client -sticky nswe
  80. }
  81. ttk::style layout ButtonNotebook.Tab {
  82. ButtonNotebook.tab -sticky nswe -children {
  83. ButtonNotebook.focus -side top -sticky nswe -children {
  84. ButtonNotebook.padding -side right -sticky nswe -children {
  85. ButtonNotebook.close -side right -sticky {}
  86. }
  87. ButtonNotebook.label -side left -sticky {}
  88. }
  89. }
  90. }
  91. #if {$::tcl_platform(platform) eq "windows"} {} ??
  92. ttk::style configure ButtonNotebook.Tab -width -8
  93. ttk::style configure ButtonNotebook.Tab -padding {8 0 0 0}
  94. }
  95.  
  96. bind TNotebook <ButtonPress-1> {+::ButtonNotebook::Press %W %x %y}
  97. bind TNotebook <Motion> {+::ButtonNotebook::Drag %W %x %y %X %Y}
  98. bind TNotebook <ButtonRelease-1> {+::ButtonNotebook::Release %W %x %y %X %Y}
  99. bind TNotebook <<ThemeChanged>> [namespace code [list Init $pertab]]
  100. }
  101.  
  102. # Hook in some event extras:
  103. # set the state to pressed if button down over a button element.
  104. proc ::ButtonNotebook::Press {w x y} {
  105. set e [$w identify $x $y]
  106. if {[string match "*close" $e] || [string match "*detach" $e]} {
  107. set index [$w index @$x,$y]
  108. set tw [lindex [$w tabs] $index]
  109. if {[winfo class $tw] ne "Noclose"} {
  110. $w state pressed
  111. }
  112. } else {
  113. upvar #0 [namespace current]::$w state
  114. if {![info exists state]} {
  115. # FIX ME: dragging tabs isnt working so well at the moment
  116. #set state(drag) 1
  117. #set state(drag_index) [$w index @$x,$y]
  118. #set state(drag_under) $state(drag_index)
  119. #set state(drag_from_x) $x
  120. #set state(draw_from_y) $y
  121. #set state(drag_indic) [ttk::label $w._indic -text v]
  122. }
  123. }
  124. }
  125.  
  126. proc ::ButtonNotebook::Drag {w x y rootX rootY} {
  127. upvar #0 [namespace current]::$w state
  128.  
  129. # Use user3 to prevent activation of a non-closing close element
  130. set contained [lindex [$w tabs] [$w index @$x,$y]]
  131. if {[winfo class $contained] eq "Noclose"} {
  132. $w state user3
  133. } else { $w state !user3 }
  134.  
  135. if {[info exists state]} {
  136. if {[winfo containing $rootX $rootY] eq $w} {
  137. set index [$w index @$x,$y]
  138. if {$index != $state(drag_under)} {
  139. place $state(drag_indic) -anchor nw -x $x -y 0
  140. set state(drag_under) $index
  141. }
  142. }
  143. }
  144. }
  145.  
  146. # On release, do the button action if any.
  147. proc ::ButtonNotebook::Release {w x y rootX rootY} {
  148. $w state !pressed
  149. set e [$w identify $x $y]
  150. set index [$w index @$x,$y]
  151. if {[string match "*close" $e]} {
  152. set tw [lindex [$w tabs] $index]
  153. if {[winfo class $tw] ne "Noclose"} {
  154. $w forget $index
  155. event generate $w <<NotebookClosedTab>>
  156. }
  157. } elseif {[string match "*detach" $e]} {
  158. Detach $w $index
  159. } else {
  160. upvar #0 [namespace current]::$w state
  161. if {[info exists state]} {
  162. set dropwin [winfo containing $rootX $rootY]
  163. if {$dropwin eq {}} {
  164. Detach $w $state(drag_index)
  165. } elseif {$dropwin eq $w && $index != $state(drag_index)} {
  166. Move $w $state(drag_index) $index
  167. }
  168. destroy $state(drag_indic)
  169. unset state
  170. }
  171. }
  172. }
  173.  
  174. # Move a tab from old index to new index position.
  175. proc ::ButtonNotebook::Move {notebook old_index new_index} {
  176. set tab [lindex [$notebook tabs] $old_index]
  177. set title [$notebook tab $old_index -text]
  178. $notebook forget $old_index
  179. if {[string is integer -strict $new_index]} {
  180. incr new_index -1
  181. if {$new_index < 0} {set new_index 0}
  182. if {$new_index > [llength [$notebook tabs]]} { set new_index end }
  183. } else {
  184. set new_index end
  185. }
  186. $notebook insert $new_index $tab -text $title
  187. }
  188.  
  189. # Turn a tab into a toplevel (must be a tk::frame)
  190. proc ::ButtonNotebook::Detach {notebook index} {
  191. set tab [lindex [$notebook tabs] $index]
  192. set title [$notebook tab $index -text]
  193. $notebook forget $index
  194. wm manage $tab
  195. wm title $tab $title
  196. wm protocol $tab WM_DELETE_WINDOW \
  197. [namespace code [list Attach $notebook $tab $index]]
  198. bind $tab <Configure> \
  199. [namespace code [list Debug $notebook "Configure %wx%h %x,%y"]]
  200. bind $tab <Expose> [namespace code [list Debug $notebook "Expose"]]
  201. bind $tab <Activate> [namespace code [list Debug $notebook "Activate"]]
  202. bind $tab <Deactivate> [namespace code [list Debug $notebook "Deactivate"]]
  203. bind $tab <ButtonPress> [namespace code [list Debug $notebook "Button"]]
  204. bind $tab <Visibility> \
  205. [namespace code [list Debug $notebook "Visibility %s"]]
  206.  
  207. event generate $tab <<DetachedTab>>
  208. }
  209. proc ::ButtonNotebook::Debug {notebook msg} {
  210. if {[winfo exists $notebook.page0.text]} {
  211. $notebook.page0.text insert end $msg\n {}
  212. $notebook.page0.text see end
  213. }
  214. }
  215.  
  216. # Attach a toplevel to the notebook
  217. proc ::ButtonNotebook::Attach {notebook tab {index end}} {
  218. set title [wm title $tab]
  219. wm forget $tab
  220. if {[catch {
  221. if {[catch {$notebook insert $index $tab -text $title} err]} {
  222. $notebook add $tab -text $title
  223. }
  224. $notebook select $tab
  225. } err]} {
  226. puts stderr "AttachWindow: $err"
  227. wm manage $w
  228. wm title $w $title
  229. }
  230. }
  231. proc ::ButtonNotebook::Test {} {
  232. variable tabtest
  233. set dlg [toplevel .test[incr tabtest]]
  234. wm title $dlg "Notebook test"
  235. wm withdraw $dlg
  236. set nb [ttk::notebook $dlg.nb -style ButtonNotebook]
  237. frame $nb.page0 -background red -width 100 -height 100
  238. frame $nb.page1 -background blue -width 100 -height 100
  239. frame $nb.page2 -background green -width 100 -height 100 -class Noclose
  240. frame $nb.page3 -background tomato -width 100 -height 100
  241. $nb add $nb.page0 -text One
  242. $nb add $nb.page1 -text Two
  243. $nb add $nb.page2 -text Three
  244. $nb add $nb.page3 -text "Some really long label."
  245.  
  246. set txt [text $nb.page0.text -height 10 -width 10]
  247. set vs [scrollbar $nb.page0.vs -command [list $txt yview]]
  248. $txt configure -yscrollcommand [list $vs set]
  249. grid $txt $vs -sticky news
  250. grid rowconfigure $nb.page0 0 -weight 1
  251. grid columnconfigure $nb.page0 0 -weight 1
  252.  
  253. grid $dlg.nb -sticky news
  254. grid rowconfigure $dlg 0 -weight 1
  255. grid columnconfigure $dlg 0 -weight 1
  256.  
  257. bind TNotebook <Motion> [string map [list %txt $txt] {
  258. %txt insert end [%W identify %x %y] {} "\n" {}
  259. %txt see end
  260. }]
  261. bind $dlg <Control-F2> {console show}
  262. wm withdraw .
  263. wm protocol $dlg WM_DELETE_WINDOW {exit}
  264. wm geometry $dlg 320x240
  265. wm deiconify $dlg
  266. }
  267.  
  268. ::ButtonNotebook::Init 1
  269.  
  270. # The following line causes the Test procedure to be run if this file
  271. # is run standalone.
  272. puts [winfo class .]
  273. if {[string match "Tab*" [winfo class .]]} {
  274. ::ButtonNotebook::Test
  275. tkwait window .
  276. }