1#!/usr/local/bin/bltwish 2 3package require BLT 4# -------------------------------------------------------------------------- 5# Starting with Tcl 8.x, the BLT commands are stored in their own 6# namespace called "blt". The idea is to prevent name clashes with 7# Tcl commands and variables from other packages, such as a "table" 8# command in two different packages. 9# 10# You can access the BLT commands in a couple of ways. You can prefix 11# all the BLT commands with the namespace qualifier "blt::" 12# 13# blt::graph .g 14# blt::table . .g -resize both 15# 16# or you can import all the command into the global namespace. 17# 18# namespace import blt::* 19# graph .g 20# table . .g -resize both 21# 22# -------------------------------------------------------------------------- 23if { $tcl_version >= 8.0 } { 24 namespace import blt::* 25 namespace import -force blt::tile::* 26} 27source scripts/demo.tcl 28 29set saved [pwd] 30 31#blt::bltdebug 100 32 33image create photo bgTexture -file ./images/rain.gif 34 35set imageList {} 36foreach f [glob ./images/mini-*.gif] { 37 lappend imageList [image create photo -file $f] 38} 39 40#option add *Hiertable.Tile bgTexture 41option add *Hiertable.ScrollTile yes 42#option add *Hiertable.Column.background grey90 43option add *Hiertable.titleShadow { grey80 } 44option add *Hiertable.titleFont {*-helvetica-bold-r-*-*-11-*-*-*-*-*-*-*} 45 46option add *xHiertable.openCommand { 47 set path /home/gah/src/blt/%P 48 if { [file isdirectory $path] } { 49 cd $path 50 set files [glob -nocomplain * */. ] 51 if { $files != "" } { 52 eval %W insert -at %n end $files 53 } 54 } 55} 56 57option add *xHiertable.closeCommand { 58 eval %W delete %n 0 end 59} 60 61hiertable .h -width 0\ 62 -yscrollcommand { .vs set } \ 63 -xscrollcommand { .hs set } \ 64 -selectmode multiple 65 66 67.h column configure treeView -text "View" 68.h column insert 0 mtime atime gid 69.h column insert end nlink mode type ctime uid ino size dev 70.h column configure uid -background \#eaeaff 71.h column configure mtime -hide no -bg \#ffeaea 72.h column configure size gid nlink uid ino dev -justify right 73.h column configure treeView -hide no -edit no 74 75scrollbar .vs -orient vertical -command { .h yview } 76scrollbar .hs -orient horizontal -command { .h xview } 77table . \ 78 0,0 .h -fill both \ 79 0,1 .vs -fill y \ 80 1,0 .hs -fill x 81 82proc FormatSize { size } { 83 set string "" 84 while { $size > 0 } { 85 set rem [expr $size % 1000] 86 set size [expr $size / 1000] 87 if { $size > 0 } { 88 set rem [format "%03d" $rem] 89 } 90 if { $string != "" } { 91 set string "$rem,$string" 92 } else { 93 set string "$rem" 94 } 95 } 96 return $string 97} 98 99array set modes { 100 0 --- 101 1 --x 102 2 -w- 103 3 -wx 104 4 r-- 105 5 r-x 106 6 rw- 107 7 rwx 108} 109 110proc FormatMode { mode } { 111 global modes 112 113 set mode [format %o [expr $mode & 07777]] 114 set owner $modes([string index $mode 0]) 115 set group $modes([string index $mode 1]) 116 set world $modes([string index $mode 2]) 117 118 return "${owner}${group}${world}" 119} 120 121table configure . c1 r1 -resize none 122image create photo fileImage -file images/stopsign.gif 123proc DoFind { dir path } { 124 global fileList count 125 set saved [pwd] 126 127 cd $dir 128 foreach f [lsort [glob -nocomplain *]] { 129 set entry [file join $path $f] 130 if { [catch { file stat $entry info }] != 0 } { 131 lappend fileList $entry 132 } else { 133 if 0 { 134 if { $info(type) == "file" } { 135 set info(type) @fileImage 136 } else { 137 set info(type) "" 138 } 139 } 140 set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"] 141 set info(atime) [clock format $info(atime) -format "%b %d, %Y"] 142 set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"] 143 set info(size) [FormatSize $info(size)] 144 set info(mode) [FormatMode $info(mode)] 145 lappend fileList $entry -data [array get info] 146 } 147 incr count 148 if { [file isdirectory $f] } { 149 DoFind $f $entry 150 } 151 } 152 cd $saved 153} 154 155proc Find { dir } { 156 global fileList count 157 set fileList {} 158 catch { file stat $dir info } 159 incr count 160 lappend fileList $dir -data [array get info] 161 DoFind $dir $dir 162 return $fileList 163} 164 165proc GetAbsolutePath { dir } { 166 set saved [pwd] 167 cd $dir 168 set path [pwd] 169 cd $saved 170 return $path 171} 172 173set top [GetAbsolutePath ..] 174set trim "$top" 175 176.h configure -separator "/" -trim $trim 177 178set count 0 179#.h entry configure root -label [file tail [GetAbsolutePath $top]] 180.h configure -bg grey90 181regsub -all {\.\./*} [Find $top] {} fileList 182puts "$count entries" 183eval .h insert end $fileList 184.h configure -bg white 185 186focus .h 187 188set nodes [.h find -glob -name *.c] 189eval .h entry configure $nodes -foreground green4 190set nodes [.h find -glob -name *.h] 191eval .h entry configure $nodes -foreground cyan4 192set nodes [.h find -glob -name *.o] 193eval .h entry configure $nodes -foreground red4 194 195cd $saved 196#bltdebug 100 197 198.h column bind all <ButtonRelease-3> { 199 %W configure -flat no 200} 201 202proc SortColumn { column } { 203 set old [.h sort cget -column] 204 set decreasing 0 205 if { "$old" == "$column" } { 206 set decreasing [.h sort cget -decreasing] 207 set decreasing [expr !$decreasing] 208 } 209 .h sort configure -decreasing $decreasing -column $column 210 .h configure -flat yes 211 .h sort auto yes 212 blt::busy hold .h 213 update 214 blt::busy release .h 215} 216 217foreach column [.h column names] { 218 .h column configure $column -command [list SortColumn $column] 219} 220