util/src/TclTk/blt2.5/demos/hiertable3.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 *Hiertable.Tile     bgTexture
  41 option add *Hiertable.ScrollTile  yes
  42 #option add *Hiertable.Column.background grey90
  43 option add *Hiertable.titleShadow { grey80 }
  44 option add *Hiertable.titleFont {*-helvetica-bold-r-*-*-11-*-*-*-*-*-*-*}
  45
  46 hiertable .h  -width 0\
  47     -yscrollcommand { .vs set } \
  48     -xscrollcommand { .hs set }  \
  49     -selectmode multiple \
  50     -hideroot yes
  51
  52 #.h configure -icons "" -activeicons ""
  53
  54 .h column configure treeView -text "View"
  55 .h column insert 0 mtime atime gid
  56 .h column insert end nlink mode type ctime uid ino size dev
  57 .h column configure uid -background \#eaeaff -style text
  58 .h column configure mtime -hide no -bg \#ffeaea -style text
  59 .h column configure size gid nlink uid ino dev -justify right -style text
  60 .h column configure treeView -hide no -edit no -style text
  61
  62 scrollbar .vs -orient vertical -command { .h yview }
  63 scrollbar .hs -orient horizontal -command { .h xview }
  64 table . \
  65     0,0 .h  -fill both \
  66     0,1 .vs -fill y \
  67     1,0 .hs -fill x
  68
  69 proc FormatSize { size } {
  70    set string ""
  71    while { $size > 0 } {
  72        set rem [expr $size % 1000]
  73        set size [expr $size / 1000]
  74        if { $size > 0 } {
  75            set rem [format "%03d" $rem]
  76        }
  77        if { $string != "" } {
  78            set string "$rem,$string"
  79        } else {
  80            set string "$rem"
  81        }
  82    }
  83    return $string
  84 }
  85
  86 array set modes {
  87    0    ---
  88    1    --x
  89    2    -w-
  90    3    -wx
  91    4    r--
  92    5    r-x
  93    6    rw-
  94    7    rwx
  95 }
  96
  97 proc FormatMode { mode } {
  98    global modes
  99
 100    set mode [format %o [expr $mode & 07777]]
 101    set owner $modes([string index $mode 0])
 102    set group $modes([string index $mode 1])
 103    set world $modes([string index $mode 2])
 104
 105    return "${owner}${group}${world}"
 106 }
 107
 108 table configure . c1 r1 -resize none
 109 image create photo fileImage -file images/stopsign.gif
 110
 111 proc DoFind { dir parent } {
 112     global count
 113     set saved [pwd]
 114
 115     cd $dir
 116     foreach f [lsort [glob -nocomplain *]] {
 117         set node [tree0 insert $parent -label $f]
 118         if { [catch { file stat $f info }] == 0 } {
 119             if 0 {
 120             if { $info(type) == "file" } {
 121                 set info(type) @fileImage
 122             } else {
 123                 set info(type) ""
 124             }
 125             }
 126             set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"]
 127             set info(atime) [clock format $info(atime) -format "%b %d, %Y"]
 128             set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"]
 129             set info(size)  [FormatSize $info(size)]
 130             set info(mode)  [FormatMode $info(mode)]
 131             eval tree0 set $node [array get info]
 132         }
 133         incr count
 134         if { [file isdirectory $f] } {
 135             DoFind $f $node
 136         }
 137     }
 138     cd $saved
 139 }
 140
 141 proc Find { dir } {
 142     global count
 143     set count 0
 144     catch { file stat $dir info }
 145     incr count
 146     tree create tree0
 147     tree0 label root [file tail $dir]
 148     eval tree0 set root [array get info]
 149     DoFind $dir root
 150     puts "$count entries"
 151 }
 152
 153 proc GetAbsolutePath { dir } {
 154     set saved [pwd]
 155     cd $dir
 156     set path [pwd]
 157     cd $saved
 158     return $path
 159 }
 160
 161 set top [GetAbsolutePath ..]
 162 Find $top
 163
 164 focus .h
 165
 166 .h configure -tree tree0 -separator /
 167
 168 set nodes [.h find -glob -name *.c]
 169 eval .h entry configure $nodes -foreground green4
 170 set nodes [.h find -glob -name *.h]
 171 eval .h entry configure $nodes -foreground cyan4
 172 set nodes [.h find -glob -name *.o]
 173 eval .h entry configure $nodes -foreground red4
 174
 175 cd $saved
 176
 177 .h column bind all <ButtonRelease-3> {
 178     %W configure -flat no
 179 }
 180
 181 proc SortColumn { column } {
 182     set old [.h sort cget -column]
 183     set decreasing 0
 184     if { "$old" == "$column" } {
 185         set decreasing [.h sort cget -decreasing]
 186         set decreasing [expr !$decreasing]
 187     }
 188     .h sort configure -decreasing $decreasing -column $column
 189     .h configure -flat yes
 190     .h sort auto yes
 191     blt::busy hold .h
 192     update
 193     blt::busy release .h
 194 }
 195
 196 foreach column [.h column names] {
 197     .h column configure $column -command [list SortColumn $column]
 198 }