/usr/share/blt2.4/demos/hierbox1.tcl is in blt-demo 2.4z-7ubuntu2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | #!/usr/bin/wish
package require BLT
# --------------------------------------------------------------------------
# Starting with Tcl 8.x, the BLT commands are stored in their own
# namespace called "blt". The idea is to prevent name clashes with
# Tcl commands and variables from other packages, such as a "table"
# command in two different packages.
#
# You can access the BLT commands in a couple of ways. You can prefix
# all the BLT commands with the namespace qualifier "blt::"
#
# blt::graph .g
# blt::table . .g -resize both
#
# or you can import all the command into the global namespace.
#
# namespace import blt::*
# graph .g
# table . .g -resize both
#
# --------------------------------------------------------------------------
if { $tcl_version >= 8.0 } {
namespace import blt::*
namespace import -force blt::tile::*
}
source scripts/demo.tcl
set saved [pwd]
#blt::bltdebug 100
image create photo bgTexture -file ./images/rain.gif
set imageList {}
foreach f [glob ./images/mini-*.gif] {
lappend imageList [image create photo -file $f]
}
#option add *Hierbox.Tile bgTexture
option add *Hierbox.ScrollTile yes
option add *xHierbox.openCommand {
set path /home/gah/src/blt/%P
if { [file isdirectory $path] } {
cd $path
set files [glob -nocomplain * */. ]
if { $files != "" } {
eval %W insert -at %n end $files
}
}
}
option add *xHierbox.closeCommand {
eval %W delete %n 0 end
}
image create photo openFolder -file images/open.gif
image create photo closeFolder -file images/close.gif
option add *Hierbox.icons "closeFolder openFolder"
image create photo openFolder2 -file images/open2.gif
image create photo closeFolder2 -file images/close2.gif
option add *Hierbox.activeIcons "closeFolder2 openFolder2"
hierbox .h \
-activebackground blue \
-yscrollcommand { .vs set } \
-xscrollcommand { .hs set }
scrollbar .vs -orient vertical -command { .h yview }
scrollbar .hs -orient horizontal -command { .h xview }
table . \
0,0 .h -fill both \
0,1 .vs -fill y \
1,0 .hs -fill x
table configure . c1 r1 -resize none
proc DoFind { dir path } {
global fileList
set saved [pwd]
cd $dir
lappend fileList $path
foreach f [lsort [glob -nocomplain *]] {
set entry [file join $path $f]
lappend fileList $entry
if { [file isdirectory $f] } {
DoFind $f $entry
}
}
cd $saved
}
proc Find { dir } {
global fileList
set fileList {}
DoFind $dir $dir
return $fileList
}
set top ..
set trim "$top"
.h configure -separator "/" -autocreate yes
proc GetAbsolutePath { dir } {
set saved [pwd]
cd $dir
set path [pwd]
cd $saved
return $path
}
.h entry configure root -label [file tail [GetAbsolutePath $top]]
.h configure -bg grey90
update
regsub -all {\.\./*} [Find $top] {} fileList
eval .h insert end $fileList
.h configure -bg white
.h find -glob -name *.gif -exec {
%W entry configure %n -image [image create photo -file $top/%P]
}
focus .h
set nodes [.h find -glob -name *.c]
eval .h entry configure $nodes -labelcolor red
cd $saved
|