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 41#option add *Hiertable.Column.background grey90 42option add *Hiertable.ScrollTile yes 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 -hideroot no -width 0 \ 62 -yscrollcommand { .vs set } \ 63 -xscrollcommand { .hs set } \ 64 -selectmode single -hideleaves false 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 -relief raised -bd 1 71.h column configure mtime -hide no -bg \#ffeaea -relief raised -bd 1 72.h column configure size gid nlink uid ino dev -justify right -edit yes 73.h column configure treeView -hide no -edit no 74scrollbar .vs -orient vertical -command { .h yview } 75scrollbar .hs -orient horizontal -command { .h xview } 76table . \ 77 0,0 .h -fill both \ 78 0,1 .vs -fill y \ 79 1,0 .hs -fill x 80 81proc FormatSize { size } { 82 set string "" 83 while { $size > 0 } { 84 set rem [expr $size % 1000] 85 set size [expr $size / 1000] 86 if { $size > 0 } { 87 set rem [format "%03d" $rem] 88 } 89 if { $string != "" } { 90 set string "$rem,$string" 91 } else { 92 set string "$rem" 93 } 94 } 95 return $string 96} 97 98array set modes { 99 0 --- 100 1 --x 101 2 -w- 102 3 -wx 103 4 r-- 104 5 r-x 105 6 rw- 106 7 rwx 107} 108 109proc FormatMode { mode } { 110 global modes 111 112 set mode [format %o [expr $mode & 07777]] 113 set owner $modes([string index $mode 0]) 114 set group $modes([string index $mode 1]) 115 set world $modes([string index $mode 2]) 116 117 return "${owner}${group}${world}" 118} 119 120table configure . c1 r1 -resize none 121image create photo fileImage -file images/stopsign.gif 122proc DoFind { dir path } { 123 global fileList count 124 set saved [pwd] 125 126 cd $dir 127 foreach f [lsort [glob -nocomplain *]] { 128 set entry [file join $path $f] 129 if { [catch { file stat $entry info }] != 0 } { 130 lappend fileList $entry 131 } else { 132 if 0 { 133 if { $info(type) == "file" } { 134 set info(type) @fileImage 135 } else { 136 set info(type) "" 137 } 138 } 139 set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"] 140 set info(atime) [clock format $info(atime) -format "%b %d, %Y"] 141 set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"] 142 set info(size) [FormatSize $info(size)] 143 set info(mode) [FormatMode $info(mode)] 144 lappend fileList $entry -data [array get info] 145 } 146 incr count 147 if { [file type $f] == "directory" } { 148 DoFind $f $entry 149 } 150 } 151 cd $saved 152} 153 154proc Find { dir } { 155 global fileList count 156 set fileList {} 157 catch { file stat $dir info } 158 incr count 159 lappend fileList $dir -data [array get info] 160 DoFind $dir $dir 161 return $fileList 162} 163 164proc GetAbsolutePath { dir } { 165 set saved [pwd] 166 cd $dir 167 set path [pwd] 168 cd $saved 169 return $path 170} 171 172set top [GetAbsolutePath ..] 173set trim "$top" 174 175.h configure -separator "/" -trim $trim 176 177set count 0 178.h entry configure root -label [file tail [GetAbsolutePath $top]] 179.h configure -bg grey90 180regsub -all {\.\./*} [Find $top] {} fileList 181puts "$count entries" 182eval .h insert end $fileList 183.h configure -bg white 184 185focus .h 186 187set nodes [.h find -glob -name *.c] 188eval .h entry configure $nodes -foreground green4 189set nodes [.h find -glob -name *.h] 190eval .h entry configure $nodes -foreground cyan4 191set nodes [.h find -glob -name *.o] 192eval .h entry configure $nodes -foreground red4 193 194cd $saved 195#bltdebug 100 196 197toplevel .top 198hiertable .top.h2 -tree .h -yscrollcommand { .top.sbar set } 199scrollbar .top.sbar -command { .top.h2 yview } 200pack .top.h2 -side left -expand yes -fill both 201pack .top.sbar -side right -fill y 202 203.h column bind all <ButtonRelease-3> { 204 %W configure -flat no 205} 206 207proc SortColumn { column } { 208 set old [.h sort cget -column] 209 set decreasing 0 210 if { "$old" == "$column" } { 211 set decreasing [.h sort cget -decreasing] 212 set decreasing [expr !$decreasing] 213 } 214 .h sort configure -decreasing $decreasing -column $column -mode integer 215 .h configure -flat yes 216 .h sort auto yes 217 218 blt::busy hold .h 219 update 220 blt::busy release .h 221} 222 223foreach column [.h column names] { 224 .h column configure $column -command [list SortColumn $column] 225} 226 227scale .s -from 0 -to 300 -orient horizontal -length 300 228table . \ 229 3,0 .s 230update 231.s set 20 232if 1 { 233 .s configure -command { .h entry configure 0 -height } 234} 235 236