I386LINUX/util/I386LINUX/lib/blt2.4/demos/hierbox2.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 proc AddDirEntries { w dir } {
  30     if { [file isdirectory $dir] } {
  31         set files [glob -nocomplain $dir/*]
  32         eval $w insert end [lsort $files]
  33         set subdirs [glob -nocomplain $dir/*/]
  34         eval $w entry configure [lsort $subdirs] -button yes
  35     }
  36 }
  37
  38 set imageList {}
  39 foreach f [glob ./images/mini-*.gif] {
  40     lappend imageList [image create photo -file $f]
  41 }
  42
  43 set top ../
  44
  45 #option add *Hierbox.Tile       bgTexture
  46 option add *Hierbox.TileOffset  yes
  47
  48 option add *forceGadgets        no
  49 option add *Hierbox.openCommand {
  50     AddDirEntries %W "$top/%P"
  51 }
  52 option add *Hierbox.closeCommand {
  53     eval %W delete %n 0 end
  54 }
  55
  56 image create photo openFolder -file images/open.gif
  57 image create photo closeFolder -file images/close.gif
  58
  59 option add *Hierbox.icons "closeFolder openFolder"
  60
  61 #option add *Hierbox.Button.activeForeground red
  62 #option add *Hierbox.bindTags "Label all"
  63
  64 hierbox .h  \
  65     -selectmode multiple \
  66     -hideroot yes \
  67     -yscrollcommand { .vs set } \
  68     -xscrollcommand { .hs set }
  69
  70 .h button configure -activebackground grey92
  71 scrollbar .vs -orient vertical -command { .h yview }
  72 scrollbar .hs -orient horizontal -command { .h xview }
  73 button .test -text Test -command {
  74     set index [.h curselection]
  75     set names [eval .h get -full $index]
  76     puts "selected names are $names"
  77 }
  78
  79 button .quit -text Quit -command { exit 0 }
  80
  81 table . \
  82     0,0 .h  -fill both \
  83     2,0 .quit \
  84     0,1 .vs -fill y 1,0 .hs -fill x \
  85     3,0 .test
  86
  87 table configure . c1 r1 r2 r3 -resize none
  88
  89 .h configure -separator "/" -trim $top \
  90     -allowduplicates no
  91
  92 #.h entry configure 0 -label [file tail $top]
  93
  94 AddDirEntries .h $top
  95 focus .h
  96 set nodes [.h find -glob -name *.c]
  97 eval .h entry configure $nodes -labelcolor red
  98
  99 wm protocol . WM_DELETE_WINDOW { destroy . }
 100 #blt::bltdebug 100