JM 9 Oct 2012 - someone asked me to create a kind of org chart from a list of employees, which includes (among other employee's relevant information), the employee's manager name. There is of course some off the shelve solutions using google docs or visio, but I am always on the mood to give Tcl a try.
this script (not fully tested btw) uses LemonTree again, given the flexibility it offers. I removed the code I did not need so please refer to LemonTree if you want to review the beauty of this code from RS
the script parses a file (hardcoded name, sorry) called "orgchart.csv" which contents are like this:
General, Colonel A,General Colonel B,General Captain A,Colonel B Captain B,Colonel B Captain C,Colonel B Sergeant A,Captain A Sergeant B,Captain A Private A,Sergeant B Private B,Sergeant B
the objective is to create something similar to http://en.wikipedia.org/wiki/Organizational_chart , but with a dynamic twist.
as an exercise for the reader:
package require BWidget namespace eval LemonTree {variable uniqueID 0} proc LemonTree::add {w parent type name {text ""}} { variable uniqueID; variable icon set text $name if {$parent != "root"} { if {$text eq ""} {set text "$val3,$val2,[string range $val1 0 20]"} } set id n[incr uniqueID] set data [list type $type name $name] #tk_messageBox -message "$type,$name" set fill [expr {[string match (* $text]? "blue": "black"}] set drawcross [expr {[info proc ::LemonTree::kids($type)] eq "" ? "never" : "allways"}] $w insert end $parent $id -text $text -data $data -drawcross $drawcross -fill $fill if [info exists icon($type)] { $w itemconfigure $id -image $icon($type) } } proc LemonTree::open {w node} { if {[$w itemcget $node -drawcross] eq "allways"} { set data [$w itemcget $node -data] set type [dict'get $data type] foreach {ktype kids} [kids($type) $w $node] { foreach kid $kids {add $w $node $ktype $kid} } $w itemconfigure $node -drawcross auto } } proc LemonTree::kids(html) {w node} { set name [dict'get [$w itemcget $node -data] name] list html [getReporters $name] } set path $BWIDGET::LIBRARY/images foreach {type name} {dir folder file file array copy html folder} { set LemonTree::icon($type) [image create photo -file $path/$name.gif] } proc LemonTree::Info {w node} { set type [dict'get [$w itemcget $node -data] type] if {[info proc ::LemonTree::info($type)] ne ""} { balloon $w [info($type) $w $node] } } #-- type-specific info providers: proc LemonTree::info(html) {w node} { return "TBD" } #-- A simple ballon, modified from Bag of Tk algorithms: proc balloon {w text} { set top .balloon catch {destroy $top} toplevel $top -bd 1 pack [message $top.txt -aspect 10000 -bg lightyellow \ -borderwidth 0 -text $text -font {Helvetica 9}] wm overrideredirect $top 1 wm geometry $top +[winfo pointerx $w]+[winfo pointery $w] bind $top <1> [list destroy $top] raise $top } proc dict'get {dict key} { foreach {k value} $dict {if {$k eq $key} {return $value}} } # # # proc getReporters {who} { set fp [open orgchart.csv r] while {[gets $fp line] >= 0} { foreach {empl jefe} [split $line ,] { if {$jefe == $who} { lappend reporters $empl } } } close $fp if {[info exists reporters]} { if {[llength $reporters] > 1} { return $reporters } } } proc main {quien} { LemonTree::add .t root html $quien $quien return } # ------------------------------------------- label .lbl -text "From:" entry .txt -width 60 button .btnGet -text "Start" -command {main [.txt get]} button .btnSalir -text Exit -command { catch {t destroy} exit } grid .lbl .txt grid .btnGet -row 1 -column 1 grid .btnSalir -row 1 -column 2 #-- Now to demonstrate and test the whole thing: Tree .t -background white -opencmd {LemonTree::open .t} \ -width 60 -height 30 -yscrollcommand {.y set} .t bindText <1> {LemonTree::Info .t} .t bindImage <1> {LemonTree::Info .t} scrollbar .y -command {.t yview} grid .t -row 2 -column 0 -columnspan 3 grid .y -row 2 -column 3 -sticky ns .txt insert end "General" #-- Little development helpers: bind . <Escape> {exec wish $argv0 &; exit} bind . <F1> {console show}