cloneProc

Believe it or not, I actually needed this for something!

 ## ******************************************************** 
 ##
 ## Name: cloneProc
 ##
 ## Description:
 ## Creates a new procedure identical in behaviour to a
 ## prototype procedure, but with a different name.
 ##
 ## Parameters:
 ##
 ## Usage:
 ##
 ## Comments:
 ##

 proc cloneProc { proto clone } {
      eval proc $clone \{ [ info args $proto ] \} \
                       \{ [ info body $proto ] \}
 }
 ## ********************************************************

-PSE

Hmmm, seems like the following is simpler:

 proc cloneProc { proto clone } {
     proc $clone [info args $proto] [info body $proto]
 }

I'm curious why you thought all the extra quoting was needed?

Because I always wear a belt and suspenders. -pse

Of course, both versions suffer from the inability to clone default arguments. An exercise for the next reader?

-DGP

Sure, I'll bite:

 proc cloneProc { proto clone } {
     set argv {}
     foreach x [info args $proto] {
         if {[info default $proto $x y]} {
             set x [list $x $y]
         }
         lappend argv $x
     }
     proc $clone $argv [info body $proto]
 }

-JC

DKF: Woe betide anyone trying to clone anything with a (admittedly bizarre) argument name with a space in with the above code:

  proc cloneProc {proto clone} {
      set argv [list]
      foreach x [info args $proto] {
          if {[info default $proto $x y]} {
              lappend argv [list $x $y]
          } else {
              lappend argv [list $x]
          }
      }
      proc $clone $argv [info body $proto]
  }

(careful Donal, you're about to step on my patent for cloning admittedly bizarre things in space)

MGS [2003/08/12] - I found it a little more complex, dealing with namespaces, etc, so I use:

 proc clone:proc {proc1 proc2} {
 
   set argv {}
 
   set proc [uplevel [list namespace which -command $proc1]]
 
   foreach arg [info args $proc] {
     if { [info default $proc $arg default] } {
       lappend argv [list $arg $default]
     } else {
       lappend argv [list $arg]
     }
   }
 
   uplevel [list proc $proc2 $argv [info body $proc]]
 
   return
 
 }

Category Uncategorized