util/X86LINUX64/lib/blt2.5/demos/hierbox1.tcl

   1 #!../src/bltwish
   2
   3 package 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 # --------------------------------------------------------------------------
  23 if { $tcl_version >= 8.0 } {
  24     namespace import blt::*
  25     namespace import -force blt::tile::*
  26 }
  27 source scripts/demo.tcl
  28
  29 set saved [pwd]
  30
  31 #blt::bltdebug 100
  32
  33 image create photo bgTexture -file ./images/rain.gif
  34
  35 set imageList {}
  36 foreach f [glob ./images/mini-*.gif] {
  37     lappend imageList [image create photo -file $f]
  38 }
  39
  40 #option add *Hierbox.Tile       bgTexture
  41 option add *Hierbox.ScrollTile  yes
  42
  43 option 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
  54 option add *xHierbox.closeCommand {
  55     eval %W delete %n 0 end
  56 }
  57
  58 image create photo openFolder -file images/open.gif
  59 image create photo closeFolder -file images/close.gif
  60
  61 option add *Hierbox.icons "closeFolder openFolder"
  62
  63 image create photo openFolder2 -file images/open2.gif
  64 image create photo closeFolder2 -file images/close2.gif
  65
  66 option add *Hierbox.activeIcons "closeFolder2 openFolder2"
  67
  68 hierbox .h  \
  69     -activebackground blue \
  70     -yscrollcommand { .vs set } \
  71     -xscrollcommand { .hs set }
  72
  73 scrollbar .vs -orient vertical -command { .h yview }
  74 scrollbar .hs -orient horizontal -command { .h xview }
  75 table . \
  76     0,0 .h  -fill both \
  77     0,1 .vs -fill y \
  78     1,0 .hs -fill x
  79
  80 table configure . c1 r1 -resize none
  81
  82 proc 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
  98 proc Find { dir } {
  99     global fileList
 100     set fileList {}
 101     DoFind $dir $dir
 102     return $fileList
 103 }
 104 set top ..
 105 set trim "$top"
 106
 107 .h configure -separator "/" -autocreate yes
 108
 109 proc 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
 118 update
 119 regsub -all {\.\./*} [Find $top] {} fileList
 120 eval .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
 127 focus .h
 128
 129 set nodes [.h find -glob -name *.c]
 130 eval .h entry configure $nodes -labelcolor red
 131
 132 cd $saved
 133