diff options
Diffstat (limited to 'blt/demos/treeview1.tcl')
| -rwxr-xr-x | blt/demos/treeview1.tcl | 191 |
1 files changed, 191 insertions, 0 deletions
diff --git a/blt/demos/treeview1.tcl b/blt/demos/treeview1.tcl new file mode 100755 index 00000000000..ce5ff20e06d --- /dev/null +++ b/blt/demos/treeview1.tcl @@ -0,0 +1,191 @@ +#!../src/bltwish + +package require BLT +# -------------------------------------------------------------------------- +# Starting with Tcl 8.x, the BLT commands are stored in their own +# namespace called "blt". The idea is to prevent name clashes with +# Tcl commands and variables from other packages, such as a "table" +# command in two different packages. +# +# You can access the BLT commands in a couple of ways. You can prefix +# all the BLT commands with the namespace qualifier "blt::" +# +# blt::graph .g +# blt::table . .g -resize both +# +# or you can import all the command into the global namespace. +# +# namespace import blt::* +# graph .g +# table . .g -resize both +# +# -------------------------------------------------------------------------- +if { $tcl_version >= 8.0 } { + namespace import blt::* + namespace import -force blt::tile::* +} +source scripts/demo.tcl + +proc SortColumn { column } { + set old [.t sort cget -column] + set decreasing 0 + if { "$old" == "$column" } { + set decreasing [.t sort cget -decreasing] + set decreasing [expr !$decreasing] + } + .t sort configure -decreasing $decreasing -column $column -mode integer + .t configure -flat yes + .t sort auto yes + + blt::busy hold .t + update + blt::busy release .t +} + +proc FormatSize { size } { + set string "" + while { $size > 0 } { + set rem [expr $size % 1000] + set size [expr $size / 1000] + if { $size > 0 } { + set rem [format "%03d" $rem] + } + if { $string != "" } { + set string "$rem,$string" + } else { + set string "$rem" + } + } + return $string +} + +array set modes { + 0 --- + 1 --x + 2 -w- + 3 -wx + 4 r-- + 5 r-x + 6 rw- + 7 rwx +} + +proc FormatMode { mode } { + global modes + + set mode [format %o [expr $mode & 07777]] + set owner $modes([string index $mode 0]) + set group $modes([string index $mode 1]) + set world $modes([string index $mode 2]) + + return "${owner}${group}${world}" +} + +proc Find { tree parent dir } { + global count + set saved [pwd] + + cd $dir + foreach f [glob -nocomplain *] { + set name [file tail $f] + if { [catch { file stat $f info }] != 0 } { + set node [$tree insert $parent -label $name] + } else { + if { $info(type) == "file" } { + set info(type) @blt::tv::normalOpenFolder + } else { + set info(type) "" + } + set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"] + set info(atime) [clock format $info(atime) -format "%b %d, %Y"] + set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"] + set info(size) [FormatSize $info(size)] + set info(mode) [FormatMode $info(mode)] + set node [$tree insert $parent -label $name -data [array get info]] + } + incr count + if { [file type $f] == "directory" } { + Find $tree $node $f + } + } + cd $saved +} + + +proc GetAbsolutePath { dir } { + set saved [pwd] + cd $dir + set path [pwd] + cd $saved + return $path +} + +option add *TreeView.font { Courier 12 } +#option add *TreeView.Button.background grey95 +#option add *TreeView.Button.activeBackground grey90 +#option add *TreeView.Column.background grey90 +option add *TreeView.Column.titleShadow { grey70 1 } +#option add *TreeView.Column.titleFont { Helvetica 12 bold } +option add *TreeView.Column.font { Courier 12 } + +set top [GetAbsolutePath ..] +#set top [GetAbsolutePath /home/gah] +set trim "$top" + +set tree [tree create] +treeview .t \ + -width 0 \ + -yscrollcommand { .vs set } \ + -xscrollcommand { .hs set } \ + -yscrollincrement 1 \ + -selectmode single \ + -tree $tree + +.t column configure treeView -text file +.t column insert 0 mtime atime gid +.t column insert end nlink mode type ctime uid ino size dev +.t column configure uid -background \#eaeaff -font fixed -relief raised -bd 1 +.t column configure mtime -hide no -bg \#ffeaea -relief raised -bd 1 +.t column configure size gid nlink uid ino dev -justify right -edit yes +.t column configure treeView -hide no -edit no +.t text configure -selectborderwidth 0 +focus .t + +scrollbar .vs -orient vertical -command { .t yview } +scrollbar .hs -orient horizontal -command { .t xview } + +table . \ + 0,0 .t -fill both \ + 0,1 .vs -fill y \ + 1,0 .hs -fill x +table configure . c1 r1 -resize none + +set count 0 +Find $tree root $top +puts "$count entries" + +$tree find root -glob *.c -addtag "c_files" +$tree find root -glob *.h -addtag "header_files" +$tree find root -glob *.tcl -addtag "tcl_files" + +.t entry configure "c_files" -foreground green4 +.t entry configure "header_files" -foreground cyan4 +.t entry configure "tcl_files" -foreground red4 + +.t column bind all <ButtonRelease-3> { + %W configure -flat no +} + +foreach column [.t column names] { + .t column configure $column -command [list SortColumn $column] +} + +# Create a second treeview that shares the same tree. +if 0 { +toplevel .top +treeview .top.t2 -tree $tree -yscrollcommand { .top.sbar set } +scrollbar .top.sbar -command { .top.t2 yview } +pack .top.t2 -side left -expand yes -fill both +pack .top.sbar -side right -fill y +} + |