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 keys ${var}}] } {return 0} else {return 1} } proc get? {tempDict args} { if {[dict exists $tempDict {*}$args]} { return [dict get $tempDict {*}$args] } } proc modify {var args} { set opVar [lindex $var 0] set dArgs [lrange $var 1 end] upvar 1 $opVar theDict foreach {name val} $args { dict set theDict {*}$dArgs $name $val } return $theDict } proc pull {var args} { if {![dict isDict $var]} { upvar 1 $var theDict } else { set theDict $var } if {![info exists theDict] || $theDict eq ""} { throw error "dict pull error: $var doesn't exist" } foreach val $args { set nVar [lindex $val 1] set val [lindex $val 0] if {$nVar eq ""} {set nVar $val} upvar 1 $nVar $nVar set $nVar [dict get? $theDict $val] dict set returnDict $nVar [set [set nVar]] } if { [ info exists returnDict ] } { return $returnDict } } proc pullFrom {var args} { set opVar [lindex $var 0] set dArgs [lrange $var 1 end] upvar 1 $opVar theDict if {![info exists theDict] || $theDict eq ""} { throw error "dict pull error: $var doesn't exist" } foreach val $args { set nVar [lindex $val 1] set val [lindex $val 0] if {$nVar eq ""} {set nVar $val} upvar 1 $nVar $nVar set $nVar [dict get? $theDict {*}$dArgs $val] dict set returnDict $nVar [set [set nVar]] } if { [ info exists returnDict ] } { return $returnDict } } proc destruct {var args} { set opVar [lindex $var 0] set dArgs [lrange $var 1 end] upvar 1 $opVar theDict foreach val $args { set nVar [lindex $val 1] set val [lindex $val 0] if {$nVar eq ""} {set nVar $val} upvar 1 $nVar $nVar set $nVar [dict get? $theDict {*}$dArgs $val] dict unset theDict {*}$dArgs $val } } proc push {var args} { set opVar [lindex $var 0] set dArgs [lrange $var 1 end] upvar 1 $opVar theDict foreach val $args { set nVar [lindex $val 1] set val [lindex $val 0] if {$nVar eq ""} {set nVar $val} upvar 1 $val fromVal if {[info exists fromVal]} { dict set theDict {*}$dArgs $nVar $fromVal } else {throw error "$val doesn't exist"} } return $theDict } } ====== ---- <> Example