Posted to tcl by patthoyts at Mon Apr 28 10:41:54 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 detach vsapi \
  21. WINDOW 22 {disabled 4 {active pressed} 3 active 2 {} 1}
  22. }]} then {
  23. CreateImageElements
  24. }
  25. }
  26. }
  27.  
  28. proc ::ButtonNotebook::CreateImageElements {} {
  29. # Create two image based elements to provide buttons to close the
  30. # tabs or to detach a tab and turn it into a toplevel.
  31. namespace eval ::img {}
  32. set imgdir [file join [file dirname [info script]] images]
  33. image create photo ::img::close -file [file join $imgdir xhn.gif]
  34. image create photo ::img::closepressed -file [file join $imgdir xhd.gif]
  35. image create photo ::img::closeactive -file [file join $imgdir xhu.gif]
  36. image create photo ::img::detach -file [file join $imgdir dhn.gif]
  37. image create photo ::img::detachup -file [file join $imgdir dhu.gif]
  38. image create photo ::img::detachdown -file [file join $imgdir dhd.gif]
  39. if {[lsearch -exact [ttk::style element names] close] == -1} {
  40. if {[catch {
  41. ttk::style element create close image \
  42. [list ::img::close \
  43. {active pressed !disabled} ::img::closepressed \
  44. {active !disabled} ::img::closeactive] \
  45. -border 3 -sticky {}
  46. ttk::style element create detach image \
  47. [list ::img::detach \
  48. {active pressed !disabled} ::img::detachdown \
  49. {active !disabled} ::img::detachup] \
  50. -border 3 -sticky {}
  51. } err]} { puts stderr $err }
  52. }
  53. }
  54.  
  55. proc ::ButtonNotebook::Init {{pertab 0}} {
  56. CreateElements
  57.  
  58. # This places the buttons on the right end of the tab area -- but in
  59. # Tk 8.5 we cannot identify these elements.
  60. if {!$pertab} {
  61. ttk::style layout ButtonNotebook {
  62. ButtonNotebook.client -sticky nswe
  63. ButtonNotebook.close -side right -sticky ne
  64. ButtonNotebook.detach -side right -sticky ne
  65. }
  66. }
  67.  
  68. # This places the button elements on each tab which uses quite a
  69. # lot of space but we can identify the elements. Changes to the
  70. # widget state affect all the button elements though.
  71. if {$pertab} {
  72. ttk::style layout ButtonNotebook {
  73. ButtonNotebook.client -sticky nswe
  74. }
  75. ttk::style layout ButtonNotebook.Tab {
  76. ButtonNotebook.tab -sticky nswe -children {
  77. ButtonNotebook.padding -side top -sticky nswe -children {
  78. ButtonNotebook.focus -side top -sticky nswe -children {
  79. ButtonNotebook.label -side left -sticky {}
  80. ButtonNotebook.detach -side left -sticky {}
  81. ButtonNotebook.close -side left -sticky {}
  82. }
  83. }
  84. }
  85. }
  86. }
  87.  
  88. if {$::ttk::currentTheme eq "xpnative"} {
  89. ttk::style configure ButtonNotebook.Tab -width -8
  90. }
  91. bind TNotebook <ButtonPress-1> {+::ButtonNotebook::Press %W %x %y}
  92. bind TNotebook <ButtonRelease-1> {+::ButtonNotebook::Release %W %x %y}
  93. bind TNotebook <<ThemeChanged>> [namespace code [list Init $pertab]]
  94. }
  95.  
  96. # Hook in some event extras:
  97. # set the state to pressed if button down over a button element.
  98. proc ::ButtonNotebook::Press {w x y} {
  99. set e [$w identify $x $y]
  100. if {[string match "*close" $e] || [string match "*detach" $e]} {
  101. $w state pressed
  102. }
  103. }
  104.  
  105. # On release, do the button action if any.
  106. proc ::ButtonNotebook::Release {w x y} {
  107. $w state !pressed
  108. set e [$w identify $x $y]
  109. set index [$w index @$x,$y]
  110. if {[string match "*close" $e]} {
  111. $w forget $index
  112. event generate $w <<NotebookClosedTab>>
  113. } elseif {[string match "*detach" $e]} {
  114. set tab [lindex [$w tabs] $index]
  115. set title [$w tab $index -text]
  116. $w forget $index
  117. wm manage $tab
  118. wm title $tab $title
  119. wm protocol $tab WM_DELETE_WINDOW \
  120. [namespace code [list Attach $w $tab $index]]
  121. event generate $tab <<DetachedTab>>
  122. }
  123. }
  124.  
  125. proc ::ButtonNotebook::Attach {notebook tab {index end}} {
  126. set title [wm title $tab]
  127. wm forget $tab
  128. if {[catch {
  129. if {[catch {$notebook insert $index $tab -text $title} err]} {
  130. $notebook add $tab -text $title
  131. }
  132. $notebook select $tab
  133. } err]} {
  134. puts stderr "AttachWindow: $err"
  135. wm manage $w
  136. wm title $w $title
  137. }
  138. }
  139. proc ::ButtonNotebook::Test {} {
  140. variable tabtest
  141. set dlg [toplevel .test[incr tabtest]]
  142. wm title $dlg "Notebook test"
  143. wm withdraw $dlg
  144. set nb [ttk::notebook $dlg.nb -style ButtonNotebook]
  145. frame $nb.page0 -background red -width 100 -height 100
  146. frame $nb.page1 -background blue -width 100 -height 100
  147. $nb add $nb.page0 -text One
  148. $nb add $nb.page1 -text Two
  149.  
  150. grid $dlg.nb -sticky news
  151. grid rowconfigure $dlg 0 -weight 1
  152. grid columnconfigure $dlg 0 -weight 1
  153.  
  154. bind TNotebook <Motion> {puts stderr [%W identify %x %y]}
  155. bind $dlg <Control-F2> {console show}
  156. wm deiconify $dlg
  157. }
  158.  
  159. ::ButtonNotebook::Init 1
  160. #::ButtonNotebook::Test; tkwait window .