oo::copy

oo::copy , a built-in Tcl command, creates a duplicate of a TclOO object.

Documentation

official reference

Synopsis

oo::copy sourceObject ?targetObject? ?targetNamespace?

Description

oo::copy creates a new object and copies the configuration of sourceObject to it, after which it calls the <cloned> method of the new object. The default implementation of that method in the oo::object class copies procedures and variables from the source object's namespace, but does not copy any traces or commands implemented in C.

Objects can potentially refuse to be duplicated, generating an error instead. Generating an error from the <cloned> method counts as refusal.

If you specify targetObject (as something other than the empty string), that will be the name of the new object. If you specify targetNamespace (as something other than the empty string) that will be the name of the object's internal namespace; note that the namespace must not exist before you call oo::copy, just as with oo::class's createWithNamespace method.

Things copied:

all variables and procedures in the namespace of sourceObject
commands that are not procedures are not copied.
exported methods
forwarded methods
mixin classes
exported procedures

Things not copied

commands in sourceObject that are not procedures
The namespace unknown command for a namespace
namespace ensemble of sourceObject
TclOO itself doesn't create a namespace ensemble on the namespace that backs sourceObject, but if one does exist, it doesn't get copied.
traces
Neither traces on variables nor traces on commands are copied.

Determining What is Copied

The script below runs a test to see what attributes of an object and its underlying namespace are copied.

#! /bin/env tclsh

proc examine object {
    variable tests
    puts [list {what is copied for} $object]
    set ns [$object eval {namespace current}]
    namespace eval ns1 [
        list namespace import ${ns}::export1]
    set results {0 yes 1 no}
    foreach {label script} $tests {
        set copts {}
        puts [list $label [dict get $results [
            catch $script cres copts]]]
        #puts $copts
    }
    $object forward1
}

::oo::class create c1 {
    method mixin1 {} {}
}

proc p1 args {}

::oo::object create one
::oo::objdefine one {
    export eval
    method hi args {
    }
    method delete1 {} {}

    method setup {} {
        namespace eval [self namespace] {
            namespace export export1 
            namespace path [list {*}[namespace path] ::tcl::mathfunc]
            proc export1 {} {}
            proc unknownproc args {}
            namespace ensemble create -map {ensemble1 export1}
            namespace unknown unknownproc
        }
    }
    deletemethod delete1
    forward forward1 p1
    mixin -append c1
}


variable tests {
    {namespace unknown} {
        $object eval nosuchproc
    }
    {method export} {
        namespace eval ns1 export1
    }
    {method forward} {
        $object forward1
    }
    {object mixin} {
        $object mixin1
    }
    {namespace ensemble} {
        $ns ensemble1
    }
    {namespace path} {
        if {{::tcl::mathfunc} ni [namespace eval $ns {namespace path}]} error 
    }
}

one setup
::oo::copy one two
examine two

Wrapper That Respects Imported Procedures

oo::object <cloned> copies aliased procedures in the origin namespace over to the new namespace as native procedures. The following drop-in replacement changes that behaviour so that imported procedures are imported procedures in the new namespace as well. The code below is not necessarily recommended, as overriding <cloned> in a subclass is the recommended way of getting this behaviour.

rename copy oocopy
proc copy {sourceObject args} {
    set from [uplevel [list namespace which $sourceObject]]
    set fromns [info object namespace $from]
    if {[string range $fromns end-1 end] eq {::}} {
        set fromns [string range $fromns 0 end-2]
    }
    set to [uplevel [list [namespace current]::oocopy $from {*}$args]]
    set tons [info object namespace $to]
    foreach proc [info procs ${tons}::*] {
        set tail [namespace tail $proc]
        if {[namespace origin ${fromns}::$tail] ne "${fromns}::$tail"} {
            #For imported procedures ::oo::copy doesn't import the procedure
            #but creates an entirely new equivalent procedure in the new
            #namespace. This is probably not what's desired.  Delete the proc
            #that oo::copy made so that copycommands can just make an
            #equivalent import
            rename $proc {}
        }
    }
    copycommands $fromns $tons my
    return $to
}