'''[AMW]''' Inspired by [eDictor], today I created the '''dictree''' [megawidget] using a [ttk::treeview] to display and edit the content of a [dict].
'''Example Usage:'''
======
# create a sample dict with some data:
dict set d author firstname "Alexander"
dict set d author surname "Mlynski-Wiese"
dict set d date "2012-12-21"
dict set d prog name "dictree"
dict set d prog version 1.1
# --> author {firstname Alexander surname Mlynski-Wiese} date 2012-12-21 prog {name dictree version 1.1}
# create the widget and populate it with the dict data:
dictree .t $d
# display the widget:
pack .t -expand yes -fill both
======
The widget will dive as deeply as possible into the data by interpreting it as nested dictionary whereever possible.
[dictree_screenshot]
If you do not want this kind interpretation for any node, just press '''Alt''' and '''click''' on the node with the mouse, and it will collapse into
a leaf.<
>Click again to expand it to a node with children again.
Alternatively, press '''Alt+Enter''' to collapse/expand the selected node in this sense.
The following keys allow modification of the data:
* '''Alt+Up/Down''' moves the selected node up or down within it's current hierarchy level
* '''Alt+Left/Right''' raises or lowers the selected node to the next hierarchy level
* '''F2''' will allow modification of the selected node's name
* '''Shift+F2''' will allow to edit the selected node's value (only if it is a leaf)
* '''Delete''' will delete the selected node(s)
* '''Insert''' will insert a new node as a sibbling before the selected node
* '''Alt+Insert''' will insert a new node as a sibbling after the selected node
After editing, you can 'reap' the tree to return the content as a dict:
======
set edited_d [.t reap]
======
-----
***Possible Enhancements***
* on right-button click, show a context menue to add/delete/edit/move the node
* drag and drop of node
-----
***Code***
The code below can be used
* as a '''package''' within other projects, or
* as a '''standalone''' application
** to display a dict loaded from a file
** to fill a demo dictionary with directory information and display it using '''dictree'''
<> dictree.tcl
======
#===============================================================================
# dictree widget display and edit dictionary data in ttk::treeview
#
# 21.12.2012, Alexander Mlynski-Wiese
#===============================================================================
package require Tcl 8.5
package require Tk
package require Ttk
package provide dictree 1.0
#-------------------------------------------------------------------------------
# dictree w d
# create a treeview widget with the pathname $w
# and fill it with the dictionary data $d
#-------------------------------------------------------------------------------
proc dictree { w d args } {
frame $w
ttk::treeview $w.t -columns {key value} -displaycolumns value \
-yscroll "${w}.sby set" -xscroll "${w}.sbx set"
if {[tk windowingsystem] ne "aqua"} {
ttk::scrollbar ${w}.sby -orient vertical -command "$w.t yview"
ttk::scrollbar ${w}.sbx -orient horizontal -command "$w.t xview"
} else {
scrollbar ${w}.sby -orient vertical -command "$w.t yview"
scrollbar ${w}.sbx -orient horizontal -command "$w.t xview"
}
$w.t heading \#0 -text "Directory Key(s)"
$w.t heading value -text "Value"
entry $w.e ;# widget used for editing
grid $w.t -row 0 -column 0 -sticky news
grid $w.sby -row 0 -column 1 -sticky ns ;# arrange the scrollbars
grid $w.sbx -row 1 -column 0 -sticky ew
grid rowconfigure $w 0 -weight 1
grid columnconfigure $w 0 -weight 1
dictree::bindings $w.t ;# create the bindings
dict for {key val} $d { ;# populate the treeview
dictree::addNode $w.t "" $key $val
}
#-----------------------------------------------------------------------
# "overload" the widget proc to support additional commands
#-----------------------------------------------------------------------
rename $w _$w
proc $w {cmd args} {
set self [lindex [info level 0] 0] ;# get name I was called with
switch -- $cmd {
reap {uplevel 1 dictree::reap $self.t $args }
default {
if { [catch {
uplevel 1 _$self $cmd $args
} ] } {
uplevel 1 $self.t $cmd $args
}
}
}
}
return $w
}
namespace eval dictree { ;# "private" functions
#-------------------------------------------------------------------------------
# bindings create the bindings for the treeview
#-------------------------------------------------------------------------------
proc bindings { w { debug 0 } } {
bind $w { dictree::setopen %W [%W selection] 1 }
bind $w { dictree::setopen %W [%W selection] 0 }
bind $w { dictree::expand %W [%W selection] }
bind $w { dictree::collapse %W [%W selection] }
bind $w { dictree::toggle %W [%W identify item %x %y] }
bind $w { dictree::toggle %W [%W selection]; break }
bind $w { dictree::edit %W [%W selection] "#0" }
bind $w { dictree::edit %W [%W selection] "value" }
bind $w { dictree::move %W [%W selection] -1; break }
bind $w { dictree::move %W [%W selection] 1; break }
bind $w { dictree::rise %W [%W selection] 1; break }
bind $w { dictree::rise %W [%W selection] -1; break }
bind $w { dictree::delete %W [%W selection] }
bind $w { dictree::insert %W [%W selection] }
bind $w { dictree::insert %W [%W selection] 1 }
if { $debug } {
# to aid developing additional bindings:
bind $w {
set item [%W identify item %x %y]
puts "%x,%y: %W item $item: [%W item $item]"
}
bind $w { puts %K }
}
return $w
}
#-------------------------------------------------------------------------------
# addNode recursive proc to create and fill the nodes
#-------------------------------------------------------------------------------
proc addNode { w parent title d } {
set node [$w insert $parent end -text $title]
set isdict 0
catch {
if { [dict get $d] == $d } {
set isdict 1
}
}
if { $isdict} {
# interpret data $d as a dictionary and create a subnode
dict for {key val} $d {
addNode $w $node $key $val
}
} else {
# $d is not a dictionary: make this node a leaf
$w set $node value $d
}
}
#-------------------------------------------------------------------------------
# setopen open/close node(s)
#-------------------------------------------------------------------------------
proc setopen { w items mode } {
foreach item $items {
$w item $item -open $mode
}
}
#-------------------------------------------------------------------------------
# collapse collapse all child nodes and make node $item a leaf
#-------------------------------------------------------------------------------
proc collapse { w items } {
foreach item $items {
set children ""
catch { set children [$w children $item] }
if { $children != "" } {
set value ""
foreach child [$w children $item] {
collapse $w $child
lappend value [$w item $child -text]
lappend value [$w set $child value]
$w delete $child
}
$w set $item value $value
}
}
}
#-------------------------------------------------------------------------------
# expand if possible, expand leaf value to child nodes
#-------------------------------------------------------------------------------
proc expand { w items } {
global errorInfo
foreach item $items {
if { [$w children $item] == "" } {
set d [$w set $item value]
set isdict 0
catch {
if { [dict get $d] == $d } {
set isdict 1
}
}
if { $isdict} {
dict for {key val} $d {
addNode $w $item $key $val
}
$w set $item value ""
}
}
}
}
#-------------------------------------------------------------------------------
# toggle toggle node(s) between collapsed / expanded
#-------------------------------------------------------------------------------
proc toggle { w items } {
foreach item $items {
if { [$w children $item] != "" } {
collapse $w $item
} else {
expand $w $item
}
}
}
#-------------------------------------------------------------------------------
# move move node up/down among siblings, i.e. keep parent node
#-------------------------------------------------------------------------------
proc move { w item increment } {
if { $item == "" || [llength $item] != 1 } { return }
set parent [$w parent $item]
set index [$w index $item]
incr index $increment
$w move $item $parent $index
}
#-------------------------------------------------------------------------------
# adopt move item to new parent
#-------------------------------------------------------------------------------
proc adopt { w item newparent newindex } {
set name [$w item $item -text]
set children [$w children $newparent]
if { $children == "" } {
return 0
}
foreach child $children {
if { $name == [$w item $child -text] } {
# not allowed: parent already has a child with that name
return 0
}
}
$w move $item $newparent $newindex
$w item $newparent -open 1
return 1
}
#-------------------------------------------------------------------------------
# rise rise/fall one level in the hierarchy
#-------------------------------------------------------------------------------
proc rise { w item increment } {
if { $item == "" || [llength $item] != 1 } { return }
set parent [$w parent $item]
if { $increment > 0 } {
# rise in the hierarchy, make my grandpa my new parent
set newparent [$w parent $parent] ;# grandpa
set newindex [$w index $parent]
incr newindex ;# behind my old parent
adopt $w $item $newparent $newindex
} else {
# fall in the hierarchy, make a brother my new parent
set index [$w index $item]
set brothers [$w children $parent]
set brother [lindex $brothers [expr $index-1]]
if { $brother != "" } {
if { [adopt $w $item $brother end] } {
return
}
}
foreach brother $brothers {
if { $brother != $item } {
if { [adopt $w $item $brother end] } {
return
}
}
}
}
}
#-------------------------------------------------------------------------------
# edit edit node text or value
#-------------------------------------------------------------------------------
proc edit { w item column { next "" } } {
global dictree
if { $item == "" || [llength $item] != 1 } { return }
foreach {bx by bw bh} [$w bbox $item $column] {}
set ym [expr $by + $bh/2]
while { $bx < 50 && [$w identify element $bx $ym] != "text" } {
incr bx
incr bw -1
}
if { $column == "#0" } {
set dictree($w,text) [$w item $item -text]
} elseif { [$w children $item] != "" } {
return
} else {
set dictree($w,text) [$w set $item $column]
}
set parent [winfo parent $w ]
if { [catch {
place $parent.e -x $bx -y $by -width $bw -height $bh
} ] } {
return
}
$parent.e configure -textvariable dictree($w,text) \
-validate key \
-validatecommand "dictree::edit_check $parent $item $column %P"
if { $dictree($w,text) == "(new)" } {
$parent.e selection range 0 end
} else {
$parent.e selection clear
}
$parent.e configure -background white
$parent.e icursor end
focus $parent.e
grab $parent.e
bind $parent.e "dictree::edit_done $w $item $column $next"
bind $parent.e "dictree::edit_done $w $item {} $next"
}
#-------------------------------------------------------------------------------
# edit_check check if name is allowed
#-------------------------------------------------------------------------------
proc edit_check { w item column value } {
global dictree
set ok 1
if { $column == "#0" } {
set parent [$w parent $item]
foreach child [$w children $parent] {
if { $child != $item &&
[$w item $child -text] == $value } {
set ok 0
}
}
set parent [winfo parent $w ]
if { ! $ok } {
$w.e configure -background red
} else {
$w.e configure -background white
}
}
return 1
}
#-------------------------------------------------------------------------------
# edit_done finish editing
#-------------------------------------------------------------------------------
proc edit_done { w item {column "" } { next "" } } {
global dictree
set parent [winfo parent $w ]
if { $column != "" && [$parent.e cget -background] == "red" } {
return
}
grab release $parent.e
focus $w
if { $column == "#0" } {
$w item $item -text $dictree($w,text)
} elseif { $column != "" } {
$w set $item $column $dictree($w,text)
}
place forget $parent.e
if { $next != "" } {
if { $column == "" } {
$w delete $item
$w selection set $dictree($w,selection)
} else {
edit $w $item $next
}
}
unset dictree($w,text)
catch { unset dictree($w,selection) }
}
#-------------------------------------------------------------------------------
# delete delete node(s) (after confirmation)
#-------------------------------------------------------------------------------
proc delete { w items } {
set count [llength $items]
set msg "Do you really want to delete the following "
if { $count > 1 } {
append msg "$count nodes:\n"
} else {
append msg "node:\n"
}
foreach item $items {
append msg " [$w item $item -text]"
}
append msg "?"
if { [tk_messageBox -title "Delete nodes" \
-icon warning -message $msg -type yesno] == "yes" } {
$w delete $items
}
}
#-------------------------------------------------------------------------------
# insert insert & edit new node before/after given node
#-------------------------------------------------------------------------------
proc insert { w item { offset 0 } } {
global dictree
if { $item == "" || [llength $item] != 1 } { return }
set dictree($w,selection) [$w selection]
set parent [$w parent $item]
set index [$w index $item]
set newidx [expr $index + $offset]
set node [$w insert $parent $newidx -text "(new)"]
$w set $node value "(new)"
$w selection set $node
edit $w $node "#0" "value"
}
#-------------------------------------------------------------------------------
# reap return the content of the treeview as dictionary
#-------------------------------------------------------------------------------
proc reap { w { node "" } } {
set children [$w children $node]
if { [llength $children] == 0 } {
set value [$w set $node value]
dict set d [$w item $node -text] $value
} else {
foreach child $children {
set value [reap $w $child]
if { $node == "" } {
lappend d {*}$value
} else {
dict lappend d [$w item $node -text] {*}$value
}
}
}
return $d
}
#-------------------------------------------------------------------------------
# dictdir generate example dict with filesystem info
#-------------------------------------------------------------------------------
proc dictdir { dir } {
set d ""
file stat $dir fstat
foreach item [lsort [array names fstat]] {
dict set d . $item $fstat($item)
}
foreach subdir [lsort [glob -directory $dir -nocomplain -types d "*"]] {
dict set d {*}[dictdir $subdir]
}
foreach fname [lsort [glob -directory $dir -nocomplain -types f "*"]] {
file stat $fname fstat
# sorted:
foreach item [lsort [array names fstat]] {
dict set d [file tail $fname] $item $fstat($item)
}
# faster but unsorted:
# dict set d [file tail $fname] [array get fstat]
}
return [list [file tail $dir]/ $d]
}
#-------------------------------------------------------------------------------
# main "main" for demo program
#-------------------------------------------------------------------------------
proc main { args } {
set fname [pwd] ;# default to current dir
if { [llength $args] >= 1 } { ;# check for commandline arg
set fname [lindex $args 0]
}
if { [file isdirectory $fname] } { ;# directory was given:
set d [dictdir $fname] ;# parse directory
} else { ;# file was given:
set h [open [lindex $args 0] "r"] ;# read dict from file
set d [read $h]
close $h
}
# create dictree control:
dictree .t $d
pack .t -expand yes -fill both
}
#-------------------------------------------------------------------------------
# end of namespace dict::
#-------------------------------------------------------------------------------
}
#-------------------------------------------------------------------------------
# "main" function: run demo if this module is called rather than sourced
#-------------------------------------------------------------------------------
if { [info exist argv0] && [info script] == $argv0 } {
dictree::main {*}$argv
}
#-------------------------------------------------------------------------------
# end of file
#-------------------------------------------------------------------------------
======
<>
Small error in editing
======
entry $w.e ;# widget used for editing
======
Should be
======
entry $w.t.e ;# widget used for editing
======
<>Command | Editor utility | GUI | Widget