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