** 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]]
======