Posted to tcl by patthoyts at Tue Mar 17 23:11:30 GMT 2009view raw
- # treebook - Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
- #
- # widget for creating 'preference dialogs' - a tabbed dialog where
- # the page selection is done using a treeview on the left of the page
- # area.
- #
- package require Tk 8.6 ;# just for png support atm, otherwise 8.5
- namespace eval ttk::treebook {
- ttk::style theme settings default {
- ttk::style layout Treebook.TNotebook.Tab null
- ttk::style layout Treebook.Treeview {
- Treebook.Treeview.fill -sticky nswe -children {
- Treebook.Treeview.padding -sticky nswe
- }
- }
- ttk::style layout TNotebook {
- Notebook.padding -sticky news
- }
- ttk::style layout Treebook.Treeview.Item {
- Treebook.Treeitem.padding -sticky nswe -children {
- Treeitem.focus -side left -sticky {} -children {
- Treeitem.image -side left -sticky news
- Treeitem.text -side left -sticky {}
- }
- }
- }
- }
- foreach theme [ttk::style theme names] {
- ttk::style theme settings $theme {
- ttk::style configure Treebook.Treeview \
- -background [ttk::style configure . -background]
- }
- }
- }
- proc ttk::treebook {w args} {
- set w [ttk::treebook::Create $w]
- interp hide {} $w
- interp alias {} $w {} ::ttk::treebook::WidgetProc $w
- return $w
- }
- proc ttk::treebook::WidgetProc {self cmd args} {
- switch -- $cmd {
- cget {
- return [uplevel 1 [list [namespace origin Cget] $self] $args]
- }
- configure {
- return [uplevel 1 [list [namespace origin Configure] $self] $args]
- }
- add {
- return [uplevel 1 [list [namespace origin Add] $self] $args]
- }
- default {
- return [uplevel 1 [list [namespace origin Default] $self] $cmd $args]
- }
- }
- return
- }
- proc ttk::treebook::Default {self args} {
- if {[llength $args] == 0} {
- return $self
- }
- return [uplevel 1 [list $self.pw.notebook] $args]
- }
- proc ttk::treebook::Cget {self args} {
- if {[llength $args] != 2} {
- return -code error "wrong # args: should be \"$self cget item option\""
- }
- foreach {item option} $args break
- switch -exact -- $option {
- -parent {
- return [uplevel 1 [list $self.pw.tree parent $item]]
- }
- -image - -text {
- return [uplevel 1 [list $self.pw.tree item $item $option]]
- }
- default {
- return -code error "unknown option \"$option\""
- }
- }
- }
- proc ttk::treebook::Create {self} {
- set self [ttk::frame $self -class Treebook]
- set outer [ttk::panedwindow $self.pw -orient horizontal]
- set tree [ttk::treeview $outer.tree -show {tree} -style Treebook.Treeview]
- set notebook [ttk::notebook $outer.notebook -style Treebook.TNotebook]
- $outer add $tree -weight 0
- $outer add $notebook -weight 1
- $outer sashpos 0 [expr {[winfo width $outer] / 4}]
- bind $tree <<TreeviewSelect>> [list [namespace origin Select] $self]
- bind $notebook <<NotebookTabChanged>> [list [namespace origin OnSelect] $self]
- bind $self.pw <Map> [list [namespace origin OnMap] $self]
- grid $outer -sticky news
- grid rowconfigure $self 0 -weight 1
- grid columnconfigure $self 0 -weight 1
- return $self
- }
- # add -text tablabel -image imagename -parent treeparent
- proc ttk::treebook::Add {self window args} {
- set notebookargs {}
- set treeargs {}
- set label $window
- set parent {}
- foreach {key val} $args {
- switch -exact -- $key {
- -parent { set parent $val }
- -image { lappend treeargs -image $val}
- default {
- lappend notebookargs $key $val
- }
- }
- }
- set r [uplevel 1 [list $self.pw.notebook add $window] $notebookargs]
- set label [$self.pw.notebook tab $window -text]
- uplevel 1 [list $self.pw.tree insert $parent end \
- -id $window -open true -text $label] $treeargs
- return $r
- }
- proc ttk::treebook::OnMap {self} {
- $self.pw sashpos 0 [expr {[winfo width $self.pw] / 4}]
- bind $self.pw <Map> {}
- }
- proc ttk::treebook::OnSelect {self} {
- event generate $self <<TreebookChanged>>
- }
- proc ttk::treebook::Select {self} {
- $self.pw.notebook select [$self.pw.tree selection]
- }
- proc Test {} {
- global p
- bind . <Control-F2> {console show}
- catch {
- image create photo tkchat -file /opt/tkchat/tkchat.vfs/bin/tkchat48.png
- }
- set p [ttk::treebook .p]
- ttk::labelframe .page0 -text "Stuff"
- ttk::labelframe .page1 -text "More stuff"
- ttk::labelframe .page2 -text "Extra stuff"
- ttk::frame .page3
- ttk::combobox .page0.theme -values [lsort [ttk::style theme names]] -state readonly
- ttk::button .page0.apply -text Apply \
- -command {ttk::style theme use [.page0.theme get]}
- grid .page0.theme .page0.apply -sticky ew
- text .page3.text -yscrollcommand {.page3.vs set} -height 6 -width 36
- ttk::scrollbar .page3.vs -command {.page3.text yview}
- grid .page3.text .page3.vs -sticky news
- grid columnconfigure .page3 0 -weight 1
- grid rowconfigure .page3 0 -weight 1
- $p add .page0 -text One -image [lindex [image names] 0] -padding 2
- $p add .page1 -text Two
- $p add .page2 -text Three
- $p add .page3 -text Subpage -parent .page0 -padding 2
- pack $p -fill both -expand 1
- bind $p <<TreebookChanged>> {.page3.text insert end "switched page\n" {}}
- return $p
- }
- if {!$tcl_interactive} {
- if {![winfo exists .p]} {
- set r [catch [linsert $argv 0 Test] err]
- if {!$r} {tkwait window .}
- if {$r} {tk_messageBox -icon error -message $err}
- exit $r
- }
- }