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