HP/util/HP/lib/blt2.4/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     -yscrollcommand { .vs set } \
  70     -xscrollcommand { .hs set }
  71
  72 scrollbar .vs -orient vertical -command { .h yview }
  73 scrollbar .hs -orient horizontal -command { .h xview }
  74 table . \
  75     0,0 .h  -fill both \
  76     0,1 .vs -fill y \
  77     1,0 .hs -fill x
  78
  79 table configure . c1 r1 -resize none
  80
  81 proc DoFind { dir path } {
  82     global fileList
  83     set saved [pwd]
  84
  85     cd $dir
  86     lappend fileList $path
  87     foreach f [lsort [glob -nocomplain *]] {
  88         set entry [file join $path $f]
  89         lappend fileList $entry
  90         if { [file isdirectory $f] } {
  91             DoFind $f $entry
  92         }
  93     }
  94     cd $saved
  95 }
  96
  97 proc Find { dir } {
  98     global fileList
  99     set fileList {}
 100     DoFind $dir $dir
 101     return $fileList
 102 }
 103 set top ..
 104 set trim "$top"
 105
 106 .h configure -separator "/" -autocreate yes -activebackground white
 107
 108 proc GetAbsolutePath { dir } {
 109     set saved [pwd]
 110     cd $dir
 111     set path [pwd]
 112     cd $saved
 113     return $path
 114 }
 115 .h entry configure root -label [file tail [GetAbsolutePath $top]]
 116 .h configure -bg grey90
 117 update
 118 regsub -all {\.\./*} [Find $top] {} fileList
 119 eval .h insert end $fileList
 120 .h configure -bg white
 121
 122 .h find -glob -name *.gif -exec {
 123      %W entry configure %n -image [image create photo -file $top/%P]
 124 }
 125
 126 focus .h
 127
 128 set nodes [.h find -glob -name *.c]
 129 eval .h entry configure $nodes -labelcolor red
 130
 131 cd $saved