Posted to tcl by patthoyts at Tue Mar 17 23:11:30 GMT 2009view raw

  1. # treebook - Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
  2. #
  3. # widget for creating 'preference dialogs' - a tabbed dialog where
  4. # the page selection is done using a treeview on the left of the page
  5. # area.
  6. #
  7.  
  8. package require Tk 8.6 ;# just for png support atm, otherwise 8.5
  9.  
  10. namespace eval ttk::treebook {
  11.  
  12. ttk::style theme settings default {
  13. ttk::style layout Treebook.TNotebook.Tab null
  14.  
  15. ttk::style layout Treebook.Treeview {
  16. Treebook.Treeview.fill -sticky nswe -children {
  17. Treebook.Treeview.padding -sticky nswe
  18. }
  19. }
  20. ttk::style layout TNotebook {
  21. Notebook.padding -sticky news
  22. }
  23. ttk::style layout Treebook.Treeview.Item {
  24. Treebook.Treeitem.padding -sticky nswe -children {
  25. Treeitem.focus -side left -sticky {} -children {
  26. Treeitem.image -side left -sticky news
  27. Treeitem.text -side left -sticky {}
  28. }
  29. }
  30. }
  31. }
  32. foreach theme [ttk::style theme names] {
  33. ttk::style theme settings $theme {
  34. ttk::style configure Treebook.Treeview \
  35. -background [ttk::style configure . -background]
  36. }
  37. }
  38. }
  39.  
  40. proc ttk::treebook {w args} {
  41. set w [ttk::treebook::Create $w]
  42. interp hide {} $w
  43. interp alias {} $w {} ::ttk::treebook::WidgetProc $w
  44. return $w
  45. }
  46.  
  47. proc ttk::treebook::WidgetProc {self cmd args} {
  48. switch -- $cmd {
  49. cget {
  50. return [uplevel 1 [list [namespace origin Cget] $self] $args]
  51. }
  52. configure {
  53. return [uplevel 1 [list [namespace origin Configure] $self] $args]
  54. }
  55. add {
  56. return [uplevel 1 [list [namespace origin Add] $self] $args]
  57. }
  58. default {
  59. return [uplevel 1 [list [namespace origin Default] $self] $cmd $args]
  60. }
  61. }
  62. return
  63. }
  64.  
  65. proc ttk::treebook::Default {self args} {
  66. if {[llength $args] == 0} {
  67. return $self
  68. }
  69. return [uplevel 1 [list $self.pw.notebook] $args]
  70. }
  71.  
  72. proc ttk::treebook::Cget {self args} {
  73. if {[llength $args] != 2} {
  74. return -code error "wrong # args: should be \"$self cget item option\""
  75. }
  76. foreach {item option} $args break
  77. switch -exact -- $option {
  78. -parent {
  79. return [uplevel 1 [list $self.pw.tree parent $item]]
  80. }
  81. -image - -text {
  82. return [uplevel 1 [list $self.pw.tree item $item $option]]
  83. }
  84. default {
  85. return -code error "unknown option \"$option\""
  86. }
  87. }
  88. }
  89.  
  90. proc ttk::treebook::Create {self} {
  91.  
  92. set self [ttk::frame $self -class Treebook]
  93. set outer [ttk::panedwindow $self.pw -orient horizontal]
  94. set tree [ttk::treeview $outer.tree -show {tree} -style Treebook.Treeview]
  95. set notebook [ttk::notebook $outer.notebook -style Treebook.TNotebook]
  96.  
  97. $outer add $tree -weight 0
  98. $outer add $notebook -weight 1
  99. $outer sashpos 0 [expr {[winfo width $outer] / 4}]
  100. bind $tree <<TreeviewSelect>> [list [namespace origin Select] $self]
  101. bind $notebook <<NotebookTabChanged>> [list [namespace origin OnSelect] $self]
  102. bind $self.pw <Map> [list [namespace origin OnMap] $self]
  103.  
  104. grid $outer -sticky news
  105. grid rowconfigure $self 0 -weight 1
  106. grid columnconfigure $self 0 -weight 1
  107.  
  108. return $self
  109. }
  110.  
  111. # add -text tablabel -image imagename -parent treeparent
  112. proc ttk::treebook::Add {self window args} {
  113. set notebookargs {}
  114. set treeargs {}
  115. set label $window
  116. set parent {}
  117. foreach {key val} $args {
  118. switch -exact -- $key {
  119. -parent { set parent $val }
  120. -image { lappend treeargs -image $val}
  121. default {
  122. lappend notebookargs $key $val
  123. }
  124. }
  125. }
  126. set r [uplevel 1 [list $self.pw.notebook add $window] $notebookargs]
  127. set label [$self.pw.notebook tab $window -text]
  128. uplevel 1 [list $self.pw.tree insert $parent end \
  129. -id $window -open true -text $label] $treeargs
  130. return $r
  131. }
  132.  
  133. proc ttk::treebook::OnMap {self} {
  134. $self.pw sashpos 0 [expr {[winfo width $self.pw] / 4}]
  135. bind $self.pw <Map> {}
  136. }
  137.  
  138. proc ttk::treebook::OnSelect {self} {
  139. event generate $self <<TreebookChanged>>
  140. }
  141.  
  142. proc ttk::treebook::Select {self} {
  143. $self.pw.notebook select [$self.pw.tree selection]
  144. }
  145.  
  146. proc Test {} {
  147. global p
  148. bind . <Control-F2> {console show}
  149. catch {
  150. image create photo tkchat -file /opt/tkchat/tkchat.vfs/bin/tkchat48.png
  151. }
  152. set p [ttk::treebook .p]
  153. ttk::labelframe .page0 -text "Stuff"
  154. ttk::labelframe .page1 -text "More stuff"
  155. ttk::labelframe .page2 -text "Extra stuff"
  156. ttk::frame .page3
  157.  
  158. ttk::combobox .page0.theme -values [lsort [ttk::style theme names]] -state readonly
  159. ttk::button .page0.apply -text Apply \
  160. -command {ttk::style theme use [.page0.theme get]}
  161. grid .page0.theme .page0.apply -sticky ew
  162.  
  163. text .page3.text -yscrollcommand {.page3.vs set} -height 6 -width 36
  164. ttk::scrollbar .page3.vs -command {.page3.text yview}
  165. grid .page3.text .page3.vs -sticky news
  166. grid columnconfigure .page3 0 -weight 1
  167. grid rowconfigure .page3 0 -weight 1
  168.  
  169. $p add .page0 -text One -image [lindex [image names] 0] -padding 2
  170. $p add .page1 -text Two
  171. $p add .page2 -text Three
  172. $p add .page3 -text Subpage -parent .page0 -padding 2
  173. pack $p -fill both -expand 1
  174.  
  175. bind $p <<TreebookChanged>> {.page3.text insert end "switched page\n" {}}
  176. return $p
  177. }
  178. if {!$tcl_interactive} {
  179. if {![winfo exists .p]} {
  180. set r [catch [linsert $argv 0 Test] err]
  181. if {!$r} {tkwait window .}
  182. if {$r} {tk_messageBox -icon error -message $err}
  183. exit $r
  184. }
  185. }