1#!/usr/local/bin/bltwish 2 3package 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# -------------------------------------------------------------------------- 23if { $tcl_version >= 8.0 } { 24 namespace import blt::* 25 namespace import -force blt::tile::* 26} 27source scripts/demo.tcl 28 29proc SortColumn { column } { 30 set old [.t sort cget -column] 31 set decreasing 0 32 if { "$old" == "$column" } { 33 set decreasing [.t sort cget -decreasing] 34 set decreasing [expr !$decreasing] 35 } 36 .t sort configure -decreasing $decreasing -column $column -mode integer 37 if { ![.t cget -flat] } { 38 .t configure -flat yes 39 } 40 .t sort auto yes 41 42 blt::busy hold .t 43 update 44 blt::busy release .t 45} 46 47proc FormatSize { size } { 48 set string "" 49 while { $size > 0 } { 50 set rem [expr $size % 1000] 51 set size [expr $size / 1000] 52 if { $size > 0 } { 53 set rem [format "%03d" $rem] 54 } 55 if { $string != "" } { 56 set string "$rem,$string" 57 } else { 58 set string "$rem" 59 } 60 } 61 return $string 62} 63 64array set modes { 65 0 --- 66 1 --x 67 2 -w- 68 3 -wx 69 4 r-- 70 5 r-x 71 6 rw- 72 7 rwx 73} 74 75proc FormatMode { mode } { 76 global modes 77 78 set mode [format %o [expr $mode & 07777]] 79 set owner $modes([string index $mode 0]) 80 set group $modes([string index $mode 1]) 81 set world $modes([string index $mode 2]) 82 83 return "${owner}${group}${world}" 84} 85 86proc Find { tree parent dir } { 87 global count 88 set saved [pwd] 89 90 cd $dir 91 foreach f [glob -nocomplain *] { 92 set name [file tail $f] 93 if { [catch { file stat $f info }] != 0 } { 94 set node [$tree insert $parent -label $name] 95 } else { 96 if { $info(type) == "file" } { 97 set info(type) [list @blt::tv::normalOpenFolder $name] 98 } else { 99 set info(type) "" 100 } 101 set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"] 102 set info(atime) [clock format $info(atime) -format "%b %d, %Y"] 103 set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"] 104 set info(size) [FormatSize $info(size)] 105 set info(mode) [FormatMode $info(mode)] 106 set node [$tree insert $parent -label $name -data [array get info]] 107 } 108 incr count 109 if { [file type $f] == "directory" } { 110 Find $tree $node $f 111 } 112 } 113 cd $saved 114} 115 116 117proc GetAbsolutePath { dir } { 118 set saved [pwd] 119 cd $dir 120 set path [pwd] 121 cd $saved 122 return $path 123} 124 125option add *TreeView.focusOutSelectForeground white 126option add *TreeView.focusOutSelectBackground grey80 127 128#option add *TreeView.Button.activeBackground pink 129option add *TreeView.Button.activeForeground red2 130option add *TreeView.Button.background grey95 131option add *TreeView.Column.background grey90 132option add *TreeView.CheckBoxStyle.activeBackground white 133if 0 { 134option add *TreeView.Column.titleFont { Helvetica 12 bold } 135option add *TreeView.text.font { Helvetica 12 } 136option add *TreeView.CheckBoxStyle.font { Courier 10 } 137option add *TreeView.ComboBoxStyle.font { Helvetica 20 } 138option add *TreeView.TextBoxStyle.font { Times 34 } 139} 140 141set top [GetAbsolutePath ..] 142#set top [GetAbsolutePath /home/gah] 143set trim "$top" 144 145set tree [tree create] 146treeview .t \ 147 -width 0 \ 148 -yscrollcommand { .vs set } \ 149 -xscrollcommand { .hs set } \ 150 -selectmode single \ 151 -tree $tree 152 153.t column configure #0 -title "" 154#file 155.t column insert 0 mtime atime gid 156.t column insert end nlink mode type ctime uid ino size dev 157.t column configure uid -background red -relief raised 158.t column configure mtime -hide no -bg green -relief raised 159.t column configure size gid nlink uid ino dev -justify left -edit yes 160.t column configure size type -justify left -edit yes 161.t column configure #0 -hide no -edit no -icon blt::tv::normalOpenFolder 162focus .t 163 164scrollbar .vs -orient vertical -command { .t yview } 165scrollbar .hs -orient horizontal -command { .t xview } 166 167table . \ 168 0,0 .t -fill both \ 169 0,1 .vs -fill y \ 170 1,0 .hs -fill x 171table configure . c1 r1 -resize none 172 173set count 0 174Find $tree root $top 175puts "$count entries" 176 177if {[catch { 178 tree op find $tree -top root -glob -name *.c -addtag "c_files" 179 tree op find $tree -top root -glob -name *.h -addtag "header_files" 180 tree op find $tree -top root -glob -name *.tcl -addtag "tcl_files" 181} xrc]} { 182 tclLog "Wize 'op' subcmd unavailable" 183 $tree find -top root -glob -name *.c -addtag "c_files" 184 $tree find -top root -glob -name *.h -addtag "header_files" 185 $tree find -top root -glob -name *.tcl -addtag "tcl_files" 186} 187 188.t entry configure "c_files" -foreground green4 189.t entry configure "header_files" -foreground cyan4 190.t entry configure "tcl_files" -foreground red4 191 192.t column bind all <ButtonRelease-3> { 193 %W configure -flat no 194} 195 196foreach column [.t column names] { 197 .t column configure $column -command [list SortColumn $column] 198} 199 200# Create a second treeview that shares the same tree. 201if 0 { 202toplevel .top 203treeview .top.t2 -tree $tree -yscrollcommand { .top.sbar set } 204scrollbar .top.sbar -command { .top.t2 yview } 205pack .top.t2 -side left -expand yes -fill both 206pack .top.sbar -side right -fill y 207} 208 209#.t configure -bg #ffffed 210.t style create checkbox check \ 211 -onvalue 30 -offvalue "50" \ 212 -showvalue yes 213 214.t style create combobox combo \ 215 -icon blt::tv::normalOpenFolder 216catch {.t style conf combo -choices {500 510 520}} 217 218.t column configure uid -style combo 219.t column configure gid -style check 220.t bind ComboBoxStyle <ButtonPress-1> { 221 puts "BBB: [%W column current], [%W nearest %x %y]" 222} 223catch {console show} 224 225