%3 ::nx::Object ::nx::Object __default_accessor __default_method_call_protection __object_configureparameter __resolve_method_path contains copy delete object method delete object property delete object variable destroy_on_cleanup info info info lookup parameters info lookup slots info lookup syntax info lookup variables info object method args info object method body info object method callprotection info object method debug info object method definition info object method definitionhandle info object method deprecated info object method exists info object method handle info object method origin info object method parameters info object method registrationhandle info object method returns info object method submethods info object method syntax info object method type info object slots info object variables info variable definition info variable name info variable parameter move object alias object forward object method object property object variable private protected public qn require namespace require object method require private object method require protected object method require public object method serialize ::nx::CopyHandler ::nx::CopyHandler copy copyTargets dest getDest makeTargetList objLength targetList ::nx::CopyHandler->::nx::Object

Class ::nx::CopyHandler

::nx::CopyHandler[i] create ... \
           [ -dest (default "") ] \
           [ -objLength objLength ] \
           [ -targetList (default "") ]

Class Relations

  • class: ::nx::Class[i]
  • superclass: ::nx::Object[i]
::nx::Class create ::nx::CopyHandler \
     -superclass ::nx::Object

Methods (to be applied on instances)

  • copy (scripted)

    set :objLength [string length $obj]
set :dest $dest
:makeTargetList $obj
:copyTargets

  • copyTargets (scripted)

    set objs {}
array set cmdMap {alias alias forward forward method create setter setter}

foreach origin [set :targetList] {
  set dest [:getDest $origin]
  if {[::nsf::object::exists $origin]} {
      if {$dest eq ""} {
        #set obj [[$origin info class] new -noinit]
        set obj [::nsf::object::alloc [$origin info class] ""]
        #nsf::object::property $obj initialized 1
        set dest [set :dest $obj]
      } else {
        #
        # Slot container are handled separately, since
        # ::nx::slotObj does already the right thing. We have just
        # to copy the variables (XOTcl keeps the parameter
        # definitions there).
        #
        if {[::nsf::object::property $origin slotcontainer]} {
          ::nx::slotObj -container [namespace tail $origin]  [namespace qualifiers $dest]
          ::nsf::nscopyvars $origin $dest
          continue
        } else {
          #
          # create an object without calling init
          #
          #set obj [[$origin info class] create $dest -noinit]
          set obj [::nsf::object::alloc [$origin info class] $dest]
          #nsf::object::property $obj initialized 1
          #puts stderr "COPY obj=<$obj>"
        }
      }

    # copy class information
    if {[::nsf::is class $origin]} {
        # obj is a class, copy class specific information
      ::nsf::relation::set $obj superclass [$origin ::nsf::methods::class::info::superclass]
      ::nsf::method::assertion $obj class-invar [::nsf::method::assertion $origin class-invar]
        ::nsf::relation::set $obj class-filter [::nsf::relation::get $origin class-filter]
        ::nsf::relation::set $obj class-mixin [::nsf::relation::get $origin class-mixin]
        ::nsf::nscopyvars ::nsf::classes$origin ::nsf::classes$dest

        foreach m [$origin ::nsf::methods::class::info::methods -path -callprotection all] {
          set rest [lassign [$origin ::nsf::methods::class::info::method definition $m] . protection what .]

          # remove -returns from reported definitions
          set p [lsearch -exact $rest -returns]
        if {$p > -1} {set rest [lreplace $rest $p $p+1]}

        set pathData  [$obj eval [list :__resolve_method_path $m]]
        set object    [dict get $pathData object]

        #
        # Create a copy of the instance method and set the method
        # properties with separate primitive commands.
        #
          set r [::nsf::method::$cmdMap($what) $object [dict get $pathData methodName] {*}$rest]

          ::nsf::method::property $object $r returns [$origin ::nsf::methods::class::info::method returns $m]
          ::nsf::method::property $object $r call-protected [::nsf::method::property $origin $m call-protected]
          ::nsf::method::property $object $r call-private [::nsf::method::property $origin $m call-private]
        }
      }

      # copy object -> might be a class obj
      ::nsf::object::property $obj keepcallerself [::nsf::object::property $origin keepcallerself]
      ::nsf::object::property $obj perobjectdispatch [::nsf::object::property $origin perobjectdispatch]
      ::nsf::object::property $obj hasperobjectslots [::nsf::object::property $origin hasperobjectslots]
      ::nsf::method::assertion $obj check [::nsf::method::assertion $origin check]
      ::nsf::method::assertion $obj object-invar [::nsf::method::assertion $origin object-invar]
      ::nsf::relation::set $obj object-filter [::nsf::relation::get $origin object-filter]
      ::nsf::relation::set $obj object-mixin [::nsf::relation::get $origin object-mixin]
      # reused in XOTcl, no "require namespace" there, so use nsf primitiva
      if {[::nsf::directdispatch $origin ::nsf::methods::object::info::hasnamespace]} {
        ::nsf::directdispatch $obj ::nsf::methods::object::requirenamespace
      }
    } else {
      namespace eval $dest {}
    }
    lappend objs $obj
    ::nsf::nscopyvars $origin $dest

    foreach m [$origin ::nsf::methods::object::info::methods -path -callprotection all] {
      set rest [lassign [$origin ::nsf::methods::object::info::method definition $m] . protection . what .]

      # remove -returns from reported definitions
      set p [lsearch -exact $rest -returns];
    if {$p > -1} {set rest [lreplace $rest $p $p+1]}

    set pathData  [$obj eval [list :__resolve_method_path -per-object $m]]
    set object    [dict get $pathData object]

    #
    # Create a copy of the object method and set the method
    # properties with separate primitive commands.
    #
      set r [::nsf::method::$cmdMap($what) $object -per-object  [dict get $pathData methodName] {*}$rest]
      ::nsf::method::property $object -per-object $r  returns [$origin ::nsf::methods::object::info::method returns $m]
      ::nsf::method::property $object -per-object $r  call-protected [::nsf::method::property $origin -per-object $m call-protected]
      ::nsf::method::property $object -per-object $r  call-private [::nsf::method::property $origin -per-object $m call-private]
    }

    #
    # transfer the traces
    #
    foreach var [$origin info vars] {
      set cmds [::nsf::directdispatch $origin -frame object ::trace info variable $var]
      #puts stderr "COPY $var <$cmds>"
      if {$cmds ne ""} {
        foreach cmd $cmds {
          lassign $cmd op def
          #$origin trace remove variable $var $op $def
          set domain [lindex $def 0]
          if {$domain eq $origin} {
        set def [concat $dest [lrange $def 1 end]]
          }
          #puts stderr "COPY $var domain $domain [::nsf::object::exists $domain] && [$domain info has type ::nx::Slot]"
          #if {[::nsf::object::exists $domain] && [$domain info has type ::nx::Slot]} {
        # slot traces are handled already by the slot mechanism
        #continue
          #}
          #
          # handle the most common cases to replace $origin by $dest in trace command
          #
          if {[lindex $def 2] eq $origin} {
        set def [lreplace $def 2 2 $dest]
          } elseif {[lindex $def 0] eq $origin} {
        set def [lreplace $def 0 0 $dest]
          }
          ::nsf::directdispatch $dest -frame object ::trace add variable $var $op $def
        }
      }
    }
}

#
# alter 'domain' and 'manager' in slot objects
#
foreach origin [set :targetList] {
    set dest [:getDest $origin]
    set slots [list]
    #
    # get class specific slots
    #
    if {[::nsf::is class $origin]} {
      set slots [$origin ::nsf::methods::class::info::slotobjects -type ::nx::Slot]
    }
    #
    # append object specific slots
    #
    foreach slot [$origin ::nsf::methods::object::info::slotobjects -type ::nx::Slot] {
      lappend slots $slot
    }

    #puts stderr "replacing domain and manager from <$origin> to <$dest> in slots <$slots>"
    foreach oldslot $slots {
      set container [expr {[$oldslot cget -per-object] ? "per-object-slot" : "slot"}]
      set newslot [::nx::slotObj -container $container $dest [namespace tail $oldslot]]
      if {[$oldslot cget -domain] eq $origin}   {$newslot configure -domain $dest}
      if {[$oldslot cget -manager] eq $oldslot} {$newslot configure -manager $newslot}
      $newslot eval :init
    }
}
return [lindex $objs 0]

  • dest (forward)

  • getDest (scripted)
    

    if {${:dest} eq ""} {
    return ""
} else {
    set tail [string range $origin [set :objLength] end]
    return ::[string trimleft [set :dest]$tail :]
}
  • makeTargetList (scripted)
    

    if {[::nsf::is object,type=::nx::EnsembleObject $t]} {
    #
    # we do not copy ensemble objects, since method
    # introspection/recreation will care about these
    #
    return
}
lappend :targetList $t
#puts stderr "COPY makeTargetList $t targetList '${:targetList}'"
# if it is an object without namespace, it is a leaf
if {[::nsf::object::exists $t]} {
    if {[::nsf::directdispatch $t ::nsf::methods::object::info::hasnamespace]} {
      # make target list from all children
      set children [$t info children]
  } else {
      # ok, no namespace -> no more children
      return
  }
}
# now append all namespaces that are in the obj, but that
# are not objects
foreach c [namespace children $t] {
  if {![::nsf::object::exists $c]} {
    lappend children [namespace children $t]
  }
}

# a namespace or an obj with namespace may have children
# itself
foreach c $children {
  :makeTargetList $c
}
  • objLength (forward)
    

  • targetList (forward)