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