** dicttool **
Starting from [tcllib] 1.17, the dicttool package provides additional utilities on top of the regular [dict] package. One of these is the ability to recursively merge dictionaries. The version below adds the ability to append to list values during the merge. The option -restrict is a list of glob-style matching patterns that the names of the keys should match to be considered for list appending. By default, it will match any key name:
======
if {[::info commands ::tcl::dict::rlamerge] eq {}} {
proc ::tcl::dict::_psearch { k ptns } {
foreach p $ptns {
if { [string match $p $k] } {
return 1
}
}
return 0
}
###
# title: A recursive form of dict merge
# description:
# A routine to recursively dig through dicts and merge
# adapted from http://stevehavelka.com/tcl-dict-operation-nested-merge/
# This appends to list values
###
proc ::tcl::dict::rlamerge {args} {
# Parse possible list of restricted keys to consider as lists
if { [lindex $args 0] eq "-restrict" } {
::set restrictions [lindex $args 1]
::set a [lindex $args 2]
::set args [lrange $args 3 end]
} else {
::set restrictions [list "*"]
::set a [lindex $args 0]
::set args [lrange $args 1 end]
}
::set result $a
# Merge b into a, and handle nested dicts appropriately
::foreach b $args {
for { k v } $b {
if {[string index $k end] eq ":"} {
# Element names that end in ":" are assumed to be literals
set result $k $v
} elseif { [dict exists $result $k] } {
# key exists in a and b? let's see if both values are dicts
# both are dicts, so merge the dicts
if { [is_dict [get $result $k]] && [is_dict $v] } {
set result $k [rlamerge -restrict $restrictions [get $result $k] $v]
} elseif { [_psearch $k $restrictions] && [string is list [get $result $k]] && [string is list $v] } {
lappend result $k {*}$v
} else {
set result $k $v
}
} else {
set result $k $v
}
}
}
return $result
}
namespace ensemble configure dict -map [dict replace\
[namespace ensemble configure dict -map] rlamerge ::tcl::dict::rlamerge]
}
======
Here is a little example:
======
set a [dict create color green]
set b [dict create fruit pear]
set c [dict create color {red blue} fruit {apple orange}]
puts [dict print [dict rlamerge -restrict {fruit} $a $b $c]]
======