Updated 2016-04-07 22:04:11 by Bezoar

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.

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 <plus> { dictree::setopen %W [%W selection] 1 }
bind $w <minus> { dictree::setopen %W [%W selection] 0 }
bind $w <Alt-plus> { dictree::expand %W [%W selection] }
bind $w <Alt-minus> { dictree::collapse %W [%W selection] }
bind $w <Alt-ButtonPress-1> { dictree::toggle %W [%W identify item %x %y] }
bind $w <Alt-Return> { dictree::toggle %W [%W selection]; break }
bind $w <F2> { dictree::edit %W [%W selection] "#0" }
bind $w <Shift-F2> { dictree::edit %W [%W selection] "value" }
bind $w <Alt-Up> { dictree::move %W [%W selection] -1; break }
bind $w <Alt-Down> { dictree::move %W [%W selection] 1; break }
bind $w <Alt-Left> { dictree::rise %W [%W selection] 1; break }
bind $w <Alt-Right> { dictree::rise %W [%W selection] -1; break }
bind $w <Delete> { dictree::delete %W [%W selection] }
bind $w <Insert> { dictree::insert %W [%W selection] }
bind $w <Alt-Insert> { dictree::insert %W [%W selection] 1 }
if { $debug } {
# to aid developing additional bindings:
bind $w <ButtonPress-1> {
set item [%W identify item %x %y]
puts "%x,%y: %W item $item: [%W item $item]"
}
bind $w <KeyPress> { 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 <Return> "dictree::edit_done $w $item $column $next"
bind $parent.e <Escape> "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

Bezoar 4/7/2016

I made the edits for the errors above in the code to allow the widget to work right out of the box. I also changed binding to edit value from Alt-F2 to Shift-F2