1 # BLT TreeView Utilities.
2 # Load and dump treeview to XTL form.
4 namespace eval ::blt::tv {
6 set pc(colors) {LightBlue Aquamarine Khaki LightCyan Cornsilk LightYellow Lavender Azure}
9 proc ::blt::tv::_TreeLoad {w tl {id 0}} {
13 if {[llength $i]==1} {
14 set lbl [expr {$j == {}?$i:$j}]
16 $w insert end $tag -at $id
18 $w insert end $tag -at $id -data [list $p(-datacol) $j]
21 set tind [lindex $i 1]
23 foreach {k l} [lrange $i 2 end] {
24 if {$p(-trim) != {}} { set k [string trimleft $k $p(-trim)] }
27 set cns [$w col names]
28 foreach k [array names data] {
29 if {[lsearch -exact $cns $k]<0} {
31 foreach m {-relief -bd} { $w col conf $k $m [$w col cget 0 $m] }
35 set data($p(-datacol)) $j
37 set nid [$w insert end $tag -at $id -data [array get data]]
41 $w entry conf $nid -forcetree 1 -opencommand [concat [list ::blt::tv::TreeLoad $w $j] [array get p] -id $nid -nice 0]
48 tclLog "Tag '$tind' is not '+' or '-' in: $i $j"
55 proc ::blt::tv::TreeLoad {w tl args} { #TYPES: . Win . {opts -trim -nice -defer -id -datacol}
56 # Load treeview from an XTL.
57 array set p {-trim {} -nice 0 -defer 1 -id 0 -datacol Value}
59 if {$p(-id) && [$w entry children $p(-id)] != {}} return
60 if {[lsearch -exact [$w col names] $p(-datacol)]<0} {
61 $w col insert end $p(-datacol)
63 $w conf -allowduplicates 1
66 set rc [catch {_TreeLoad $w $tl $p(-id)} rv]
70 $w style create textbox alt -bg LightBlue
71 $w conf -underline 1 -altstyle alt -bg White -selectbackground SteelBlue -nofocusselectbackground SteelBlue
72 eval $w col conf [$w col names] -bd 1 -relief raised
77 proc ::blt::tv::_TreeDump1 {w node} {
82 set tag [$w entry cget $i -label]
87 if {$p(-aval) != {}} {
88 catch { set avals [$w entry set $i $p(-aval)] }
90 set avals [$w entry cget $i -data]
92 foreach {j k} $avals {
100 if {$p(-vval) != {}} {
101 catch { set val [$w entry set $i $p(-vval)] }
103 if {[$w entry isleaf $i]} {
104 if {[array size data]} {
105 set tattr [concat [list $tag -] [array get data]]
106 } elseif {[string match #* $tag]} {
109 set tattr [list $tag]
111 lappend rc $tattr $val
113 set tattr [concat [list $tag +] [array get data]]
114 lappend rc $tattr [_TreeDump $w $i]
118 proc ::blt::tv::_TreeDump {w node} {
121 foreach i [$w entry children $node] {
127 proc ::blt::tv::FmtTree {lst {ind " "} {sp {}}} {
130 foreach {atag val} $lst {
132 if {[string index $rc end] != "\n"} { append rc \n }
133 if {[lindex $atag 1] == "+"} {
134 set src [FmtTree $val $ind "$sp$ind"]
135 append rc $sp [list $atag $src] \n
137 append rc $sp [list $atag $val] \n
140 return $rc[string range $sp 0 end-[string length $ind]]
143 proc ::blt::tv::TreeDump {w args} { #TYPES: . Win {opts -prefix -fmt -label -aval -vval -start -notop}
144 # Dump a treeview to XTL.
145 array set p {-prefix {} -fmt 1 -label 1 -aval {} -vval {} -start 0 -notop 0}
148 set rc [_TreeDump1 $w $p(-start)]
150 set rc [_TreeDump $w $p(-start)]
152 if {$p(-fmt)} { set rc [FmtTree $rc] }
156 proc ::blt::tv::WNew {cmd args} {
157 # Use style commands if possible.
158 if {[info exists ::Tk::Wins]} {
159 return [eval $cmd new $args]
161 return [eval $cmd $args]
165 proc ::blt::tv::XTLLoad {args} { #TYPES: win {opts -altcolor -colopts -conf -data -eval -refresh -titles -win}
180 if {$p(-eval) != {}} {
181 set data [eval $p(-eval)]
184 error "Must provide -data"
186 set titles $p(-titles)
188 set titles {Name Value}
190 set colors $pc(colors)
192 if {[set t $p(-win)] != {}} {
193 if {$p(-refresh) && ![winfo exists $p(-win)]} return
196 while {[winfo exists [set w .__tvdatatable$idx]]} {
202 grid $f -row 10 -column 10 -sticky news
203 grid columnconf $w 10 -weight 1
204 grid rowconf $w 10 -weight 1
206 WNew Scrollbar $f.sv -command "$t yview"
207 WNew Scrollbar $f.sh -command "$t xview" -orient horizontal
208 WNew TreeView $t -width 600 -autocreate 1 -yscrollcommand "$f.sv set" -xscrollcommand "$f.sh set" -bg white -underline 1
210 grid $f.sh -sticky we
211 grid conf $t -sticky news
212 grid conf $f.sv -sticky ns
213 grid columnconf $f 0 -weight 1
214 grid rowconf $f 0 -weight 1
217 #$t conf -font {Verdana 14 bold}; $t conf -titlefont [$t cget -font]
218 if {$p(-altcolor) != {}} {
219 if {[set color $p(-altcolor)] == "*"} {
220 set color [lindex $colors [expr {($idx-1)%[llength $colors]}]]
223 $t style create textbox alt -bg $color
224 $t conf -altstyle alt -selectbackground SteelBlue -nofocusselectbackground SteelBlue
229 eval $t col conf [$t col names] -bd 1 -relief raised -autowidth 250
230 $t col conf 0 -title Tag
231 $t col conf Value -justify left -titlejustify left
232 if {$p(-colopts) != {}} {
233 foreach i [$t col names] { eval [list $t column conf $i] $p(-colopts) }
235 if {$p(-conf) != {}} {
236 eval $t conf $p(-conf)
238 if {$p(-refresh) > 0} {
242 after $p(-refresh) [concat [namespace current]::TableLoad [array get p]]
247 proc ::blt::tv::TableLoad {args} { #TYPES: win {opts -altcolor -colopts -colprefix -conf -data -eval -refresh -subfield -split -titles -ititles -treefield -win}
267 if {$p(-eval) != {}} {
268 set data [eval $p(-eval)]
271 set data [split $data \n]
274 error "Must provide -data"
276 set titles $p(-titles)
278 set titles [lindex $data 0]
279 set data [lrange $data 1 end]
281 set colors $pc(colors)
283 if {[set t $p(-win)] != {}} {
284 if {$p(-refresh) && ![winfo exists $p(-win)]} return
287 while {[winfo exists [set w .__tvdatatable$idx]]} {
293 grid $f -row 10 -column 10 -sticky news
294 grid columnconf $w 10 -weight 1
295 grid rowconf $w 10 -weight 1
297 WNew Scrollbar $f.sv -command "$t yview"
298 WNew Scrollbar $f.sh -command "$t xview" -orient horizontal
299 WNew TreeView $t -width 600 -autocreate 1 -yscrollcommand "$f.sv set" -xscrollcommand "$f.sh set" -bg white -underline 1
301 grid $f.sh -sticky we
302 grid conf $t -sticky news
303 grid conf $f.sv -sticky ns
304 grid columnconf $f 0 -weight 1
305 grid rowconf $f 0 -weight 1
308 #$t conf -font {Verdana 14 bold}; $t conf -titlefont [$t cget -font]
309 if {$p(-altcolor) != {}} {
310 if {[set color $p(-altcolor)] == "*"} {
311 set color [lindex $colors [expr {($idx-1)%[llength $colors]}]]
314 $t style create textbox alt -bg $color
315 $t conf -altstyle alt -selectbackground SteelBlue -nofocusselectbackground SteelBlue
319 if {$p(-treefield) != {}} {
320 $t column conf 0 -relief raised -bd 1 -title $p(-treefield)
322 $t column conf 0 -hide 1
324 set data0 [$t column names]
326 while {[llength $data0] <= [llength $i]} {
327 set cn [lindex $titles [expr {[llength $data0]-1}]]
329 set cn $p(-colprefix)[llength $data0]
331 $t column insert end $cn -justify left -relief raised -bd 1 -pad 10 -editopts {-autonl 1} -command [list blt::tv::SortColumn %W %C]
332 set data0 [$t column names]
338 set ii [lindex $data0 [incr n]]
342 if {$p(-treefield) == {}} {
345 set path $q($p(-treefield))
347 $t insert end $path -data $d
349 if {$p(-subfield) != {}} {
350 foreach i [$t find] {
351 set id [$t entry set $i $p(-subfield)]
352 if {$id == {}} continue
353 set did [$t find -name $id]
354 if {$did == {}} continue
355 #puts "ID($i) id=$id, did=$did"
356 if {[string equal $did $i]} continue
361 bind . <Control-Alt-Insert> "console show"
362 if {$p(-colopts) != {}} {
363 foreach i [$t col names] { eval [list $t column conf $i] $p(-colopts) }
365 if {$p(-conf) != {}} {
366 eval $t conf $p(-conf)
368 if {$p(-refresh) > 0} {
372 after $p(-refresh) [concat [namespace current]::TableLoad [array get p]]
377 proc ::blt::tv::EditValid {wconf t newdata ind} {
378 # The following uses validate to prevent invalid edit from completing.
379 set nam [$t entry set $ind Name]
380 if {[catch {eval $wconf [list $nam $newdata]} rv]} {
386 proc ::blt::tv::TableWid {wconf} {
387 # Edit widget configure info in a table.
388 set w [lindex $wconf 0]
389 if {[llength $wconf] == 1} { lappend wconf configure }
390 set data [lsort -dictionary [eval $wconf]]
391 set t [blt::tv::TableLoad -data $data -titles {Name DBName DBClass Default Value Type}]
392 wm title [winfo toplevel $t] "Widget Info: [winfo class $w] [winfo name $w] '[lrange $wconf 1 end]' in [winfo parent $w]"
393 $t col move Value DBName
394 $t col move Default DBName
395 eval $t col conf [$t col names] -bg LightGray
396 $t col conf Value -edit 1 -titleforeground LimeGreen -titlejustify left -bg White
397 $t col conf Value -validatecmd [list [namespace current]::EditValid $wconf %W %V %#]
401 proc ::blt::tv::TreeFill {w str args} {
402 # Load treeview with data indented by 4 space multiples (converts tabs to 4).
403 # If -flat, load as a table and ignore indents.
404 set cols [$w column names]
405 set tstr [string trim $str]
407 set istable [$w cget -flat]
408 set sind [expr {$istable?0:1}]
409 if {[llength $cols] == 1} {
411 set s0 [string first \n $tstr]
416 set str0 [string range $tstr 0 [incr s0 -1]]
417 set s0 [string first \n $tstr]
418 set str [string range $tstr [incr s0] end]
421 set titles [lrange $cols $sind end]
423 $w column insert end $i
426 set col0 [lindex $cols 0]
427 $w column conf 0 -title $col0
430 set titles [lrange $cols $sind end]
431 if {[lindex $cols 0] != "#0"} { error "tree col must be first" }
435 set str [string map {\t { }} $str]
437 set lst [split $str \n]
441 foreach j $i k $titles {
447 $w insert end #auto -data $data
451 while {[string trim [lindex $lst 0]] == {} && [llength $lst]>1} {
452 set lst [lrange $lst 1 end]
454 set l0 [lindex $lst 0]
455 set l0a [string trimleft $l0]
456 set sp0 [expr {[string length $l0]-[string length $l0a]}]
461 set lbl [lindex $i 0]
462 set ii [lrange $i 1 end]
463 set la [string trimleft $i]
464 if {$la == {}} continue
465 set sp [expr {[string length $i]-[string length $la]}]
466 set lev [expr {($sp-$sp0)/4}]
467 set mod [expr {($sp-$sp0)%4}]
468 if {$mod && $msg == {}} {
469 set msg "treeview data indent ($mod) not divisible by 4 in: '$i'"
472 foreach j $ii k $titles {
474 set k [$w column insert end #auto]
481 if {$lev<=0 || $n==1} {
484 set at [$w index tail]
485 while {[$w entry depth $at]>$lev} {
486 set at [$w entry parent $at]
489 $w insert end [list $lbl] -at $at -data $data
498 if {$argv0 == [info script]} {
499 if {[llength $argv]} {
500 return [eval ::blt::tv::TableLoad $argv]
503 pack [treeview .tt ] -side left -fill both -expand y
518 ::blt::tv::TreeLoad .tt $tree -trim - -nice 1
519 tclLog [::blt::tv::TreeDump .tt]
520 pack [treeview .tf ] -side left -fill both -expand y
521 ::blt::tv::TreeFill .tf {
530 .tf open [.tf find -istree]
532 namespace eval ::blt::tv {
533 TableLoad -titles {Name Alpha Bravo Charlie Detroit Foxtrot} -data {
538 if {$::tcl_platform(platform) == "unix"} {
539 TableLoad -eval {exec df} -ititles 1 -split 1
540 TableLoad -ititles 1 -treefield PID -subfield PPID -split 1 -eval {exec ps -eo comm,uid_hack,rss,sz,time,pid,ppid,tty}
541 TableLoad -ititles 1 -data [split [exec ps -Alwj] \n]
542 TableLoad -ititles 1 -data [array get ::env] -llength 2
545 set data [split [string trim [exec ps auxw]] \n]
546 set ttl [lindex $data 0]
549 set pos [string last [lindex $ttl end] $ttl]
550 foreach i [lrange $data 1 end] {
551 set nl [string range $i 0 [expr {$pos-1}]]
552 lappend nl [string range $i $pos end]
557 TableLoad -ititles 1 -eval {LoadPs} -refresh 3000
558 #eval TableLoad [lrange $argv $n end]