# stack_proc.tcl # Copyright 2001 by Larry Smith # Wild Open Source, Inc # For license terms see "COPYING" from any GPL licensed distribution # # permits a new definition of a proc to stack on top # of a previous one, even it the previous one is built-in. # procs can nest to any depth. You can eliminate the # latest proc with pullproc, or call up the stack to # each previously-stacked proc in turn with callprev, # or merely retrieve its name with getprev. proc pushproc { name arguments { code "" } } { if ![ string equal [ info commands $name ] "" ] { upvar #0 $name stack if [ info exists stack ] { incr stack } else { set stack 1 } rename $name $name-$stack } if [ string equal $code "" ] { rename $arguments $name } else { proc $name $arguments $code } } proc pullproc { name { newname "" }} { upvar #0 $name stack if [ info exists stack ] { rename $name $newname rename $name-$stack $name incr stack -1 if { $stack == 0 } { unset stack } } } proc getprev { } { set name [lindex [ info level -1 ] 0] if { "$name" == "callprev" } { set name [lindex [ info level -2 ] 0] } set curproc "" regexp {([^-]*)-([0-9]*)} $name -> procname curproc if ![info exists procname] { set procname $name } upvar #0 $procname stack if { "$curproc" == "" } { if [ info exists stack ] { set curproc $stack } else { return "" } } else { incr curproc -1 } if { $curproc == 0 } { return "" } return $procname-$curproc } proc callprev { args } { set name [ getprev ] if ![string equal $name "" ] { return [ eval $name $args ] } return "" } #example source stack_proc.tcl pushproc test { x } { puts "first $x ([lindex [ info level 0 ] 0])" } pushproc test { x } { puts "second $x ([lindex [ info level 0 ] 0])" callprev $x } pushproc test { x } { puts "third $x ([lindex [ info level 0 ] 0])" callprev $x } test a pullproc test test b pullproc test test c # another example pushproc file { op args } { switch $op { "getacl" { return "getacl" } "putacl" { return "putacl" } default { eval callprev $op $args } } } puts [ file exists foo] puts [ file getacl foo] ---- Where do we find this "COPYING" file describing the license terms of the above code? You don't, I just cut and pasted the code when the stacking ---- [modify a proc's behavior with a shim] issue came up. It's just the GPL.