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 *Hierbox.Tile	bgTexture
41option add *Hierbox.ScrollTile  yes
42
43option add *xHierbox.openCommand	{
44    set path /home/gah/src/blt/%P
45    if { [file isdirectory $path] } {
46	cd $path
47	set files [glob -nocomplain * */. ]
48	if { $files != "" } {
49	    eval %W insert -at %n end $files
50	}
51    }
52}
53
54option add *xHierbox.closeCommand {
55    eval %W delete %n 0 end
56}
57
58image create photo openFolder -file images/open.gif
59image create photo closeFolder -file images/close.gif
60
61option add *Hierbox.icons "closeFolder openFolder"
62
63image create photo openFolder2 -file images/open2.gif
64image create photo closeFolder2 -file images/close2.gif
65
66option add *Hierbox.activeIcons "closeFolder2 openFolder2"
67
68hierbox .h  \
69    -activebackground blue \
70    -yscrollcommand { .vs set } \
71    -xscrollcommand { .hs set }
72
73scrollbar .vs -orient vertical -command { .h yview }
74scrollbar .hs -orient horizontal -command { .h xview }
75table . \
76    0,0 .h  -fill both \
77    0,1 .vs -fill y \
78    1,0 .hs -fill x
79
80table configure . c1 r1 -resize none
81
82proc DoFind { dir path } {
83    global fileList
84    set saved [pwd]
85
86    cd $dir
87    lappend fileList $path
88    foreach f [lsort [glob -nocomplain *]] {
89	set entry [file join $path $f]
90	lappend fileList $entry
91	if { [file isdirectory $f] } {
92	    DoFind $f $entry
93	}
94    }
95    cd $saved
96}
97
98proc Find { dir } {
99    global fileList
100    set fileList {}
101    DoFind $dir $dir
102    return $fileList
103}
104set top ..
105set trim "$top"
106
107.h configure -separator "/" -autocreate yes
108
109proc GetAbsolutePath { dir } {
110    set saved [pwd]
111    cd $dir
112    set path [pwd]
113    cd $saved
114    return $path
115}
116.h entry configure root -label [file tail [GetAbsolutePath $top]]
117.h configure -bg grey90
118update
119regsub -all {\.\./*} [Find $top] {} fileList
120eval .h insert end $fileList
121.h configure -bg white
122
123.h find -glob -name *.gif -exec {
124     %W entry configure %n -image [image create photo -file $top/%P]
125}
126
127focus .h
128
129set nodes [.h find -glob -name *.c]
130eval .h entry configure $nodes -labelcolor red
131
132cd $saved
133
134