Tcl's ensembles are handy, but sometimes you want to add a command to an existing one.  This page shows some ways you can do that.

**See Also**

   * [Larry Smith]: [stacking] does a similar job.
   * [AMG]: See also my [[dict getnull]] example in [[[dict get]]].
   * [samoc]: oclib.tcl[https://github.com/samoconnor/oclib.tcl] has a similar "extend_proc" [https://github.com/samoconnor/oclib.tcl/blob/master/oclib/oc_ensemble-1.0.tm#L17] command.


**A Word of Warning**

Dynamically extending ensembles is risky.  The first examples on this page put new procs inside the ensemble's namespace.  Because these can shadow core commands in ::, this can impact the behaviour of existing ensemble commands: adding a [set] subcommand is almost guaranteed to cause problems!

[PYK]'s refinements to the versions below take more care to avoid this risk.
There is also `[ycl] shelf subcmd`, which offers a more fine-grained way to
accomplish the task, allowing a subcommand like `set` to be mapped to a command
named `set_`, which can be placed in any namespace, not just the namespace of
the ensemble:

======
proc ::some_ensemble::set_ args {
    error [list {just kidding} $args]
}

shelf subcmd ::some_ensemble set set_
======

Or, if the command is in another namespace:

======
shelf subcmd ::some_ensemble:: set ::some_other_namespace::some_command
======

To use `shelf subcmd` with an ensemble that doesn't have a map, first create a
map for it:

======
foreach command [ensemble commands some_ensemble] {
    shelf subcmd some_ensemble $command
}
======

After that, use `[shelf] subcmd` to add more commands. 


Another alternative is, [Ensemble objects], which with the help of [TclOO] try to
design around the problem for new ensembles.



**[CMcC]'s version (2006)**

Here's a simple bit of code to extend any [ensemble]-like command by means of tcl8.5's [namespace ensemble] command.  [CMcC] 6Mar2006:


======
 package provide extend 1.0
 package require Tcl 8.5
 
 # extend a command with a new subcommand
 proc extend {cmd body} {
    if {![namespace exists ${cmd}]} {
        set wrapper [string map [list %C $cmd %B $body] {
            namespace eval %C {}
            rename %C %C::%C
            namespace eval %C {
                proc _unknown {junk subc args} {
                    return [list %C::%C $subc]
                }
                namespace ensemble create -unknown %C::_unknown
            }
        }]
    }

    append wrapper [string map [list %C $cmd %B $body] {
        namespace eval %C {
            %B
            namespace export -clear *
        }
    }]
    uplevel 1 $wrapper
 }
======

----
Here's the [file] command extended with '''newer''' and '''newerthan''' subcommands:

======
 extend file {
    proc newer {a b} {
       return [expr {[file mtime $a] > [file mtime $b]}]
    }

    proc newerthan {mtime path} {
       return [expr {[file exists $path] && ([file mtime $path] > $mtime)}]
    }
 }
======

Here's the [dict] command extended with the '''modify''' subcommand:

======
 # extra useful dict commands
 extend dict {
    proc modify {var args} {
       upvar 1 $var dvar
       foreach {name val} $args {
          dict set dvar $name $val
       }
    }
 }
======

----
**[DKF]'s version**
In a [comp.lang.tcl] posting dated Fri, 04 Apr 2014 09:25:30 [DKF] posted an example of using the ensemble's `-unknown` parameter to lazily apply extensions.  A version of [extend] using this technique:

======
proc extend {ens script} {
    namespace eval $ens [concat {
        proc _unknown {ens cmd args} {
            if {$cmd in [namespace eval ::${ens} {::info commands}]} {
                set map [namespace ensemble configure $ens -map]
                dict set map $cmd ::${ens}::$cmd
                namespace ensemble configure $ens -map $map
            }
            return "" ;# back to namespace ensemble dispatch
                      ;# which will error appropriately if the cmd doesn't exist
        }
    }   \; $script]
    namespace ensemble configure $ens -unknown ${ens}::_unknown
}
======
Note that new extensions defined in this way will not appear in the ensemble's map until they are used, so the default error message is misleading.

----

**[PYK]'s improvements**

[PYK] 2016-10-14:   Fixed various quoting and robustness weaknesses in the implementations on this page.  In order to achieve that with CMCC's variant, I modified `extend` to accept as arguments a procedure specification instead of a complete script.  The main advantage to this interface change is that the user doesn't have to worry about encountering an alternate `proc` in some namespace.

======
#! /usr/bin/env tclsh

package provide extend 1.0
package require tcl 8.5
 
# extend a command with new subcommands
proc extend {cmd subcmd subspec body} {
    namespace eval [uplevel 1 [list namespace which $cmd]] [string map [
        list %subcmd [list $subcmd] %subspec [list $subspec] %body [list $body]] {
        if {[namespace which [namespace tail [namespace current]]] ne "[
            string trimright [namespace current] :]::[
            namespace tail [namespace current]]"} {

            ::rename [::namespace current] [::namespace current]::[
                ::namespace tail [::namespace current]]
            ::namespace export *
            ::namespace ensemble create -unknown [list ::apply [list {ns subc args} {
                ::return [::list ${ns}::[::namespace tail $ns] $subc]
            } [namespace current]]]
        }
        puts [list creating %subcmd in [namespace current]]
        ::proc %subcmd %subspec %body
    }]
}
======
Example use:
======
extend file newer {a b} {
  return [expr {[file mtime $a] > [file mtime $b]}]
}

extend file newerthan {mtime path} {
  return [expr {[file exists $path] && ([file mtime $path] > $mtime)}]
}
======

[DKF]'s version with some tweaks.  This still takes a script.
======
proc extend {ens script} {
    uplevel 1 [string map [list %ens [list $ens]] {
        namespace ensemble configure %ens -unknown [list ::apply [list {ens cmd args} {
            ::if {$cmd in [::namespace eval ::${ens} {::info commands}]} {
                ::set map [::namespace ensemble configure $ens -map]
                ::dict set map $cmd ::${ens}::$cmd
                ::namespace ensemble configure $ens -map $map
            }
            ::return {} ;# back to namespace ensemble dispatch
                  ;# which will error appropriately if the cmd doesn't exist
        } [namespace current]]]
    }]\;[list namespace eval $ens $script]
}
======



**[dict] extensions by [Napier]**
[Napier / Dash Automation] 2015-12-27 --

I really like ES6 Javascripts capabilities to work with objects such as  "const { key1, key2 } = myObject", so I decided to give myself similar functionality with a "dict pull" command.  
One thing I am not sure of, is if setting an empty string is the proper thing to do when a value doesn't exist.  I would like to handle it similar to javascript, but tcl doesn't have a "null" option which could be used
to default to false

I know this is somewhat similar to dict update or dict with but the syntax is a bit simpler and it's designed for it's exact purpose, except that it only unpacks the requested keys and will create the variables so they may be used without [info exists] in cases that is too verbose.

The resulting operation with extend:

======
set tempDict [dict create foo fooVal bar barVal]
dict pull $tempDict foo bar rawr
puts $foo        ; # % fooVal
puts $bar        ; # % barVal
puts $rawr       ; # % ""
======

and the code:
======
extend dict {

  proc isDict {var} { 
    if { [::catch {::dict size ${var}}] } {::return 0} else {::return 1} 
  }
  
  proc get? {tempDict key args} {
    if {[::dict exists $tempDict $key {*}$args]} {
      ::return [::dict get $tempDict $key {*}$args]
    }
  }
  
  proc pull {var args} {
    ::upvar 1 $var check
    if { [::info exists check] } {
      ::set d $check
    } else { ::set d $var }
    ::foreach v $args {
      ::set path [::lassign $v variable name default]
      ::if { $name eq {} } { ::set name $variable }
      ::upvar 1 $name value
      ::if { [::dict exists $d {*}$path $variable] } {
        ::set value [::dict get $d {*}$path $variable]
      } else { ::set value $default }
      ::dict set rd $name $value
    }
    ::return $rd
  }
  
  proc pullFrom {var args} {
    ::set mpath [::lassign $var var]
    ::upvar 1 $var check
    ::if { [::info exists check] } { 
      ::set d $check
    } else { ::set d $var }
    ::foreach v $args {
      ::set path [::lassign $v variable name default]
      ::if { $name eq {} } { ::set name $variable }
      ::upvar 1 $name value
      ::if { [::dict exists $d {*}$mpath $variable {*}$path] } {
        ::set value [::dict get $d {*}$mpath $variable {*}$path]
      } else { ::set value $default }
      ::dict set rd $name $value
    }
    ::return $rd
  }
  
  proc modify {var args} {
    ::upvar 1 $var d
    ::if { ! [info exists d] } { ::set d {} }
    ::if { [::llength $args] == 1 } { ::set args [::lindex $args 0] }
    ::dict for { k v } $args { ::dict set d $k $v }
    ::return $d
  }
  
  proc push {var args} {
    ::if {$var ne "->"} { ::upvar 1 $var d }
    ::if { ! [::info exists d] } { ::set d {} }
    ::foreach arg $args {
      ::set default [::lassign $arg variable name]
      ::upvar 1 $variable value
      ::if { [::info exists value] } {
        ::if { $name eq {} } { ::set name $variable }
        ::if { $value ne {} } {
          ::dict set d $name $value
        } else { ::dict set d $name $default }
      } else { ::throw error "$variable doesn't exist when trying to push $name into dict $var" }
    }
    ::return $d
  }
  
  proc pushIf {var args} {
    ::if {$var ne "->"} { ::upvar 1 $var d }
    ::if { ! [::info exists d] } { ::set d {} }
    ::foreach arg $args {
      ::set default [::lassign $arg variable name]
      ::upvar 1 $variable value
      ::if { ! [::info exists value] } { ::throw error "$variable doesn't exist when trying to pushIf $name into dict $var" }
      ::if { $name eq {} } { ::set name $variable }
      ::if { $value ne {} } {
        ::dict set d $name $value
      } elseif { $default ne {} } {
        ::dict set d $name $default
      }
    }
    ::return $d
  }
  
  proc pushTo {var args} {
    ::set mpath [::lassign $var var]
    ::if {$var ne "->"} { ::upvar 1 $var d }
    ::if { ! [::info exists d] } { ::set d {} }
    ::foreach arg $args {
      ::set path [::lassign $arg variable name]
      ::upvar 1 $variable value
      ::if { ! [::info exists value] } { ::throw error "$variable doesn't exist when trying to pushTo $name into dict $var at path $path" }
      ::if { $name eq {} } { ::set name $variable }
      ::dict set d {*}$mpath {*}$path $name $value
    }
    ::return $d
  }

  proc destruct {var args} {
    ::set opVar [::lindex $var 0]
    ::set dArgs [::lrange $var 1 end]
    ::upvar 1 $opVar theDict
    ::if { ! [::info exists theDict] } {
      ::set theDict {}
    }
    ::set returnDict {}
    ::foreach val $args {
      ::lassign $val val nVar def
      ::if {$nVar eq ""} {::set nVar $val}
      ::upvar 1 $nVar $nVar
      ::if {$def ne ""} {
        ::set $nVar [::if? [::dict get? $theDict {*}$dArgs $val] $def]
      } else {
        ::set $nVar [::dict get? $theDict {*}$dArgs $val]
      }
      ::dict set returnDict $nVar [set $nVar]
      ::catch {::dict unset theDict {*}$dArgs $val}
    }
    ::return $returnDict
  }
  
  proc pickIf {var args} { ::return [::dict pick $var {*}$args] }
  
  proc pick {var args} {
    ::set tempDict {}
    ::foreach arg $args {
      ::lassign $arg key as
      ::if { [::dict exists $var $key] } {
        ::if { $as eq {} } { ::set as $key }
        ::set v [::dict get $var $key]
        ::if { $v ne {} } { ::dict set tempDict $as $v }
      }
    }
    ::return $tempDict
  }
  
  proc withKey {var key} {
    ::set tempDict {}
    ::dict for {k v} $var {
      ::if { [::dict exists $v $key] } {
        ::dict set tempDict $k [::dict get $v $key]        
      }
    }
    ::return $tempDict
  }
  
  ::proc fromlist { lst {values {}} } {
    ::set tempDict {}
    ::append tempDict [::join $lst " [list $values] "] " [list $values]"
  }
  
  proc sort {what dict args} {
    ::set res {}
    ::if {$dict eq {}} { ::return }
    ::set dictKeys [::dict keys $dict]
    ::switch -glob -nocase -- $what {
      "v*" {
        ::set valuePositions [::dict values $dict]
        ::foreach value [ ::lsort {*}$args [::dict values $dict] ] {
          ::set position [::lsearch $valuePositions $value]
          ::if {$position eq -1} { ::puts "Error for $value" }
          ::set key [::lindex $dictKeys $position]
          ::set dictKeys [::lreplace $dictKeys $position $position]
          ::set valuePositions [::lreplace $valuePositions $position $position]
          ::dict set res $key $value
        }
      }
      "k*" -
      default {
        ::foreach key [::lsort {*}$args $dictKeys] {
          ::dict set res $key [::dict get $dict $key] 
        }
      }
    }
    ::return $res
  }
  
  proc invert {var args} {
    ::set d {}
    ::dict for {k v} $var {
      ::if {"-overwrite" in $args} {
        ::dict set d $v $k
      } else {
        ::dict lappend d $v $k
      }
    }
    ::return $d
  }
  
  proc json {json dict {key {}}} {
    ::puts "TO JSON: $dict $key"
    ::upvar 1 $dict convertFrom
    ::if {![info exists convertFrom] || $convertFrom eq {}} { ::return }
    ::set key [::if? $key $dict]
    $json map_key $key map_open
      ::dict for {k v} $convertFrom {
        ::if {$v eq {} || $k eq {}} { ::continue }
        ::if {[::string is entier -strict $v]} {                   $json string $k number $v
        } elseif {[::string is bool -strict $v]} {           $json string $k bool $v
        } else {                                                                                $json string $k string $v  
        }
      }
    $json map_close
    ::return
  }
  
  proc serialize { json dict } {
    ::dict for {k v} $dict {
      ::if {$v eq {} || $k eq {}} { ::continue }
      ::if {[::string is entier -strict $v]} {                   $json string $k number $v
      } elseif {[::string is bool -strict $v]} {           $json string $k bool $v
      } else {                                                                                                        $json string $k string $v  
      }
    }
  }
  
  proc types {tempDict} {
    ::set typeDict {}
    ::dict for {k v} $tempDict {
      ::if {[::string is entier -strict $v]} {                          ::dict set typeDict $k number
        } elseif {[::string is bool -strict $v]} {          ::dict set typeDict $k bool
        } else {                                                                                                                   ::dict set typeDict $k string 
        }
    }
    ::return $typeDict
  }
  
}
======

----
<<categories>> Example