Extending an ensemble of routines is one of the fundamental techniques for organizing routines in programs.
In Tcl an ensemble of routines is often exposed as a single routine whose first argument is the name of the routine in the ensemble to execute. This is the basis of object-oriented programming in Tcl. To extend an existing ensemble:
If the routines in the original ensemble are implemented in a namespace, it would be a bad idea to drop new routines into that namespace because it would require knowledge of all the routines already in that namespace. For example, the namespace might implement its own set that does something entirely different from set. Any routine dropped into the namespace would have to be aware of this and make sure to choose the right set. This approach does not compose well. In general then, the right approach is to extend a routine by wrapping it.
Here is an implementation of extend that keeps the extension routines neatly separated from the original set of ensemble routines:
namespace eval ensemble {
# extend an ensemble-like routine with the routines in some namespace
proc extend {routine extension} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $extension]} {
set extension [uplevel 1 [
list [namespace which namespace] current]]::$extension
}
if {![namespace exists $extension]} {
error [list {no such namespace} $extension]
}
set extension [namespace eval $extension [
list [namespace which namespace] current]]
namespace eval $extension [
list [namespace which namespace] export *]
while 1 {
set renamed ${routinens}::${routinetail}_[info cmdcount]
if {[namespace which $renamed] eq {}} break
}
rename $routine $renamed
namespace eval $extension [
list namespace ensemble create -command $routine -unknown [
list apply {{renamed ensemble routine args} {
list $renamed $routine
}} $renamed
]
]
return $routine
}
}In the following example, file is extended with newer and newerthan:
namespace eval fileextension {
proc newer {a b} {
puts [list eh [namespace which file]]
#expr {[file mtime $a] > [file mtime $b]}
}
proc newerthan {mtime path} {
expr {[file exists $path] && ([file mtime $path] > $mtime)}
}
}
ensemble extend file fileextensionIn the next example, modify is added to dict:
# extra useful dict commands
namespace eval dictextension {
proc modify {var args} {
upvar 1 $var dvar
foreach {name val} $args {
dict set dvar $name $val
}
}
}
ensemble extend dict dictextension PYK 2016-10-14 2020-01-26: extend, presented below, adds a routine to a namespace ensemble. Therefore, it only works with namespace ensemble routines, and not generally with other ways of implementing ensembles of routines. Furthermore, instead of accepting the name of an existing routine, it acts like proc, accepting a procedure specification and creating that procedure in the namespace for the ensemble routine. It also assumes that the namespace of the ensemble has the same name as the ensemble routine itself. Because of these caveats, it isn't as useful as the general technique of wrapping an ensemble routine, as presented above.
#! /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)}]
}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 2016-10-14: Here is DKF's version with some changes to avoid namespace collisions, and using apply instead of proc:
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]
}Napier 2015-12-27 --
I really like ES6 Javascript's 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 its 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 ; # % ""
Read More / See Code Dict Extensions
DKF: A dict update with an empty body will have the same effect, but requires that you specify the variable name separately to the key, and a dict with with an empty body will also have a related effect, but that expands all the keys to variables.