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