Wrapping a procedure

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