NEM 2006-10-06: As another demonstration of Tcl 8.5 features, here is an example of how to wrap some functionality around a Tcl procedure. This is vaguely similar to filters in
XOTcl, and
stacking procedures. The old procedure is stored away as an anonymous procedure (
lambda) that is made available to the wrapper in the variable "next". You can then use
apply to re-invoke the old version. The use of lambdas makes this version completely transparent, as no new command names are introduced. However, I currently use
interp alias to arrange for the old lambda to be made available, which means that the wrapped command is no longer a proc, and so cannot be wrapped again. This could probably be fixed if someone has time to think about it a bit more.
# Get the argument list of a proc, complete with defaults.
# We assume the proc-name is fully-qualified.
proc params proc {
set params [list]
foreach param [info args $proc] {
if {[info default $proc $param default]} {
lappend params [list $param $default]
} else {
lappend params $param
}
}
return $params
}
proc wrap {proc params body} {
# Resolve fully-qualified proc name
set name [uplevel 1 [list namespace which -command $proc]]
# Capture namespace, params and body of old proc
set ns [namespace qualifiers $name]
set next [list [params $name] [info body $name] $ns]
# Install new proc, passing $next as first parameter
interp alias {} $name {} ::apply \
[list [linsert $params 0 next] $body $ns] $next
return $name
}We can then do stuff like the following:
proc add {a b} { expr {$a + $b} }
wrap add {a b} {
puts "BEFORE: $a + $b"
set res [apply $next $a $b]
puts "AFTER : $a + $b = $res"
return $res
}Test:
% add 3 4
BEFORE: 3 + 4
AFTER : 3 + 4 = 7
7
