# $Id$
#
# Sandbox test script for treeview testing
#
package require tile
option add *Toolbar*TCheckbutton.style Toolbutton
option add *tearOff 0
#
# Tree window:
#
set f [ttk::frame .f]
set tv $f.tv
ttk::scrollbar $f.vsb -orient vertical -command [list $tv yview]
ttk::treeview $tv \
-columns [list X Y Z] -displaycolumns [list Z Y] \
-yscrollcommand [list $f.vsb set] \
;
grid $f.tv $f.vsb -sticky news
grid columnconfigure $f 0 -weight 1
grid rowconfigure $f 0 -weight 1
#
# Status bar:
#
ttk::label .l -textvariable message
#
# View control:
#
set Show(headings) 1
set Show(tree) 1
proc setShow {tv} {
variable Show
set show [list]
foreach {key value} [array get Show] {
if {$value} { lappend show $key }
}
$tv configure -show $show
}
#
# Menubar:
#
set m [menu .menu]
$m add cascade -label View -underline 0 -menu [menu $m.view]
$m.view add checkbutton -label "Headings?" \
-variable Show(headings) -command [list setShow $f.tv]
$m.view add checkbutton -label "Tree?" \
-variable Show(tree) -command [list setShow $f.tv]
. configure -menu $m
#
# Toolbar:
#
ttk::frame .t -class Toolbar
raise .t
pack \
[ttk::checkbutton .t.sh -text "Headings?" \
-variable Show(headings) -command [list setShow $f.tv]] \
[ttk::checkbutton .t.st -text "Tree?" \
-variable Show(tree) -command [list setShow $f.tv]] \
-side left ;
#
# Configure tree:
#
$tv heading #0 -text "Tree"
$tv heading X -text "XXX"
$tv heading Y -text "YYY"
$tv heading Z -text "ZZZ"
pack .t -side top -expand false -fill x
pack .l -side bottom -expand false -fill x
pack .f -side top -expand true -fill both -padx 6 -pady 6
bind . <KeyPress-Escape> [list destroy .]
bind $tv <Motion> { set ::message [%W identify %x %y] }
bind $tv <KeyPress-Delete> { %W delete [%W selection] }
$tv insert {} end -id a -text "First node" -values [list a1 a2 a3]
$tv insert {} end -id b -text "Second node" -values [list b1 b2 b3]
$tv insert {} end -id c -text "Third node" -values [list c1 c2 c3]
$tv insert a end -id a1 -text "First subnode" -values [list d1 d2 d3]
$tv insert a end -id a2 -text "Second subnode" -values [list e1 e2 e3]
$tv insert a1 end -text "Subsubnode!!" -values [list X! Y! Z!]
foreach label {a b c d e f g h i j k l m n o} {
$tv insert b end -text $label
}
# Directory browser:
# SOURCE: tkfbox.tcl
set Icons(folder) [image create photo -data {
R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
set Icons(file) [image create photo -data {
R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
proc loaddir {tv node dir} {
variable Icons
foreach subdir [glob -nocomplain -type d -directory $dir *] {
set dirnode [$tv insert $node end \
-text [file tail $subdir] -image $Icons(folder)]
loaddir $tv $dirnode $subdir
}
foreach file [glob -nocomplain -type f -directory $dir *] {
$tv insert $node end -text [file tail $file] -image $Icons(file)
}
}
proc scandir {dir} {
foreach subdir [glob -nocomplain -type d -directory $dir *] {
scandir $subdir
}
glob -nocomplain -type f -directory $dir *
}
proc dirbrowse {dir} {
set tv $::tv
loaddir $tv [$tv insert {} end -text $dir] $dir
}
proc setWidths {tv {weights {}} {width {}}} {
if {$width eq {}} { set width [winfo width $tv] }
array set W $weights
set columns [$tv cget -displaycolumns]
if {![llength $columns]} {
set columns [$tv cget -columns]
}
set columns [linsert $columns 0 "#0"]
set totalWeight 0.0
set weights [list]
foreach column $columns {
if {[info exists W($column)]} {
set weight $W($column)
} else {
set weight 1
}
lappend weights $weight
set totalWeight [expr {$totalWeight+$weight}]
}
foreach column $columns weight $weights {
set colwidth [expr {int(($width * $weight)/$totalWeight)}]
$tv column $column -width $colwidth
}
}