I386LINUX/util/I386LINUX/lib/blt2.4/demos/hiertable1.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.Column.background grey90
  42 option add *Hiertable.ScrollTile  yes
  43 option add *Hiertable.titleShadow { grey80 }
  44 option add *Hiertable.titleFont {*-helvetica-bold-r-*-*-11-*-*-*-*-*-*-*}
  45
  46 option add *xHiertable.openCommand      {
  47     set path /home/gah/src/blt/%P
  48     if { [file isdirectory $path] } {
  49         cd $path
  50         set files [glob -nocomplain * */. ]
  51         if { $files != "" } {
  52             eval %W insert -at %n end $files
  53         }
  54     }
  55 }
  56
  57 option add *xHiertable.closeCommand {
  58     eval %W delete %n 0 end
  59 }
  60
  61 hiertable .h  -hideroot no -width 0 \
  62     -yscrollcommand { .vs set } \
  63     -xscrollcommand { .hs set }  \
  64     -selectmode single -hideleaves false
  65
  66
  67 .h column configure treeView -text View
  68 .h column insert 0 mtime atime gid
  69 .h column insert end nlink mode type ctime uid ino size dev
  70 .h column configure uid -background \#eaeaff -relief raised -bd 1
  71 .h column configure mtime -hide no -bg \#ffeaea -relief raised -bd 1
  72 .h column configure size gid nlink uid ino dev -justify right -edit yes
  73 .h column configure treeView -hide no -edit no
  74 scrollbar .vs -orient vertical -command { .h yview }
  75 scrollbar .hs -orient horizontal -command { .h xview }
  76 table . \
  77     0,0 .h  -fill both \
  78     0,1 .vs -fill y \
  79     1,0 .hs -fill x
  80
  81 proc FormatSize { size } {
  82    set string ""
  83    while { $size > 0 } {
  84        set rem [expr $size % 1000]
  85        set size [expr $size / 1000]
  86        if { $size > 0 } {
  87            set rem [format "%03d" $rem]
  88        }
  89        if { $string != "" } {
  90            set string "$rem,$string"
  91        } else {
  92            set string "$rem"
  93        }
  94    }
  95    return $string
  96 }
  97
  98 array set modes {
  99    0    ---
 100    1    --x
 101    2    -w-
 102    3    -wx
 103    4    r--
 104    5    r-x
 105    6    rw-
 106    7    rwx
 107 }
 108
 109 proc FormatMode { mode } {
 110    global modes
 111
 112    set mode [format %o [expr $mode & 07777]]
 113    set owner $modes([string index $mode 0])
 114    set group $modes([string index $mode 1])
 115    set world $modes([string index $mode 2])
 116
 117    return "${owner}${group}${world}"
 118 }
 119
 120 table configure . c1 r1 -resize none
 121 image create photo fileImage -file images/stopsign.gif
 122 proc DoFind { dir path } {
 123     global fileList count
 124     set saved [pwd]
 125
 126     cd $dir
 127     foreach f [lsort [glob -nocomplain *]] {
 128         set entry [file join $path $f]
 129         if { [catch { file stat $entry info }] != 0 } {
 130             lappend fileList $entry
 131         } else {
 132             if 0 {
 133             if { $info(type) == "file" } {
 134                 set info(type) @fileImage
 135             } else {
 136                 set info(type) ""
 137             }
 138             }
 139             set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"]
 140             set info(atime) [clock format $info(atime) -format "%b %d, %Y"]
 141             set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"]
 142             set info(size)  [FormatSize $info(size)]
 143             set info(mode)  [FormatMode $info(mode)]
 144             lappend fileList $entry -data [array get info]
 145         }
 146         incr count
 147         if { [file type $f] == "directory" } {
 148             DoFind $f $entry
 149         }
 150     }
 151     cd $saved
 152 }
 153
 154 proc Find { dir } {
 155     global fileList count
 156     set fileList {}
 157     catch { file stat $dir info }
 158     incr count
 159     lappend fileList $dir -data [array get info]
 160     DoFind $dir $dir
 161     return $fileList
 162 }
 163
 164 proc GetAbsolutePath { dir } {
 165     set saved [pwd]
 166     cd $dir
 167     set path [pwd]
 168     cd $saved
 169     return $path
 170 }
 171
 172 set top [GetAbsolutePath ..]
 173 set trim "$top"
 174
 175 .h configure -separator "/" -trim $trim
 176
 177 set count 0
 178 .h entry configure root -label [file tail [GetAbsolutePath $top]]
 179 .h configure -bg grey90
 180 regsub -all {\.\./*} [Find $top] {} fileList
 181 puts "$count entries"
 182 eval .h insert end $fileList
 183 .h configure -bg white
 184
 185 focus .h
 186
 187 set nodes [.h find -glob -name *.c]
 188 eval .h entry configure $nodes -foreground green4
 189 set nodes [.h find -glob -name *.h]
 190 eval .h entry configure $nodes -foreground cyan4
 191 set nodes [.h find -glob -name *.o]
 192 eval .h entry configure $nodes -foreground red4
 193
 194 cd $saved
 195 #bltdebug 100
 196
 197 toplevel .top
 198 hiertable .top.h2 -tree .h -yscrollcommand { .top.sbar set }
 199 scrollbar .top.sbar -command { .top.h2 yview }
 200 pack .top.h2 -side left -expand yes -fill both
 201 pack .top.sbar -side right -fill y
 202
 203 .h column bind all <ButtonRelease-3> {
 204     %W configure -flat no
 205 }
 206
 207 proc SortColumn { column } {
 208     set old [.h sort cget -column]
 209     set decreasing 0
 210     if { "$old" == "$column" } {
 211         set decreasing [.h sort cget -decreasing]
 212         set decreasing [expr !$decreasing]
 213     }
 214     .h sort configure -decreasing $decreasing -column $column -mode integer
 215     .h configure -flat yes
 216     .h sort auto yes
 217
 218     blt::busy hold .h
 219     update
 220     blt::busy release .h
 221 }
 222
 223 foreach column [.h column names] {
 224     .h column configure $column -command [list SortColumn $column]
 225 }
 226
 227 scale .s -from 0 -to 300 -orient horizontal -length 300
 228 table . \
 229     3,0 .s
 230 update
 231 .s set 20
 232 if 1 {
 233     .s configure -command { .h entry configure 0 -height }
 234 }
 235