Index: library/lib/doc-tools.tcl
===================================================================
diff -u -r6166d76909482a0a4c1296cb959462d71c688922 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision 6166d76909482a0a4c1296cb959462d71c688922)
+++ library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -108,8 +108,8 @@
# comment blocks.
:method behind? {error_msg} {
- return [expr {[::nx::core::is $error_msg object] && \
- [::nx::core::is $error_msg type [current]]}]
+ return [expr {[::nsf::is $error_msg object] && \
+ [::nsf::is $error_msg type [current]]}]
}
# @method thrown_by?
@@ -222,7 +222,7 @@
# @return The identifier of the newly generated or resolved entity object
# @see {{@method id}}
namespace eval $id {}
- if {[::nx::core::objectproperty $id object]} {
+ if {[::nsf::objectproperty $id object]} {
$id configure {*}$args
} else {
:create $id {*}$args
@@ -302,8 +302,8 @@
:method require_part {domain prop value} {
if {[info exists :part_class]} {
- if {[::nx::core::is $value object] && \
- [::nx::core::is $value type ${:part_class}]} {
+ if {[::nsf::is $value object] && \
+ [::nsf::is $value type ${:part_class}]} {
return $value
}
return [${:part_class} new \
@@ -369,9 +369,9 @@
if {$use ne ""} {
foreach thing {@command @object} {
set docobj [$thing id $use]
- if {[::nx::core::objectproperty $docobj object]} break
+ if {[::nsf::objectproperty $docobj object]} break
}
- if {[::nx::core::objectproperty $docobj object]} {
+ if {[::nsf::objectproperty $docobj object]} {
if {![$docobj eval [list info exists :$what]]} {error "no attribute $what in $docobj"}
set names [list]
foreach v [$docobj $what] {
@@ -501,7 +501,7 @@
# requested (from the part_attribute) applicable to the
# partof object, which is the object behind [$domain name]?
if {[info exists :scope] &&
- ![::nx::core::objectproperty [$domain name] ${:scope}]} {
+ ![::nsf::objectproperty [$domain name] ${:scope}]} {
error "The object '[$domain name]' does not qualify as '[$part_attribute scope]'"
}
next
@@ -518,8 +518,8 @@
if {[${:name} info is class]} {
set inherited [dict create]
foreach c [lreverse [${:name} info heritage]] {
- set entity [[::nx::core::current class] id $c]
- if {![::nx::core::is $entity object]} continue
+ set entity [[::nsf::current class] id $c]
+ if {![::nsf::is $entity object]} continue
if {[$entity eval [list info exists :${member}]]} {
dict set inherited $entity [$entity $member]
}
@@ -530,7 +530,7 @@
:method undocumented {} {
# TODO: for object methods and class methods
- if {![::nx::core::objectproperty ${:name} object]} {return ""}
+ if {![::nsf::objectproperty ${:name} object]} {return ""}
foreach m [${:name} info methods] {set available_method($m) 1}
set methods ${:@method}
if {[info exists :@param]} {set methods [concat ${:@method} ${:@param}]}
@@ -632,7 +632,7 @@
# documentaion quality check: is documentation in sync with implementation?
# TODO: make me conditional, MARKUP should be in templates
set object [${:partof} name]
- if {[::nx::core::objectproperty $object object]} {
+ if {[::nsf::objectproperty $object object]} {
if {[$object info methods ${:name}] ne ""} {
set actualParams ""
if {[$object info method type ${:name}] eq "forward"} {
@@ -643,7 +643,7 @@
break
}
}
- if {$cmd ne "" && [string match ::nx::core::* $cmd]} {
+ if {$cmd ne "" && [string match ::nsf::* $cmd]} {
# TODO: we assume here, the cmd is a primitive
# command and we intend only to handle cases from
# predefined or xotcl2. Make sure this is working
@@ -662,7 +662,7 @@
}
}
set comment "
Defined as a forwarder, can't check "
- #set handle ::nx::core::signature($object-class-${:name})
+ #set handle ::nsf::signature($object-class-${:name})
#if {[info exists $handle]} {append comment
[set $handle]}
} else {
set actualParams [$object info method parameter ${:name}]
@@ -773,7 +773,7 @@
{entity:substdefault "[current]"}
} {
# Here, we assume the -nonleaf mode being active for {{{[eval]}}}.
- set tmplscript [list subst [[::nx::core::current class] read_tmpl $template]]
+ set tmplscript [list subst [[::nsf::current class] read_tmpl $template]]
$entity eval [subst -nocommands {
$initscript
$tmplscript
@@ -798,7 +798,7 @@
return $rendered
}
:method ?var {varname args} {
- uplevel 1 [list :? -ops [list [::nx::core::current method] -] \
+ uplevel 1 [list :? -ops [list [::nsf::current method] -] \
"\[info exists $varname\]" {*}$args]
}
:method ? {
@@ -829,7 +829,7 @@
}
:method include {template} {
- uplevel 1 [list subst [[::nx::core::current class] read_tmpl $template]]
+ uplevel 1 [list subst [[::nsf::current class] read_tmpl $template]]
}
#
@@ -888,7 +888,7 @@
:method link {entity_type args} {
set id [$entity_type id {*}$args]
- if {![::nx::core::is $id object]} return;
+ if {![::nsf::is $id object]} return;
set pof ""
if {[$id info is type ::nx::doc::Part]} {
set pof "[[$id partof] name]#"
@@ -1051,7 +1051,7 @@
::nx::Object create doc {
:method log {msg} {
- puts stderr "[current]->[uplevel 1 [list ::nx::core::current method]]: $msg"
+ puts stderr "[current]->[uplevel 1 [list ::nsf::current method]]: $msg"
}
# @method process
@@ -1066,7 +1066,7 @@
#
:method process {{-noeval false} thing args} {
# 1) in-situ processing: a class object
- if {[::nx::core::objectproperty $thing object]} {
+ if {[::nsf::objectproperty $thing object]} {
if {[$thing eval {info exists :__initcmd}]} {
:analyze_initcmd @object $thing [$thing eval {set :__initcmd}]
}
@@ -1080,14 +1080,14 @@
::nx::Class create SourcingTracker {
:method create args {
set obj [next];
- #[::nx::core::current class] eval {
+ #[::nsf::current class] eval {
# if {![info exists :scripts([info script])]} {
#dict create :scripts
#dict set :scripts [info script] objects
# }
#}
#puts stderr "dict lappend :scripts([info script]) objects [current]"
- [::nx::core::current class] eval [list dict set :scripts [info script] objects \$obj _]
+ [::nsf::current class] eval [list dict set :scripts [info script] objects \$obj _]
return \$obj
}
}
@@ -1170,7 +1170,7 @@
# initcmds and method bodies.
foreach addition $additions {
# TODO: for now, we skip over pure Tcl commands and procs
- if {![::nx::core::is $addition object]} continue;
+ if {![::nsf::is $addition object]} continue;
:process [namespace origin $addition]
}
}
@@ -1267,7 +1267,7 @@
# activate the recoding of initcmds
- ::nx::core::configure keepinitcmd true
+ ::nsf::configure keepinitcmd true
}
}
@@ -1446,7 +1446,7 @@
set partof_entity [$entity_type id $qualifier]
# TODO: Also, we expect the qualifier to resolve against an
# already existing entity object? Is this intended?
- if {[::nx::core::is $partof_entity object]} {
+ if {[::nsf::is $partof_entity object]} {
return [list $nq_name $partof_entity]
}
}
@@ -1582,7 +1582,7 @@
}
:method map {line set} {
- set line [string map [[::nx::core::current class] eval [list set :markup_map($set)]] $line]
+ set line [string map [[::nsf::current class] eval [list set :markup_map($set)]] $line]
}
}
Index: library/lib/make.tcl
===================================================================
diff -u -rabac3188f00f8c9be8bd99e92598fc8b91c84fd7 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/lib/make.tcl (.../make.tcl) (revision abac3188f00f8c9be8bd99e92598fc8b91c84fd7)
+++ library/lib/make.tcl (.../make.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -22,7 +22,7 @@
}
set so [glob -nocomplain *[info sharedlibextension]]
- set version $::nx::core::version
+ set version $::nsf::version
# loading libnext into nextsh might cause problems on some systems
foreach lib [list libnext$version[info sharedlibextension] \
next$version.dll] {
Index: library/lib/test.tcl
===================================================================
diff -u -r89b5047e54e47a88a7de75d8523a07ffa5743407 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/lib/test.tcl (.../test.tcl) (revision 89b5047e54e47a88a7de75d8523a07ffa5743407)
+++ library/lib/test.tcl (.../test.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -53,7 +53,7 @@
foreach o [Object info instances -closure] {
if {[info exists pre_exist($o)]} continue
#puts "must destroy $o"
- if {[::nx::core::objectproperty $o object]} {$o destroy}
+ if {[::nsf::objectproperty $o object]} {$o destroy}
}
}
}
Index: library/nx/nx.tcl
===================================================================
diff -u
--- library/nx/nx.tcl (revision 0)
+++ library/nx/nx.tcl (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -0,0 +1,1404 @@
+package provide nx 2.0
+package require nsf
+
+namespace eval ::nx {
+ #
+ # By setting the variable bootstrap, we can check later, whether we
+ # are in bootstrapping mode
+ #
+ set bootstrap 1
+
+ #
+ # First create the ::nx object system.
+ #
+ ::nsf::createobjectsystem ::nx::Object ::nx::Class {
+ -class.alloc alloc
+ -class.create create
+ -class.dealloc dealloc
+ -class.recreate recreate
+ -class.requireobject __unknown
+ -object.configure configure
+ -object.defaultmethod defaultmethod
+ -object.destroy destroy
+ -object.init init
+ -object.move move
+ -object.objectparameter objectparameter
+ -object.residualargs residualargs
+ -object.unknown unknown
+ }
+
+ #
+ # get frequenly used primitiva from the next scripting framework
+ #
+ namespace import ::nsf::next ::nsf::current
+
+ #
+ # provide the standard command set for ::nx::Object
+ #
+ foreach cmd [info command ::nsf::cmd::Object::*] {
+ set cmdName [namespace tail $cmd]
+ if {$cmdName in [list "exists" "instvar"]} continue
+ ::nsf::alias Object $cmdName $cmd
+ }
+
+ # provide ::eval as method for ::nx::Object
+ ::nsf::alias Object eval -nonleaf ::eval
+
+ # provide the standard command set for Class
+ foreach cmd [info command ::nsf::cmd::Class::*] {
+ set cmdName [namespace tail $cmd]
+ ::nsf::alias Class $cmdName $cmd
+ }
+
+ # set a few aliases as protected
+ # "__next", if defined, should be added as well
+ foreach cmd [list cleanup noinit residualargs uplevel upvar] {
+ ::nsf::methodproperty Object $cmd protected 1
+ }
+
+ foreach cmd [list recreate] {
+ ::nsf::methodproperty Class $cmd protected 1
+ }
+ # TODO: info methods shows finally "slots" and "slot". Wanted?
+
+ # protect some methods against redefinition
+ ::nsf::methodproperty Object destroy redefine-protected true
+ ::nsf::methodproperty Class alloc redefine-protected true
+ ::nsf::methodproperty Class dealloc redefine-protected true
+ ::nsf::methodproperty Class create redefine-protected true
+
+ # define method "method" for Class and Object
+
+ # @method ::nx::Class#method
+ #
+ # Defines a per-class method, similarly to Tcl specifying
+ # {{{procs}}}. Optionally assertions may be specified by two
+ # additional arguments. Therefore, to specify only post-assertions
+ # an empty pre-assertion list must be given. All assertions are a
+ # list of ordinary Tcl {{{expr}}} statements. When {{{method}}} is
+ # called with an empty argument list and an empty body, the
+ # specified method is deleted.
+ # {{{
+ # Class create AClass {
+ # :method foo args {;}
+ # }
+ #
+ # AClass create anInstance
+ # anInstance foo; # invokes "foo"
+ # }}}
+ #
+ # @param name The method name
+ # @param arguments:list A list specifying non-positional and positional parameters
+ # @param body The script which forms the method body
+ # @param preAssertion Optional assertions that must hold before the proc executes
+ # @param postAssertion Optional assertions that must hold after the proc executes
+
+ ::nsf::method Class method {
+ name arguments body -precondition -postcondition
+ } {
+ set conditions [list]
+ if {[info exists precondition]} {lappend conditions -precondition $precondition}
+ if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
+ ::nsf::method [::nsf::current object] $name $arguments $body {*}$conditions
+ }
+
+ # @method ::nx::Object#method
+ #
+ # Defines a per-object method, similarly to Tcl specifying
+ # {{{procs}}}. Optionally assertions may be specified by two
+ # additional arguments. Therefore, to specify only post-assertions
+ # an empty pre-assertion list must be given. All assertions are a
+ # list of ordinary Tcl {{{expr}}} statements. When {{{method}}} is
+ # called with an empty argument list and an empty body, the
+ # specified method is deleted.
+ # {{{
+ # Object create anObject {
+ # :method foo args {;}
+ # }
+ # anObject foo; # invokes "foo"
+ # }}}
+ #
+ # @param name The method name
+ # @param arguments:list A list specifying non-positional and positional parameters
+ # @param body The script which forms the method body
+ # @param preAssertion Optional assertions that must hold before the proc executes
+ # @param postAssertion Optional assertions that must hold after the proc executes
+ ::nsf::method Object method {
+ name arguments body -precondition -postcondition
+ } {
+ set conditions [list]
+ if {[info exists precondition]} {lappend conditions -precondition $precondition}
+ if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
+ ::nsf::method [::nsf::current object] -per-object $name $arguments $body {*}$conditions
+ }
+
+ # define method modifiers "object", "public" and "protected"
+ Class eval {
+
+ # method-modifier for object specific methos
+ :method object {what args} {
+ if {$what in [list "alias" "attribute" "forward" "method" "setter"]} {
+ return [::nsf::dispatch [::nsf::current object] ::nsf::classes::nx::Object::$what {*}$args]
+ }
+ if {$what in [list "info"]} {
+ return [::nx::objectInfo [lindex $args 0] [::nsf::current object] {*}[lrange $args 1 end]]
+ }
+ if {$what in [list "filter" "mixin"]} {
+ return [:object-$what {*}$args]
+ }
+ if {$what in [list "filterguard" "mixinguard"]} {
+ return [::nsf::dispatch [::nsf::current object] ::nsf::cmd::Object::$what {*}$args]
+ }
+ }
+
+ # define unknown handler for class
+ :method unknown {m args} {
+ error "Method '$m' unknown for [::nsf::current object].\
+ Consider '[::nsf::current object] create $m $args' instead of '[::nsf::current object] $m $args'"
+ }
+ # protected is not jet defined
+ ::nsf::methodproperty [::nsf::current object] unknown protected 1
+ }
+
+ Object eval {
+
+ # method modifier "public"
+ :method public {args} {
+ set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}]
+ if {$p == -1} {error "$args is not a method defining method"}
+ set r [{*}:$args]
+ ::nsf::methodproperty [::nsf::current object] $r protected false
+ return $r
+ }
+
+ # method modifier "protected"
+ :method protected {args} {
+ set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}]
+ if {$p == -1} {error "$args is not a method defining command"}
+ set r [{*}:$args]
+ ::nsf::methodproperty [::nsf::current object] $r [::nsf::current method] true
+ return $r
+ }
+
+ # unknown handler for Object
+ :protected method unknown {m args} {
+ if {![::nsf::current isnext]} {
+ error "[::nsf::current object]: unable to dispatch method '$m'"
+ }
+ }
+
+ # "init" must exist on Object. per default it is empty.
+ :protected method init args {}
+
+ # this method is called on calls to object without a specified method
+ :protected method defaultmethod {} {::nsf::current object}
+
+ # provide a placeholder for the bootup process. The real definition
+ # is based on slots, which are not available at this point.
+ :protected method objectparameter {} {;}
+ }
+
+ # define forward methods
+
+ # @method ::nx::Object#forward
+ #
+ # Register a per-object method (similar to a {{{proc}}}) for
+ # forward-delegating calls to a callee (target Tcl command, other
+ # object). When the forwarder method is called, the actual arguments
+ # of the invocation are appended to the specified arguments. In
+ # callee an arguments certain substitutions can take place:
+ #
+ # {{{%proc}}} substituted by name of the forwarder method
+ #
+ # {{{%self}}} substitute by name of the object
+ #
+ # {{{%1}}} substitute by first argument of the invocation
+ #
+ # {{{ {%@POS value} }}} substitute the specified value in the
+ # argument list on position POS, where POS can be a positive or
+ # negative integer or end. Positive integers specify the position
+ # from the begin of the list, while negative integer specify the
+ # position from the end.
+ #
+ # {{{ {%argclindex LIST} }}} take the nth argument of the specified
+ # list as substitution value, where n is the number of arguments
+ # from the invocation.
+ #
+ # {{{%%}}} a single percent.
+ #
+ # {{{%Tcl-command}}} command to be executed; substituted by result.
+ #
+ # Additionally each argument can be prefixed by the positional prefix
+ # %@POS (note the delimiting space at the end) that can be used to
+ # specify an explicit position. POS can be a positive or negative
+ # integer or the word end. The positional arguments are evaluated from
+ # left to right and should be used in ascending order.
+ #
+ # @param name The name of the delegating or forward method
+ # @param -objscope:optional Causes the target to be evaluated in the scope of the object.
+ # @param -methodprefix Prepends the specified prefix to the second argument of the invocation.
+ # @param -default Is used for default method names (only in connection with %1)
+ # @param -earlybinding Look up the function pointer of the called Tcl command at definition time of the forwarder instead of invocation time. This option should only be used for calling C-implemented Tcl commands, no scripted procs
+ # @param -verbose Print the substituted command to stderr before executing
+ # @param callee
+ # @param args
+ ::nsf::forward Object forward ::nsf::forward %self -per-object
+ #set ::nsf::signature(::nx::Object-method-forward) {(methodName) obj forward name ?-default default? ?-earlybinding? ?-methodprefix name? ?-objscope? ?-onerror proc? ?-verbose? target ?args?}
+
+ # @method ::nx::Class#forward
+ #
+ # Register a per-class method (similar to a {{{proc}}}) for
+ # forward-delegating calls to a callee (target Tcl command, other
+ # object). When the forwarder method is called on an instance of the
+ # class, the actual arguments of the invocation are appended to the
+ # specified arguments. In callee an arguments certain substitutions
+ # can take place:
+ #
+ # {{{%proc}}} substituted by name of the forwarder method
+ #
+ # {{{%self}}} substitute by name of the object
+ #
+ # {{{%1}}} substitute by first argument of the invocation
+ #
+ # {{{ {%@POS value} }}} substitute the specified value in the
+ # argument list on position POS, where POS can be a positive or
+ # negative integer or end. Positive integers specify the position
+ # from the begin of the list, while negative integer specify the
+ # position from the end.
+ #
+ # {{{ {%argclindex LIST} }}} take the nth argument of the specified
+ # list as substitution value, where n is the number of arguments
+ # from the invocation.
+ #
+ # {{{%%}}} a single percent.
+ #
+ # {{{%Tcl-command}}} command to be executed; substituted by result.
+ #
+ # Additionally each argument can be prefixed by the positional prefix
+ # %@POS (note the delimiting space at the end) that can be used to
+ # specify an explicit position. POS can be a positive or negative
+ # integer or the word end. The positional arguments are evaluated from
+ # left to right and should be used in ascending order.
+ #
+ # @param name The name of the delegating or forward method
+ # @param -objscope:optional Causes the target to be evaluated in the scope of the object.
+ # @param -methodprefix Prepends the specified prefix to the second argument of the invocation.
+ # @param -default Is used for default method names (only in connection with %1)
+ # @param -earlybinding Look up the function pointer of the called Tcl command at definition time of the forwarder instead of invocation time. This option should only be used for calling C-implemented Tcl commands, no scripted procs
+ # @param -verbose Print the substituted command to stderr before executing
+ # @param callee
+ # @param args
+ ::nsf::forward Class forward ::nsf::forward %self
+
+ # The method __unknown is called in cases, where we try to resolve
+ # an unkown class. one could define a custom resolver with this name
+ # to load the class on the fly. After the call to __unknown, XOTcl
+ # tries to resolve the class again. This meachnism is used e.g. by
+ # the ::ttrace mechanism for partial loading by Zoran.
+ #
+ Class protected object method __unknown {name} {}
+
+ # Add alias methods. cmdName for XOTcl method can be added via
+ # [... info method name
]
+ #
+ # -nonleaf and -objscope make only sense for c-defined cmds,
+ # -objscope implies -nonleaf
+ #
+ Object public method alias {-nonleaf:switch -objscope:switch methodName cmd} {
+ ::nsf::alias [::nsf::current object] -per-object $methodName \
+ {*}[expr {${objscope} ? "-objscope" : ""}] \
+ {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \
+ $cmd
+ }
+ Class public method alias {-nonleaf:switch -objscope:switch methodName cmd} {
+ ::nsf::alias [::nsf::current object] $methodName \
+ {*}[expr {${objscope} ? "-objscope" : ""}] \
+ {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \
+ $cmd
+ }
+
+ # Add setter methods.
+ #
+ Object public method setter {methodName} {
+ ::nsf::setter [::nsf::current object] -per-object $methodName
+ }
+ Class public method setter {methodName} {
+ ::nsf::setter [::nsf::current object] $methodName
+ }
+
+ ########################
+ # Info definition
+ ########################
+ Object create ::nx::objectInfo
+ Object create ::nx::classInfo
+
+ #
+ # It would be nice to do here "objectInfo configure {alias ..}", but
+ # we have no working objectparameter yet due to bootstrapping
+ #
+ objectInfo eval {
+ :alias is ::nsf::objectproperty
+
+ # info info
+ :public method info {obj} {
+ set methods [list]
+ foreach name [::nsf::cmd::ObjectInfo::methods [::nsf::current object]] {
+ if {$name eq "unknown"} continue
+ lappend methods $name
+ }
+ return "valid options are: [join [lsort $methods] {, }]"
+ }
+
+ :method unknown {method obj args} {
+ error "[::nsf::current object] unknown info option \"$method\"; [$obj info info]"
+ }
+ }
+
+ classInfo eval {
+ :alias is ::nsf::objectproperty
+ :alias classparent ::nsf::cmd::ObjectInfo::parent
+ :alias classchildren ::nsf::cmd::ObjectInfo::children
+ :alias info [::nsf::cmd::ObjectInfo::method objectInfo name info]
+ :alias unknown [::nsf::cmd::ObjectInfo::method objectInfo name info]
+ }
+
+ foreach cmd [info command ::nsf::cmd::ObjectInfo::*] {
+ ::nsf::alias ::nx::objectInfo [namespace tail $cmd] $cmd
+ ::nsf::alias ::nx::classInfo [namespace tail $cmd] $cmd
+ }
+ foreach cmd [info command ::nsf::cmd::ClassInfo::*] {
+ set cmdName [namespace tail $cmd]
+ if {$cmdName in [list "object-mixin-of" "class-mixin-of"]} continue
+ ::nsf::alias ::nx::classInfo $cmdName $cmd
+ }
+ unset cmd
+
+ # register method "info" on Object and Class
+ Object forward info -onerror ::nsf::infoError ::nx::objectInfo %1 {%@2 %self}
+ Class forward info -onerror ::nsf::infoError ::nx::classInfo %1 {%@2 %self}
+
+ #
+ # definition of "abstract method foo ...."
+ #
+ Object method abstract {methtype -per-object:switch methname arglist} {
+ if {$methtype ne "method"} {
+ error "invalid method type '$methtype', must be 'method'"
+ }
+ set body "
+ if {!\[::nsf::current isnextcall\]} {
+ error \"Abstract method $methname $arglist called\"
+ } else {::nsf::next}
+ "
+ if {${per-object}} {
+ :method -per-object $methname $arglist $body
+ } else {
+ :method $methname $arglist $body
+ }
+ }
+
+
+ ########################################
+ # Slot definitions
+ ########################################
+
+ #
+ # We are in bootstrap code; we cannot use slots/parameter to define
+ # slots, so the code is a little low level. After the defintion of
+ # the slots, we can use slot-based code such as "-parameter" or
+ # "objectparameter".
+ #
+ Class create ::nx::MetaSlot
+ ::nsf::relation MetaSlot superclass Class
+
+ MetaSlot public method slotName {name baseObject} {
+ # Create slot parent object if needed
+ set slotParent ${baseObject}::slot
+ if {![::nsf::objectproperty ${slotParent} object]} {
+ ::nx::Object create ${slotParent}
+ }
+ return ${slotParent}::$name
+ }
+
+ MetaSlot method createFromParameterSyntax {
+ target -per-object:switch
+ {-initblock ""}
+ value default:optional
+ } {
+ set opts [list]
+ set colonPos [string first : $value]
+ if {$colonPos == -1} {
+ set name $value
+ } else {
+ set properties [string range $value [expr {$colonPos+1}] end]
+ set name [string range $value 0 [expr {$colonPos -1}]]
+ foreach property [split $properties ,] {
+ if {$property eq "required"} {
+ lappend opts -required 1
+ } elseif {$property eq "multivalued"} {
+ lappend opts -multivalued 1
+ } elseif {[string match type=* $property]} {
+ set type [string range $property 5 end]
+ if {![string match ::* $type]} {set type ::$type}
+ } elseif {[string match arg=* $property]} {
+ set argument [string range $property 4 end]
+ lappend opts -arg $argument
+ } else {
+ set type $property
+ }
+ }
+ }
+ if {[info exists type]} {
+ lappend opts -type $type
+ }
+
+ if {[info exists default]} {
+ lappend opts -default $default
+ }
+ if {${per-object}} {
+ lappend opts -per-object true
+ set info ObjectInfo
+ } else {
+ set info ClassInfo
+ }
+
+ :create [:slotName $name $target] {*}$opts $initblock
+ return [::nsf::cmd::${info}::method $target name $name]
+ }
+
+}
+namespace eval ::nx {
+
+ # @object ::nx::Slot
+ #
+ # A slot is a meta-object that manages property changes of
+ # objects. A property is either an attribute or a role taken by an
+ # object in an inter-object relation (e.g., in system slots). The
+ # predefined system slots are {{{class}}}, {{{superclass}}},
+ # {{{mixin}}}, and {{{filter}}}. These slots appear as methods of
+ # {{@object ::nx::Object}} or {{@object ::nx::Class}}. The slots
+ # provide a common getter and setter interface. Every multivalued
+ # slot provides e.g. a method {{{add}}} to append a value to the
+ # list of values, and a method {{{delete}}} which removes it.
+ #
+ # @superclass ::nx::doc::entities::object::nx::Object
+ MetaSlot create ::nx::Slot
+
+ # @object ::nx::ObjectParameterSlot
+ #
+ # @superclass ::nx::doc::entities::object::nx::Slot
+
+ MetaSlot create ::nx::ObjectParameterSlot
+ ::nsf::relation ObjectParameterSlot superclass Slot
+
+ MetaSlot create ::nx::MethodParameterSlot
+ ::nsf::relation MethodParameterSlot superclass Slot
+
+ # create an object for dispatching
+ MethodParameterSlot create ::nx::methodParameterSlot
+
+ # use low level interface for defining slot values. Normally, this is
+ # done via slot objects, which are defined later.
+
+ proc createBootstrapAttributeSlots {class definitions} {
+ foreach att $definitions {
+ if {[llength $att]>1} {foreach {att default} $att break}
+ set slotObj [::nx::ObjectParameterSlot slotName $att $class]
+ ::nx::ObjectParameterSlot create $slotObj
+ if {[info exists default]} {
+ ::nsf::setvar $slotObj default $default
+ unset default
+ }
+ ::nsf::setter $class $att
+ }
+
+ #
+ # Perform a second round to set default values for already defined
+ # objects.
+ #
+ foreach att $definitions {
+ if {[llength $att]>1} {foreach {att default} $att break}
+ if {[info exists default]} {
+
+ # checking subclasses is not required during bootstrap
+ foreach i [::nsf::cmd::ClassInfo::instances $class] {
+ if {![::nsf::existsvar $i $att]} {
+ if {[string match {*\[*\]*} $default]} {
+ set value [::nsf::dispatch $i -objscope ::eval subst $default]
+ } else {
+ set value $default
+ }
+ ::nsf::setvar $i $att $value
+ }
+ }
+ unset default
+ }
+ }
+
+ #puts stderr "Bootstrapslot for $class calls __invalidateobjectparameter"
+ $class __invalidateobjectparameter
+ }
+
+ ############################################
+ # Define slots for slots
+ ############################################
+
+ # @param ::nx::Slot#name
+ #
+ # Name of the slot which can be used to access the slot from an object
+
+ # @param ::nx::Slot#multivalued
+ #
+ # Boolean value for specifying single or multiple values (lists)
+
+ # @param ::nx::Slot#required
+ #
+ # Denotes whether a value must be provided
+
+ # @param ::nx::Slot#default
+ #
+ # Allows you to define a default value (to be set upon object creation)
+
+ # @param ::nx::Slot#type
+ #
+ # You may specify a type constraint on the value range to managed by the slot
+
+ createBootstrapAttributeSlots ::nx::Slot {
+ {name}
+ {multivalued false}
+ {required false}
+ default
+ type
+ }
+
+ # @param ::nx::ObjectParameterSlot#name
+ #
+ # Name of the slot which can be used to access the slot from an
+ # object. It defaults to unqualified name of an instance.
+
+ # @param ::nx::ObjectParameterSlot#methodname
+ #
+ # The name of the accessor methods to be registed on behalf of the
+ # slot object with its domains can vary from the slot name.
+
+ # @param ::nx::ObjectParameterSlot#domain
+ #
+ # The domain (object or class) of a slot on which it can be used
+
+ # @param ::nx::ObjectParameterSlot#defaultmethods
+ #
+ # A list of two elements for specifying which methods are called per
+ # default, when no slot method is explicitly specified in a call.
+
+ # @param ::nx::ObjectParameterSlot#manager
+ #
+ # The manager object of the slot (per default, the slot object takes
+ # this role, i.e. {{{[self]}}})
+
+ # @param ::nx::ObjectParameterSlot#per-object
+ #
+ # If set to {{{true}}}, the accessor methods are registered with the
+ # domain object scope only. It defaults to {{{false}}}.
+
+ createBootstrapAttributeSlots ::nx::ObjectParameterSlot {
+ {name "[namespace tail [::nsf::current object]]"}
+ {methodname}
+ {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::nsf::current object]] 1]"}
+ {defaultmethods {get assign}}
+ {manager "[::nsf::current object]"}
+ {per-object false}
+ }
+
+ # maybe add the following slots at some later time here
+ # initcmd
+ # valuecmd
+ # valuechangedcmd
+
+ ::nsf::alias ObjectParameterSlot get ::nsf::setvar
+ ::nsf::alias ObjectParameterSlot assign ::nsf::setvar
+
+ ObjectParameterSlot public method add {obj prop value {pos 0}} {
+ if {![set :multivalued]} {
+ error "Property $prop of [set :domain]->$obj ist not multivalued"
+ }
+ if {[::nsf::existsvar $obj $prop]} {
+ ::nsf::setvar $obj $prop [linsert [::nsf::setvar $obj $prop] $pos $value]
+ } else {
+ ::nsf::setvar $obj $prop [list $value]
+ }
+ }
+
+ ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} {
+ set old [::nsf::setvar $obj $prop]
+ set p [lsearch -glob $old $value]
+ if {$p>-1} {::nsf::setvar $obj $prop [lreplace $old $p $p]} else {
+ error "$value is not a $prop of $obj (valid are: $old)"
+ }
+ }
+
+ ObjectParameterSlot method unknown {method args} {
+ set methods [list]
+ foreach m [:info callable] {
+ if {[Object info callable $m] ne ""} continue
+ if {[string match __* $m]} continue
+ lappend methods $m
+ }
+ error "Method '$method' unknown for slot [::nsf::current object]; valid are: {[lsort $methods]}"
+ }
+
+ ObjectParameterSlot public method destroy {} {
+ if {${:domain} ne "" && [::nsf::objectproperty ${:domain} class]} {
+ ${:domain} __invalidateobjectparameter
+ }
+ ::nsf::next
+ }
+
+ ObjectParameterSlot protected method init {args} {
+ if {${:domain} eq ""} {
+ set :domain [::nsf::current callingobject]
+ }
+ if {${:domain} ne ""} {
+ if {![info exists :methodname]} {
+ set :methodname ${:name}
+ }
+ if {[::nsf::objectproperty ${:domain} class]} {
+ ${:domain} __invalidateobjectparameter
+ }
+ if {${:per-object} && [info exists :default] } {
+ ::nsf::setvar ${:domain} ${:name} ${:default}
+ }
+ set cl [expr {${:per-object} ? "Object" : "Class"}]
+ #puts stderr "Slot [::nsf::current object] init, forwarder on ${:domain}"
+ ::nsf::forward ${:domain} ${:name} \
+ ${:manager} \
+ [list %1 [${:manager} defaultmethods]] %self \
+ ${:methodname}
+ }
+ }
+
+ #################################################################
+ # We have no working objectparameter yet, since it requires a
+ # minimal slot infrastructure to build object parameters from
+ # slots. The above definitions should be sufficient. We provide the
+ # definition here before we refine the slot definitions.
+ #
+ # Invalidate previously defined object parameter.
+
+ MetaSlot __invalidateobjectparameter
+
+ # Provide the a slot based mechanism for building an object
+ # configuration interface from slot definitions
+
+ ObjectParameterSlot method toParameterSyntax {{name:substdefault ${:name}}} {
+ set objparamdefinition $name
+ set methodparamdefinition ""
+ set objopts [list]
+ set methodopts [list]
+ set type ""
+ if {[info exists :required] && ${:required}} {
+ lappend objopts required
+ lappend methodopts required
+ }
+ if {[info exists :type]} {
+ if {[string match ::* ${:type}]} {
+ set type [expr {[::nsf::objectproperty ${:type} metaclass] ? "class" : "object"}]
+ lappend objopts type=${:type}
+ lappend methodopts type=${:type}
+ } else {
+ set type ${:type}
+ }
+ }
+ # TODO: remove multivalued check on relations by handling multivalued
+ # not in relation, but in the converters
+ if {[info exists :multivalued] && ${:multivalued}} {
+ if {!([info exists :type] && ${:type} eq "relation")} {
+ lappend objopts multivalued
+ } else {
+ #puts stderr "ignore multivalued for $name in relation"
+ }
+ }
+ if {[info exists :arg]} {
+ set prefix [expr {$type eq "object" || $type eq "class" ? "type" : "arg"}]
+ lappend objopts $prefix=${:arg}
+ lappend methodopts $prefix=${:arg}
+ }
+ if {[info exists :default]} {
+ set arg ${:default}
+ # deactivated for now: || [string first {$} $arg] > -1
+ if {[string match {*\[*\]*} $arg]
+ && $type ne "substdefault"} {
+ lappend objopts substdefault
+ }
+ } elseif {[info exists :initcmd]} {
+ set arg ${:initcmd}
+ lappend objopts initcmd
+ }
+ if {[info exists :methodname]} {
+ if {${:methodname} ne ${:name}} {
+ lappend objopts arg=${:methodname}
+ lappend methodopts arg=${:methodname}
+ #puts stderr "..... setting arg for methodname: [::nsf::current object] has arg arg=${:methodname}"
+ }
+ }
+ if {$type ne ""} {
+ set objopts [linsert $objopts 0 $type]
+ # Never add "substdefault" to methodopts, since these are for
+ # provided values, not for defaults.
+ if {$type ne "substdefault"} {set methodopts [linsert $methodopts 0 $type]}
+ }
+ lappend objopts slot=[::nsf::current object]
+
+ if {[llength $objopts] > 0} {
+ append objparamdefinition :[join $objopts ,]
+ }
+ if {[llength $methodopts] > 0} {
+ set methodparamdefinition [join $methodopts ,]
+ }
+ if {[info exists arg]} {
+ lappend objparamdefinition $arg
+ }
+ #puts stderr "[::nsf::current method] ${name} returns [list oparam $objparamdefinition mparam $methodparamdefinition]"
+ return [list oparam $objparamdefinition mparam $methodparamdefinition]
+ }
+
+ proc ::nsf::parametersFromSlots {obj} {
+ set parameterdefinitions [list]
+ foreach slot [::nx::objectInfo slotobjects $obj] {
+ # Skip some slots for xotcl;
+ # TODO: maybe different parameterFromSlots for xotcl?
+ if {[::nsf::objectproperty ::xotcl::Object class]
+ && [::nsf::objectproperty $obj type ::xotcl::Object] &&
+ ([$slot name] eq "mixin" || [$slot name] eq "filter")
+ } continue
+ array set "" [$slot toParameterSyntax]
+ lappend parameterdefinitions -$(oparam)
+ }
+ return $parameterdefinitions
+ }
+
+ # @method ::nx::Object#objectparameter
+ Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} {
+ #puts stderr "... objectparameter [::nsf::current object]"
+ set parameterdefinitions [::nsf::parametersFromSlots [::nsf::current object]]
+ if {[::nsf::objectproperty [::nsf::current object] class]} {
+ lappend parameterdefinitions -parameter:method,optional
+ }
+ lappend parameterdefinitions \
+ -noinit:method,optional,noarg \
+ -volatile:method,optional,noarg \
+ {*}$lastparameter
+ #puts stderr "*** parameter definition for [::nsf::current object]: $parameterdefinitions"
+ return $parameterdefinitions
+ }
+
+}
+namespace eval ::nx {
+ ############################################
+ # RelationSlot
+ ############################################
+ MetaSlot create ::nx::RelationSlot
+ createBootstrapAttributeSlots ::nx::RelationSlot {
+ {multivalued true}
+ {type relation}
+ {elementtype ::nx::Class}
+ }
+
+ ::nsf::relation RelationSlot superclass ObjectParameterSlot
+ ::nsf::alias RelationSlot assign ::nsf::relation
+
+
+ RelationSlot protected method init {} {
+ if {${:type} ne "relation"} {
+ error "RelationSlot requires type == \"relation\""
+ }
+ ::nsf::next
+ }
+
+ RelationSlot protected method delete_value {obj prop old value} {
+ if {[string first * $value] > -1 || [string first \[ $value] > -1} {
+ # value contains globbing meta characters
+ if {${:elementtype} ne "" && ![string match ::* $value]} {
+ # prefix glob pattern with ::, since all object names have leading ::
+ set value ::$value
+ }
+ return [lsearch -all -not -glob -inline $old $value]
+ } elseif {${:elementtype} ne ""} {
+ # value contains no globbing meta characters, but elementtype is given
+ if {[string first :: $value] == -1} {
+ # get fully qualified name
+ if {![::nsf::objectproperty $value object]} {
+ error "$value does not appear to be an object"
+ }
+ set value [::nsf::dispatch $value -objscope ::nsf::current object]
+ }
+ if {![::nsf::objectproperty ${:elementtype} class]} {
+ error "$value does not appear to be of type ${:elementtype}"
+ }
+ }
+ set p [lsearch -exact $old $value]
+ if {$p > -1} {
+ return [lreplace $old $p $p]
+ } else {
+ error "$value is not a $prop of $obj (valid are: $old)"
+ }
+ }
+
+ RelationSlot public method delete {-nocomplain:switch obj prop value} {
+ #puts stderr RelationSlot-delete-[::nsf::current args]
+ $obj $prop [:delete_value $obj $prop [$obj info $prop] $value]
+ }
+
+ RelationSlot public method get {obj prop} {
+ ::nsf::relation $obj $prop
+ }
+
+ RelationSlot public method add {obj prop value {pos 0}} {
+ if {![set :multivalued]} {
+ error "Property $prop of ${:domain}->$obj ist not multivalued"
+ }
+ set oldSetting [::nsf::relation $obj $prop]
+ # use uplevel to avoid namespace surprises
+ uplevel [list ::nsf::relation $obj $prop [linsert $oldSetting $pos $value]]
+ }
+ RelationSlot public method delete {-nocomplain:switch obj prop value} {
+ uplevel [list ::nsf::relation $obj $prop [:delete_value $obj $prop [::nsf::relation $obj $prop] $value]]
+ }
+
+ ############################################
+ # system slots
+ ############################################
+ proc ::nsf::register_system_slots {os} {
+ ${os}::Object alloc ${os}::Class::slot
+ ${os}::Object alloc ${os}::Object::slot
+
+ # @param ::nx::Class#superclass
+ #
+ # Specifies superclasses for a given class. As a setter,
+ # {{{superclass}}} changes the list of superclasses. When used as
+ # a getter, the method returns the current superclasses.
+ #
+ # @return :list If called as a getter (without arguments),
+ # {{{superclass}}} returns the current superclasses of the object
+ ::nx::RelationSlot create ${os}::Class::slot::superclass
+ ::nsf::alias ${os}::Class::slot::superclass assign ::nsf::relation
+
+ # @param ::nx::Object#class
+ #
+ # Sets or retrieves the class of an object. When {{{class}}} is
+ # called without arguments, it returns the current class of the
+ # object.
+ #
+ # @return If called as a getter (without arguments), {{{class}}} returns the current class of the object
+ ::nx::RelationSlot create ${os}::Object::slot::class -multivalued false
+ ::nsf::alias ${os}::Object::slot::class assign ::nsf::relation
+
+ # @param ::nx::Object#mixin
+ #
+ # As a setter, {{{mixin}}} specifies a list of mixins to
+ # set. Every mixin must be an existing class. In getter mode, you
+ # can retrieve the list of mixins active for the given object.
+ #
+ # @return :list If called as a getter (without arguments), {{{mixin}}} returns the list of current mixin classes registered with the object
+ ::nx::RelationSlot create ${os}::Object::slot::mixin -methodname object-mixin
+
+ # @param ::nx::Object#filter
+ #
+ # In its setter mode, {{{filter}}} allows you to register methods
+ # as per-object filters. Every filter must be an existing method
+ # in the scope of the object. When acting as a getter, you can
+ # retrieve the list of filter methods active for the given object.
+ #
+ # @return :list If called as a getter (without arguments),
+ # {{{filter}}} returns the list of current filters
+ # registered with the object
+ ::nx::RelationSlot create ${os}::Object::slot::filter -elementtype ""
+
+ # @param ::nx::Class#mixin
+ #
+ # As a setter, {{{mixin}}} specifies a list of mixins to set for
+ # the class. Every mixin must be an existing class. In getter
+ # mode, you can retrieve the list of mixins active for the given
+ # class.
+ #
+ # @return :list If called as a getter (without arguments), {{{mixin}}} returns the list of current mixin classes registered with the class
+ ::nx::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin
+
+ # @param ::nx::Class#filter
+ #
+ # In its setter mode, {{{filter}}} allows you to register methods
+ # as per-class filters. Every filter must be an existing method
+ # in the scope of the class. When acting as a getter, you can
+ # retrieve the list of filter methods active for the given class.
+ #
+ # @return :list If called as a getter (without arguments),
+ # {{{filter}}} returns the list of current filters
+ # registered with the class
+ ::nx::RelationSlot create ${os}::Class::slot::filter -elementtype "" \
+ -methodname class-filter
+
+ # Create two conveniance slots to allow configuration of
+ # object-slots for classes via object-mixin
+ ::nx::RelationSlot create ${os}::Class::slot::object-mixin
+ ::nx::RelationSlot create ${os}::Class::slot::object-filter -elementtype ""
+ }
+
+ ::nsf::register_system_slots ::nx
+ proc ::nsf::register_system_slots {} {}
+
+
+ ############################################
+ # Attribute slots
+ ############################################
+ MetaSlot __invalidateobjectparameter
+
+ # @object ::nx::Attribute
+ #
+ # Attribute slots are used to manage the access, mutation, and
+ # querying of instance variables. One defines Attribute slots
+ # for objects and classes usually via the helper method
+ # {{@method ::nx::Object class attribute}}
+ # **** TODO STEFAN, kein Link? GEPLANT? MIT 2 GESCHWEIFTEN KLAMMER UM SALARY GIBT ES EINEN LAUFZEITFEHLER??? ********
+ # The following example defines a class with
+ # three attribute slots. The attribute {salary} has
+ # a default of {0}, the attribute {projects} has the
+ # empty list as default and is defined as multivalued.
+ # {{{
+ # Class create Person {
+ # :attribute name
+ # :attribute {salary:integer 0}
+ # :attribute {projects:multivalued ""} {
+ # set :incremental true
+ # }
+ # }
+ # }}}
+ #
+ # @param incremental A boolean value, only useful for multivalued slots. When set, one can add/delete incrementally values to the multivalued set (e.g., through an incremental {{{add}}})
+ # @param valuecmd A Tcl command to be executed whenever the managed object variable is read
+ # @param valuechangedcmd A Tcl command to be executed whenever the value of the managed object variable changes
+ # @param arg
+ # @superclass ::nx::doc::entities::object::nx::ObjectParameterSlot
+
+ MetaSlot create ::nx::Attribute -superclass ObjectParameterSlot
+
+ createBootstrapAttributeSlots ::nx::Attribute {
+ {value_check once}
+ incremental
+ initcmd
+ valuecmd
+ valuechangedcmd
+ arg
+ }
+
+ Attribute method __default_from_cmd {obj cmd var sub op} {
+ #puts "GETVAR [::nsf::current method] obj=$obj cmd=$cmd, var=$var, op=$op"
+ $obj trace remove variable $var $op [list [::nsf::current object] [::nsf::current method] $obj $cmd]
+ ::nsf::setvar $obj $var [$obj eval $cmd]
+ }
+ Attribute method __value_from_cmd {obj cmd var sub op} {
+ #puts "GETVAR [::nsf::current method] obj=$obj cmd=$cmd, var=$var, op=$op"
+ ::nsf::setvar $obj $var [$obj eval $cmd]
+ }
+ Attribute method __value_changed_cmd {obj cmd var sub op} {
+ # puts stderr "**************************"
+ # puts "valuechanged obj=$obj cmd=$cmd, var=$var, op=$op, ...\n$obj exists $var -> [::nsf::setvar $obj $var]"
+ eval $cmd
+ }
+ Attribute protected method init {} {
+ ::nsf::next ;# do first ordinary slot initialization
+ # there might be already default values registered on the class
+ set __initcmd ""
+ if {[info exists :default]} {
+ } elseif [info exists :initcmd] {
+ append __initcmd ":trace add variable [list ${:name}] read \
+ \[list [::nsf::current object] __default_from_cmd \[::nsf::current object\] [list [set :initcmd]]\]\n"
+ } elseif [info exists :valuecmd] {
+ append __initcmd ":trace add variable [list ${:name}] read \
+ \[list [::nsf::current object] __value_from_cmd \[::nsf::current object\] [list [set :valuecmd]]\]"
+ }
+ array set "" [:toParameterSyntax ${:name}]
+
+ #puts stderr "Attribute.init valueParam for [::nsf::current object] is $(mparam)"
+ if {$(mparam) ne ""} {
+ if {[info exists :multivalued] && ${:multivalued}} {
+ #puts stderr "adding assign [list obj var value:$(mparam),multivalued] // for [::nsf::current object] with $(mparam)"
+ :method assign [list obj var value:$(mparam),multivalued,slot=[::nsf::current object]] {
+ ::nsf::setvar $obj $var $value
+ }
+ #puts stderr "adding add method for [::nsf::current object] with value:$(mparam)"
+ :method add [list obj prop value:$(mparam),slot=[::nsf::current object] {pos 0}] {
+ ::nsf::next
+ }
+ } else {
+ #puts stderr "SV adding assign [list obj var value:$(mparam)] // for [::nsf::current object] with $(mparam)"
+ :method assign [list obj var value:$(mparam),slot=[::nsf::current object]] {
+ ::nsf::setvar $obj $var $value
+ }
+
+ }
+ }
+ if {[info exists :valuechangedcmd]} {
+ append __initcmd ":trace add variable [list ${:name}] write \
+ \[list [::nsf::current object] __value_changed_cmd \[::nsf::current object\] [list [set :valuechangedcmd]]\]"
+ }
+ if {$__initcmd ne ""} {
+ set :initcmd $__initcmd
+ }
+ }
+
+ # mixin class for optimizing slots
+ Class create ::nx::Attribute::Optimizer {
+
+ :method method args {::nsf::next; :optimize}
+ :method forward args {::nsf::next; :optimize}
+ :protected method init args {::nsf::next; :optimize}
+
+ :public method optimize {} {
+ #puts stderr OPTIMIZER-[info exists :incremental]
+ if {![info exists :methodname]} {return}
+ set object [expr {${:per-object} ? {object} : {}}]
+ if {${:per-object}} {
+ set perObject -per-object
+ set infokind Object
+ } else {
+ set perObject ""
+ set infokind Class
+ }
+ if {[::nsf::cmd::${infokind}Info::method ${:domain} name ${:name}] ne ""} {
+ #puts stderr "OPTIMIZER RESETTING ${:domain} slot ${:name}"
+ ::nsf::forward ${:domain} {*}$perObject ${:name} \
+ ${:manager} \
+ [list %1 [${:manager} defaultmethods]] %self \
+ ${:methodname}
+ }
+ #puts stderr "OPTIMIZER incremental [info exists :incremental] def '[set :defaultmethods]'"
+ if {[info exists :incremental] && ${:incremental}} return
+ if {[set :defaultmethods] ne {get assign}} return
+ set assignInfo [:info callable -which assign]
+ #puts stderr "OPTIMIZER assign=$assignInfo//[lindex $assignInfo {end 0}]//[:info precedence]"
+
+ if {$assignInfo ne "::nx::ObjectParameterSlot alias assign ::nsf::setvar" &&
+ [lindex $assignInfo {end 0}] ne "::nsf::setvar" } return
+ if {[:info callable -which get] ne "::nx::ObjectParameterSlot alias get ::nsf::setvar"} return
+
+ array set "" [:toParameterSyntax ${:name}]
+ if {$(mparam) ne ""} {
+ set setterParam [lindex $(oparam) 0]
+ #puts stderr "setterParam=$setterParam, op=$(oparam)"
+ } else {
+ set setterParam ${:name}
+ }
+ ::nsf::setter ${:domain} {*}$perObject $setterParam
+ #puts stderr "::nsf::setter ${:domain} {*}$perObject $setterParam"
+ }
+ }
+ # register the optimizer per default
+ Attribute mixin add Attribute::Optimizer
+
+ ############################################
+ # Define method "attribute" for convenience
+ ############################################
+ Class method attribute {spec {-slotclass ::nx::Attribute} {initblock ""}} {
+ $slotclass createFromParameterSyntax [::nsf::current object] -initblock $initblock {*}$spec
+ }
+ Object method attribute {spec {-slotclass ::nx::Attribute} {initblock ""}} {
+ $slotclass createFromParameterSyntax [::nsf::current object] -per-object -initblock $initblock {*}$spec
+ }
+
+ ############################################
+ # Define method "parameter" for backward
+ # compatibility and convenience
+ ############################################
+ Class public method parameter arglist {
+
+ foreach arg $arglist {
+ Attribute createFromParameterSyntax [::nsf::current object] {*}$arg
+ }
+ # todo needed?
+ set slot [::nsf::current object]::slot
+ if {![::nsf::objectproperty $slot object]} {Object create $slot}
+ ::nsf::setvar $slot __parameter $arglist
+ }
+ ::nsf::method classInfo parameter {class} {
+ set slot ${class}::slot
+ if {![::nsf::objectproperty $slot object]} {Object create $slot}
+ if {[::nsf::existsvar $slot __parameter]} {
+ return [::nsf::setvar $slot __parameter]
+ }
+ return ""
+ }
+
+ ##################################################################
+ # now the slots are defined; now we can defines the Objects or
+ # classes with parameters more easily than above.
+ ##################################################################
+
+ # remove helper proc
+ proc createBootstrapAttributeSlots {} {}
+
+ ##################################################################
+ # create user-level converter/checker based on ::nsf primitves
+ ##################################################################
+
+ Slot method type=hasmixin {name value arg} {
+ if {![::nsf::objectproperty $value hasmixin $arg]} {
+ error "expected object with mixin $arg but got \"$value\" for parameter $name"
+ }
+ return $value
+ }
+
+ Slot method type=baseclass {name value} {
+ if {![::nsf::objectproperty $value baseclass]} {
+ error "expected baseclass but got \"$value\" for parameter $name"
+ }
+ return $value
+ }
+
+ Slot method type=metaclass {name value} {
+ if {![::nsf::objectproperty $value metaclass]} {
+ error "expected metaclass but got \"$value\" for parameter $name"
+ }
+ return $value
+ }
+
+ ##################################################################
+ # Create a mixin class to overload method "new" such it does not
+ # allocate new objects in ::nx::*, but in the specified object
+ # (without syntactic overhead).
+ ##################################################################
+
+ Class create ::nx::ScopedNew -superclass Class {
+
+ :attribute {withclass ::nx::Object}
+ :attribute container
+
+ :protected method init {} {
+ :public method new {-childof args} {
+ ::nsf::importvar [::nsf::current class] {container object} withclass
+ if {![::nsf::objectproperty $object object]} {
+ $withclass create $object
+ }
+ eval ::nsf::next -childof $object $args
+ }
+ }
+ }
+
+ ##################################################################
+ # The method 'contains' changes the namespace in which objects with
+ # relative names are created. Therefore, 'contains' provides a
+ # friendly notation for creating nested object
+ # structures. Optionally, creating new objects in the specified
+ # scope can be turned off.
+ ##################################################################
+
+ Object public method contains {
+ {-withnew:boolean true}
+ -object
+ {-class ::nx::Object}
+ cmds
+ } {
+ if {![info exists object]} {set object [::nsf::current object]}
+ if {![::nsf::objectproperty $object object]} {$class create $object}
+ $object requireNamespace
+ if {$withnew} {
+ set m [ScopedNew new -volatile \
+ -container $object -withclass $class]
+ Class mixin add $m end
+ # TODO: the following is not pretty; however, contains might build xotcl1 and next objects.
+ if {[::nsf::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin add $m end}
+ namespace eval $object $cmds
+ Class mixin delete $m
+ if {[::nsf::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin delete $m}
+ } else {
+ namespace eval $object $cmds
+ }
+ }
+
+ Class forward slots %self contains \
+ -object {%::nsf::dispatch [::nsf::current object] -objscope ::subst [::nsf::current object]::slot}
+
+ ##################################################################
+ # copy/move implementation
+ ##################################################################
+
+ Class create ::nx::CopyHandler {
+
+ :attribute {targetList ""}
+ :attribute {dest ""}
+ :attribute objLength
+
+ :method makeTargetList {t} {
+ lappend :targetList $t
+ #puts stderr "COPY makeTargetList $t target= ${:targetList}"
+ # if it is an object without namespace, it is a leaf
+ if {[::nsf::objectproperty $t object]} {
+ if {[$t 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::objectproperty $c object]} {
+ lappend children [namespace children $t]
+ }
+ }
+
+ # a namespace or an obj with namespace may have children
+ # itself
+ foreach c $children {
+ :makeTargetList $c
+ }
+ }
+
+ :method copyNSVarsAndCmds {orig dest} {
+ ::nsf::namespace_copyvars $orig $dest
+ ::nsf::namespace_copycmds $orig $dest
+ }
+
+ # construct destination obj name from old qualified ns name
+ :method getDest origin {
+ set tail [string range $origin [set :objLength] end]
+ return ::[string trimleft [set :dest]$tail :]
+ }
+
+ :method copyTargets {} {
+ #puts stderr "COPY will copy targetList = [set :targetList]"
+ foreach origin [set :targetList] {
+ set dest [:getDest $origin]
+ if {[::nsf::objectproperty $origin object]} {
+ # copy class information
+ if {[::nsf::objectproperty $origin class]} {
+ set cl [[$origin info class] create $dest -noinit]
+ # class object
+ set obj $cl
+ $cl superclass [$origin info superclass]
+ ::nsf::assertion $cl class-invar [::nsf::assertion $origin class-invar]
+ ::nsf::relation $cl class-filter [::nsf::relation $origin class-filter]
+ ::nsf::relation $cl class-mixin [::nsf::relation $origin class-mixin]
+ :copyNSVarsAndCmds ::nsf::classes$origin ::nsf::classes$dest
+ } else {
+ # create obj
+ set obj [[$origin info class] create $dest -noinit]
+ }
+ # copy object -> may be a class obj
+ ::nsf::assertion $obj check [::nsf::assertion $origin check]
+ ::nsf::assertion $obj object-invar [::nsf::assertion $origin object-invar]
+ ::nsf::relation $obj object-filter [::nsf::relation $origin object-filter]
+ ::nsf::relation $obj object-mixin [::nsf::relation $origin object-mixin]
+ if {[$origin info hasnamespace]} {
+ $obj requireNamespace
+ }
+ } else {
+ namespace eval $dest {}
+ }
+ :copyNSVarsAndCmds $origin $dest
+ foreach i [::nsf::cmd::ObjectInfo::forward $origin] {
+ eval [concat ::nsf::forward $dest -per-object $i [::nsf::cmd::ObjectInfo::forward $origin -definition $i]]
+ }
+ if {[::nsf::objectproperty $origin class]} {
+ foreach i [::nsf::cmd::ClassInfo::forward $origin] {
+ eval [concat ::nsf::forward $dest $i [::nsf::cmd::ClassInfo::forward $origin -definition $i]]
+ }
+ }
+ set traces [list]
+ foreach var [$origin info vars] {
+ set cmds [::nsf::dispatch $origin -objscope ::trace info variable $var]
+ if {$cmds ne ""} {
+ foreach cmd $cmds {
+ foreach {op def} $cmd break
+ #$origin trace remove variable $var $op $def
+ if {[lindex $def 0] eq $origin} {
+ set def [concat $dest [lrange $def 1 end]]
+ }
+ $dest trace add variable $var $op $def
+ }
+ }
+ }
+ #puts stderr "====="
+ }
+ # alter 'domain' and 'manager' in slot objects for classes
+ foreach origin [set :targetList] {
+ if {[::nsf::objectproperty $origin class]} {
+ set dest [:getDest $origin]
+ foreach oldslot [$origin info slots] {
+ set newslot [Slot slotName [namespace tail $oldslot] $dest]
+ if {[$oldslot domain] eq $origin} {$newslot domain $cl}
+ if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}
+ }
+ }
+ }
+ }
+
+ :public method copy {obj dest} {
+ #puts stderr "[::nsf::current object] copy <$obj> <$dest>"
+ set :objLength [string length $obj]
+ set :dest $dest
+ :makeTargetList $obj
+ :copyTargets
+ }
+
+ }
+
+ Object public method copy newName {
+ if {[string compare [string trimleft $newName :] [string trimleft [::nsf::current object] :]]} {
+ [CopyHandler new -volatile] copy [::nsf::current object] $newName
+ }
+ }
+
+ Object public method move newName {
+ if {[string trimleft $newName :] ne [string trimleft [::nsf::current object] :]} {
+ if {$newName ne ""} {
+ :copy $newName
+ }
+ ### let all subclasses get the copied class as superclass
+ if {[::nsf::objectproperty [::nsf::current object] class] && $newName ne ""} {
+ foreach subclass [:info subclass] {
+ set scl [$subclass info superclass]
+ if {[set index [lsearch -exact $scl [::nsf::current object]]] != -1} {
+ set scl [lreplace $scl $index $index $newName]
+ $subclass superclass $scl
+ }
+ }
+ }
+ :destroy
+ }
+ }
+
+ #######################################################
+ # some utilities
+ #######################################################
+
+ #
+ # Provide an ensemble-like interface to the ::nsf primitiva to
+ # access variables. Note that aliasing in the next scripting
+ # framework is faster than namespace-ensembles.
+ #
+ Object create ::nx::var {
+ :alias exists ::nsf::existsvar
+ :alias import ::nsf::importvar
+ :alias set ::nsf::setvar
+ }
+
+ interp alias {} ::nx::self {} ::nsf::current object
+}
+
+
+
+#######################################################################
+# define, what should be exported
+namespace eval ::nx {
+
+ # export the contents for all xotcl versions
+ namespace export Object Class next self current
+
+ # TODO should not be necessary in the future
+ namespace export Attribute
+
+ set ::nx::confdir ~/.nx
+ set ::nx::logdir $::nx::confdir/log
+
+ unset bootstrap
+}
Index: library/nx/pkgIndex.tcl
===================================================================
diff -u
--- library/nx/pkgIndex.tcl (revision 0)
+++ library/nx/pkgIndex.tcl (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -0,0 +1,12 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex -direct" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded nx 2.0 [list source [file join $dir nx.tcl]]
+
Index: library/serialize/serializer.tcl
===================================================================
diff -u -r30173337f3b4d0d9c224713b2c86c622b26f3046 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/serialize/serializer.tcl (.../serializer.tcl) (revision 30173337f3b4d0d9c224713b2c86c622b26f3046)
+++ library/serialize/serializer.tcl (.../serializer.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -154,7 +154,7 @@
:method init {} {
# Never serialize the (volatile) serializer object
- :ignore [::nx::core::current object]
+ :ignore [::nsf::current object]
}
:method warn msg {
@@ -179,11 +179,11 @@
# we export the object tree.
set oo $o
while {1} {
- if {[::nx::core::existsvar [::nx::core::current class] exportObjects($o)]} {
+ if {[::nsf::existsvar [::nsf::current class] exportObjects($o)]} {
return 1
}
# we do this for object trees without object-less namespaces
- if {![::nx::core::objectproperty $o object]} {
+ if {![::nsf::objectproperty $o object]} {
return 0
}
set o [$o info parent]
@@ -213,7 +213,7 @@
set :level($stratum) {}
foreach c $set {
set oss [set :serializer($c)]
- if {[$oss needsNothing $c [::nx::core::current object]]} {
+ if {[$oss needsNothing $c [::nsf::current object]]} {
lappend :level($stratum) $c
}
}
@@ -247,7 +247,7 @@
#.warn "serialize $i"
#append result "# Stratum $l\n"
set oss [set :serializer($i)]
- append result [$oss serialize $i [::nx::core::current object]] \n
+ append result [$oss serialize $i [::nsf::current object]] \n
}
}
foreach e $list {
@@ -275,7 +275,7 @@
catch {unset namespace(::ns)}
foreach ns [array name namespace] {
if {![namespace exists $ns]} continue
- if {![::nx::core::objectproperty $ns object]} {
+ if {![::nsf::objectproperty $ns object]} {
append pre_cmds "namespace eval $ns {}\n"
} elseif {$ns ne [namespace origin $ns] } {
append pre_cmds "namespace eval $ns {}\n"
@@ -292,7 +292,7 @@
# assumes $o to be fully qualified
set instances [Serializer allChildren $o]
foreach oss [ObjectSystemSerializer info instances] {
- $oss registerSerializer [::nx::core::current object] $instances
+ $oss registerSerializer [::nsf::current object] $instances
}
:serialize-objects $instances 1
}
@@ -303,7 +303,7 @@
:object method allChildren o {
# return o and all its children fully qualified
- set set [::nx::core::dispatch $o -objscope ::nx::core::current]
+ set set [::nsf::dispatch $o -objscope ::nsf::current]
foreach c [$o info children] {
lappend set {*}[:allChildren $c]
}
@@ -342,7 +342,7 @@
:object method checkExportedObject {} {
foreach o [array names :exportObjects] {
- if {![::nx::core::objectproperty $o object]} {
+ if {![::nsf::objectproperty $o object]} {
puts stderr "Serializer exportObject: ignore non-existing object $o"
unset :exportObjects($o)
} else {
@@ -357,16 +357,16 @@
:object method all {-ignoreVarsRE -ignore} {
# don't filter anything during serialization
- set filterstate [::nx::core::configure filter off]
- set s [:new -childof [::nx::core::current object] -volatile]
+ set filterstate [::nsf::configure filter off]
+ set s [:new -childof [::nsf::current object] -volatile]
if {[info exists ignoreVarsRE]} {$s ignoreVarsRE $ignoreVarsRE}
if {[info exists ignore]} {$s ignore $ignore}
set r [subst {
- set ::xotcl::__filterstate \[::nx::core::configure filter off\]
+ set ::xotcl::__filterstate \[::nsf::configure filter off\]
#::nx::Slot mixin add ::nx::Slot::Nocheck
- ::nx::core::configure softrecreate [::nx::core::configure softrecreate]
- ::nx::core::setExitHandler [list [::nx::core::getExitHandler]]
+ ::nsf::configure softrecreate [::nsf::configure softrecreate]
+ ::nsf::setExitHandler [list [::nsf::getExitHandler]]
}]\n
:resetPattern
set instances [list]
@@ -390,21 +390,21 @@
append r {
#::nx::Slot mixin delete ::nx::Slot::Nocheck
- ::nx::core::configure filter $::xotcl::__filterstate
+ ::nsf::configure filter $::xotcl::__filterstate
unset ::xotcl::__filterstate
}
- ::nx::core::configure filter $filterstate
+ ::nsf::configure filter $filterstate
return $r
}
:object method methodSerialize {object method prefix} {
- set s [:new -childof [::nx::core::current object] -volatile]
+ set s [:new -childof [::nsf::current object] -volatile]
concat $object [$s method-serialize $object $method $prefix]
}
:object method deepSerialize {-ignoreVarsRE -ignore -map args} {
:resetPattern
- set s [:new -childof [::nx::core::current object] -volatile]
+ set s [:new -childof [::nsf::current object] -volatile]
if {[info exists ignoreVarsRE]} {$s ignoreVarsRE $ignoreVarsRE}
if {[info exists ignore]} {$s ignore $ignore}
@@ -416,7 +416,7 @@
}
# include Serializer in the serialized code
- :exportObjects [::nx::core::current object]
+ :exportObjects [::nsf::current object]
}
@@ -429,8 +429,8 @@
:method init {} {
# Include object system serializers and the meta-class in "Serializer all"
- Serializer exportObjects [::nx::core::current class]
- Serializer exportObjects [::nx::core::current object]
+ Serializer exportObjects [::nsf::current class]
+ Serializer exportObjects [::nsf::current object]
}
#
@@ -445,19 +445,19 @@
set cmd ""
foreach o [list ${:rootClass} ${:rootMetaClass}] {
append cmd \
- [:frameWorkCmd ::nx::core::relation $o object-mixin] \
- [:frameWorkCmd ::nx::core::relation $o class-mixin] \
- [:frameWorkCmd ::nx::core::assertion $o object-invar] \
- [:frameWorkCmd ::nx::core::assertion $o class-invar]
+ [:frameWorkCmd ::nsf::relation $o object-mixin] \
+ [:frameWorkCmd ::nsf::relation $o class-mixin] \
+ [:frameWorkCmd ::nsf::assertion $o object-invar] \
+ [:frameWorkCmd ::nsf::assertion $o class-invar]
}
return $cmd
}
:method registerTrace {on} {
if {$on} {
- ::nx::core::alias ${:rootClass} __trace__ -objscope ::trace
+ ::nsf::alias ${:rootClass} __trace__ -objscope ::trace
} else {
- ::nx::core::method ${:rootClass} __trace__ {} {}
+ ::nsf::method ${:rootClass} __trace__ {} {}
}
}
@@ -467,8 +467,8 @@
:method registerSerializer {s instances} {
# Communicate responsibility to serializer object $s
foreach i $instances {
- if {![::nx::core::objectproperty $i type ${:rootClass}]} continue
- $s setObjectSystemSerializer $i [::nx::core::current object]
+ if {![::nsf::objectproperty $i type ${:rootClass}]} continue
+ $s setObjectSystemSerializer $i [::nsf::current object]
}
}
@@ -480,10 +480,10 @@
if {[:matchesIgnorePattern $i] && ![$s isExportedObject $i]} {
continue
}
- $s setObjectSystemSerializer $i [::nx::core::current object]
+ $s setObjectSystemSerializer $i [::nsf::current object]
lappend instances $i
}
- #$s warn "[::nx::core::current object] handled instances: $instances"
+ #$s warn "[::nsf::current object] handled instances: $instances"
return $instances
}
@@ -494,14 +494,14 @@
#
foreach k [Serializer exportedMethods] {
foreach {o p m} $k break
- if {![::nx::core::objectproperty $o object]} {
+ if {![::nsf::objectproperty $o object]} {
puts stderr "Warning: $o is not an object"
- } elseif {[::nx::core::objectproperty $o type ${:rootClass}]} {set :exportMethods($k) 1}
+ } elseif {[::nsf::objectproperty $o type ${:rootClass}]} {set :exportMethods($k) 1}
}
foreach o [Serializer exportedObjects] {
- if {![::nx::core::objectproperty $o object]} {
+ if {![::nsf::objectproperty $o object]} {
puts stderr "Warning: $o is not an object"
- } elseif {[::nx::core::objectproperty $o type ${:rootClass}]} {set :exportObjects($o) 1}
+ } elseif {[::nsf::objectproperty $o type ${:rootClass}]} {set :exportObjects($o) 1}
}
foreach p [array names :ignorePattern] {Serializer addPattern $p}
}
@@ -512,7 +512,7 @@
###############################
:method classify {o} {
- if {[::nx::core::objectproperty $o type ${:rootMetaClass}]} \
+ if {[::nsf::objectproperty $o type ${:rootMetaClass}]} \
{return Class} {return Object}
}
@@ -523,7 +523,7 @@
if {[$o eval [list ::array exists :$v]]} {
lappend setcmd [list array set :$v [$o eval [list array get :$v]]]
} else {
- lappend setcmd [list set :$v [::nx::core::setvar $o $v]]
+ lappend setcmd [list set :$v [::nsf::setvar $o $v]]
}
}
}
@@ -555,7 +555,7 @@
if {![info exists methods($o)]} continue
append r \n $methods($o)
}
- #puts stderr "[::nx::core::current object] ... exportedMethods <$r\n>"
+ #puts stderr "[::nsf::current object] ... exportedMethods <$r\n>"
return "$r\n"
}
@@ -602,7 +602,7 @@
if {![:Object-needsNothing $x $s]} {return 0}
set scs [$x info superclass]
if {[$s needsOneOf $scs]} {return 0}
- if {[$s needsOneOf [::nx::core::relation $x class-mixin]]} {return 0}
+ if {[$s needsOneOf [::nsf::relation $x class-mixin]]} {return 0}
foreach sc $scs {if {[$s needsOneOf [$sc info slots]]} {return 0}}
return 1
}
@@ -650,7 +650,7 @@
}
:method method-serialize {o m modifier} {
- if {![::nx::core::objectproperty $o class]} {set modifier ""}
+ if {![::nsf::objectproperty $o class]} {set modifier ""}
return [$o {*}$modifier info method definition $m]
}
@@ -661,24 +661,24 @@
:method Object-serialize {o s} {
:collect-var-traces $o $s
append cmd [list [$o info class] create \
- [::nx::core::dispatch $o -objscope ::nx::core::current object]]
+ [::nsf::dispatch $o -objscope ::nsf::current object]]
append cmd " -noinit\n"
- foreach i [lsort [::nx::core::cmd::ObjectInfo::methods $o]] {
+ foreach i [lsort [::nsf::cmd::ObjectInfo::methods $o]] {
append cmd [:method-serialize $o $i "object"] "\n"
}
append cmd \
[list $o eval [join [:collectVars $o] "\n "]]\n \
- [:frameWorkCmd ::nx::core::relation $o object-mixin] \
- [:frameWorkCmd ::nx::core::assertion $o object-invar]
+ [:frameWorkCmd ::nsf::relation $o object-mixin] \
+ [:frameWorkCmd ::nsf::assertion $o object-invar]
- if {[::nx::core::objectproperty $o type ::nx::Slot]} {
+ if {[::nsf::objectproperty $o type ::nx::Slot]} {
# Slots needs to be initialized to ensure
# __invalidateobjectparameter to be called
append cmd [list $o eval :init] \n
}
- $s addPostCmd [:frameWorkCmd ::nx::core::relation $o object-filter]
+ $s addPostCmd [:frameWorkCmd ::nsf::relation $o object-filter]
return $cmd
}
@@ -689,21 +689,21 @@
:method Class-serialize {o s} {
set cmd [:Object-serialize $o $s]
- foreach i [lsort [::nx::core::cmd::ClassInfo::methods $o]] {
+ foreach i [lsort [::nsf::cmd::ClassInfo::methods $o]] {
append cmd [:method-serialize $o $i ""] "\n"
}
append cmd \
- [:frameWorkCmd ::nx::core::relation $o superclass -unless ${:rootClass}] \
- [:frameWorkCmd ::nx::core::relation $o class-mixin] \
- [:frameWorkCmd ::nx::core::assertion $o class-invar]
+ [:frameWorkCmd ::nsf::relation $o superclass -unless ${:rootClass}] \
+ [:frameWorkCmd ::nsf::relation $o class-mixin] \
+ [:frameWorkCmd ::nsf::assertion $o class-invar]
- $s addPostCmd [:frameWorkCmd ::nx::core::relation $o class-filter]
+ $s addPostCmd [:frameWorkCmd ::nsf::relation $o class-filter]
return $cmd\n
}
# register serialize a global method
::nx::Object method serialize {} {
- ::Serializer deepSerialize [::nx::core::current object]
+ ::Serializer deepSerialize [::nsf::current object]
}
}
@@ -719,7 +719,7 @@
set :rootClass ::xotcl::Object
set :rootMetaClass ::xotcl::Class
#array set :ignorePattern [list "::xotcl::*" 1]
- array set :ignorePattern [list "::nx::core::*" 1 "::xotcl::*" 1]
+ array set :ignorePattern [list "::nsf::*" 1 "::xotcl::*" 1]
:method serialize-all-start {s} {
@@ -731,7 +731,7 @@
}
:method serialize-all-end {s} {
- return "[next]\n::nx::core::alias ::xotcl::Object trace -objscope ::trace\n"
+ return "[next]\n::nsf::alias ::xotcl::Object trace -objscope ::trace\n"
}
@@ -789,25 +789,25 @@
:method Object-serialize {o s} {
:collect-var-traces $o $s
- append cmd [list [$o info class] create [::nx::core::dispatch $o -objscope ::nx::core::current object]]
+ append cmd [list [$o info class] create [::nsf::dispatch $o -objscope ::nsf::current object]]
# slots needs to be initialized when optimized, since
# parametercmds are not serialized
append cmd " -noinit\n"
- foreach i [::nx::core::cmd::ObjectInfo::methods $o -methodtype scripted] {
+ foreach i [::nsf::cmd::ObjectInfo::methods $o -methodtype scripted] {
append cmd [:method-serialize $o $i ""] "\n"
}
- foreach i [::nx::core::cmd::ObjectInfo::methods $o -methodtype forward] {
+ foreach i [::nsf::cmd::ObjectInfo::methods $o -methodtype forward] {
append cmd [concat [list $o] forward $i [$o info forward -definition $i]] "\n"
}
- foreach i [::nx::core::cmd::ObjectInfo::methods $o -methodtype setter] {
+ foreach i [::nsf::cmd::ObjectInfo::methods $o -methodtype setter] {
append cmd [list $o parametercmd $i] "\n"
}
append cmd \
[list $o eval [join [:collectVars $o] "\n "]] \n \
- [:frameWorkCmd ::nx::core::relation $o object-mixin] \
- [:frameWorkCmd ::nx::core::assertion $o object-invar]
+ [:frameWorkCmd ::nsf::relation $o object-mixin] \
+ [:frameWorkCmd ::nsf::assertion $o object-invar]
- $s addPostCmd [:frameWorkCmd ::nx::core::relation $o object-filter]
+ $s addPostCmd [:frameWorkCmd ::nsf::relation $o object-filter]
return $cmd
}
@@ -828,26 +828,26 @@
append cmd [list $o instparametercmd $i] "\n"
}
# provide limited support for exporting aliases for XOTcl objects
- foreach i [::nx::core::cmd::ClassInfo::methods $o -methodtype alias] {
- set xotcl2Def [::nx::core::cmd::ClassInfo::method $o definition $i]
+ foreach i [::nsf::cmd::ClassInfo::methods $o -methodtype alias] {
+ set xotcl2Def [::nsf::cmd::ClassInfo::method $o definition $i]
set objscope [lindex $xotcl2Def end-2]
set methodName [lindex $xotcl2Def end-1]
set cmdName [lindex $xotcl2Def end]
if {$objscope ne "-objscope"} {set objscope ""}
- append cmd [list ::nx::core::alias $o $methodName {*}$objscope $cmdName]\n
+ append cmd [list ::nsf::alias $o $methodName {*}$objscope $cmdName]\n
}
append cmd \
- [:frameWorkCmd ::nx::core::relation $o superclass -unless ${:rootClass}] \
- [:frameWorkCmd ::nx::core::relation $o class-mixin] \
- [:frameWorkCmd ::nx::core::assertion $o class-invar]
+ [:frameWorkCmd ::nsf::relation $o superclass -unless ${:rootClass}] \
+ [:frameWorkCmd ::nsf::relation $o class-mixin] \
+ [:frameWorkCmd ::nsf::assertion $o class-invar]
- $s addPostCmd [:frameWorkCmd ::nx::core::relation $o class-filter]
+ $s addPostCmd [:frameWorkCmd ::nsf::relation $o class-filter]
return $cmd
}
# register serialize a global method for XOTcl
::xotcl::Object instproc serialize {} {
- ::Serializer deepSerialize [::nx::core::current object]
+ ::Serializer deepSerialize [::nsf::current object]
}
Index: library/xotcl/library/xotcl2.tcl
===================================================================
diff -u -r6166d76909482a0a4c1296cb959462d71c688922 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 6166d76909482a0a4c1296cb959462d71c688922)
+++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -1,5 +1,6 @@
package provide XOTcl 2.0
package require nx
+
#######################################################
# Classical ::xotcl*
#######################################################
@@ -16,7 +17,7 @@
# ::xotcl::Object and ::xotcl::Class and defines these as root class
# of the object system and as root meta class.
#
- ::nx::core::createobjectsystem ::xotcl::Object ::xotcl::Class {
+ ::nsf::createobjectsystem ::xotcl::Object ::xotcl::Class {
-class.alloc alloc
-class.create create
-class.dealloc dealloc
@@ -34,69 +35,69 @@
}
#
- # create ::nx and ::nx::core namespaces, otherwise mk_pkgindex will fail
+ # create ::nx and ::nsf namespaces, otherwise mk_pkgindex will fail
#
namespace eval ::nx {}
- namespace eval ::nx::core {}
+ namespace eval ::nsf {}
#
# get frequenly used primitiva into the ::xotcl namespace
#
- namespace import ::nx::core::*
+ namespace import ::nsf::*
namespace import ::nx::Attribute
proc ::xotcl::self {{arg "object"}} {
switch $arg {
next {
- set handle [uplevel ::nx::core::current $arg]
+ set handle [uplevel ::nsf::current $arg]
method_handle_to_xotcl $handle
}
- default {uplevel ::nx::core::current $arg}
+ default {uplevel ::nsf::current $arg}
}
}
# provide the standard command set for ::xotcl::Object
- foreach cmd [info command ::nx::core::cmd::Object::*] {
+ foreach cmd [info command ::nsf::cmd::Object::*] {
set cmdName [namespace tail $cmd]
if {$cmdName in [list "filtersearch" "setter"]} continue
- ::nx::core::alias Object $cmdName $cmd
+ ::nsf::alias Object $cmdName $cmd
}
# provide some Tcl-commands as methods for ::xotcl::Object
foreach cmd {array append eval incr lappend set subst unset trace} {
- ::nx::core::alias Object $cmd -objscope ::$cmd
+ ::nsf::alias Object $cmd -objscope ::$cmd
}
# provide the standard command set for ::xotcl::Class
- foreach cmd [info command ::nx::core::cmd::Class::*] {
+ foreach cmd [info command ::nsf::cmd::Class::*] {
set cmdName [namespace tail $cmd]
if {$cmdName in [list "setter"]} continue
- ::nx::core::alias Class $cmdName $cmd
+ ::nsf::alias Class $cmdName $cmd
}
# protect some methods against redefinition
- ::nx::core::methodproperty Object destroy redefine-protected true
- ::nx::core::methodproperty Class alloc redefine-protected true
- ::nx::core::methodproperty Class dealloc redefine-protected true
- ::nx::core::methodproperty Class create redefine-protected true
+ ::nsf::methodproperty Object destroy redefine-protected true
+ ::nsf::methodproperty Class alloc redefine-protected true
+ ::nsf::methodproperty Class dealloc redefine-protected true
+ ::nsf::methodproperty Class create redefine-protected true
# define instproc and proc
- ::nx::core::method Class instproc {
+ ::nsf::method Class instproc {
name arguments body precondition:optional postcondition:optional
} {
set conditions [list]
if {[info exists precondition]} {lappend conditions -precondition $precondition}
if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
- ::nx::core::method [self] $name $arguments $body {*}$conditions
+ ::nsf::method [self] $name $arguments $body {*}$conditions
}
- ::nx::core::method Object proc {
+ ::nsf::method Object proc {
name arguments body precondition:optional postcondition:optional
} {
set conditions [list]
if {[info exists precondition]} {lappend conditions -precondition $precondition}
if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
- ::nx::core::method [self] -per-object $name $arguments $body {*}$conditions
+ ::nsf::method [self] -per-object $name $arguments $body {*}$conditions
}
# define - like in XOTcl 1 - a minimal implementation of "method"
@@ -112,8 +113,8 @@
}
# define forward methods
- ::nx::core::forward Object forward ::nx::core::forward %self -per-object
- ::nx::core::forward Class instforward ::nx::core::forward %self
+ ::nsf::forward Object forward ::nsf::forward %self -per-object
+ ::nsf::forward Class instforward ::nsf::forward %self
Class instproc unknown {args} {
#puts stderr "use '[self] create $args', not '[self] $args'"
@@ -135,7 +136,7 @@
# object-parameter definition, backwards compatible
#
::xotcl::Object instproc objectparameter {} {
- set parameterdefinitions [::nx::core::parametersFromSlots [self]]
+ set parameterdefinitions [::nsf::parametersFromSlots [self]]
lappend parameterdefinitions args
#puts stderr "*** parameter definition for [self]: $parameterdefinitions"
return $parameterdefinitions
@@ -144,7 +145,7 @@
#
# Use parameter definition from next
# (same with classInfo parameter, see below)
- ::nx::core::alias ::xotcl::Class parameter ::nx::core::classes::nx::Class::parameter
+ ::nsf::alias ::xotcl::Class parameter ::nsf::classes::nx::Class::parameter
# We provide a default value for superclass (when no superclass is
# specified explicitely) and metaclass, in case they should differ
@@ -165,9 +166,9 @@
${os}::Object alloc ${os}::Object::slot
::nx::RelationSlot create ${os}::Class::slot::superclass
- ::nx::core::alias ${os}::Class::slot::superclass assign ::nx::core::relation
+ ::nsf::alias ${os}::Class::slot::superclass assign ::nsf::relation
::nx::RelationSlot create ${os}::Object::slot::class -multivalued false
- ::nx::core::alias ${os}::Object::slot::class assign ::nx::core::relation
+ ::nsf::alias ${os}::Object::slot::class assign ::nsf::relation
::nx::RelationSlot create ${os}::Object::slot::mixin \
-methodname object-mixin
@@ -191,8 +192,8 @@
Object create ::xotcl::classInfo
# note, we are using ::xotcl::infoError defined earlier
- Object instforward info -onerror ::nx::core::infoError ::xotcl::objectInfo %1 {%@2 %self}
- Class instforward info -onerror ::nx::core::infoError ::xotcl::classInfo %1 {%@2 %self}
+ Object instforward info -onerror ::nsf::infoError ::xotcl::objectInfo %1 {%@2 %self}
+ Class instforward info -onerror ::nsf::infoError ::xotcl::classInfo %1 {%@2 %self}
objectInfo proc info {obj} {
set methods [list]
@@ -267,8 +268,8 @@
proc ::xotcl::info_args {allocation o method} {
set result [list]
foreach \
- argName [::nx::core::cmd::${allocation}Info::method $o args $method] \
- flag [::nx::core::cmd::${allocation}Info::method $o parameter $method] {
+ argName [::nsf::cmd::${allocation}Info::method $o args $method] \
+ flag [::nsf::cmd::${allocation}Info::method $o parameter $method] {
if {[string match -* $flag]} continue
lappend result $argName
}
@@ -278,7 +279,7 @@
proc ::xotcl::info_nonposargs {allocation o method} {
set result [list]
- foreach flag [::nx::core::cmd::${allocation}Info::method $o parameter $method] {
+ foreach flag [::nsf::cmd::${allocation}Info::method $o parameter $method] {
if {![string match -* $flag]} continue
lappend result $flag
}
@@ -287,8 +288,8 @@
}
proc ::xotcl::info_default {allocation o method arg varName} {
foreach \
- argName [::nx::core::cmd::${allocation}Info::method $o args $method] \
- flag [::nx::core::cmd::${allocation}Info::method $o parameter $method] {
+ argName [::nsf::cmd::${allocation}Info::method $o args $method] \
+ flag [::nsf::cmd::${allocation}Info::method $o parameter $method] {
if {$argName eq $arg} {
upvar 3 $varName default
if {[llength $flag] == 2} {
@@ -313,25 +314,25 @@
:proc default {o method arg var} {::xotcl::info_default Object $o $method $arg $var}
# info options emulated by "info method ..."
- :proc instbody {o methodName} {::nx::core::cmd::ClassInfo::method $o body $methodName}
- :proc instpre {o methodName} {::nx::core::cmd::ClassInfo::method $o precondition $methodName}
- :proc instpost {o methodName} {::nx::core::cmd::ClassInfo::method $o postcondition $methodName}
+ :proc instbody {o methodName} {::nsf::cmd::ClassInfo::method $o body $methodName}
+ :proc instpre {o methodName} {::nsf::cmd::ClassInfo::method $o precondition $methodName}
+ :proc instpost {o methodName} {::nsf::cmd::ClassInfo::method $o postcondition $methodName}
# info options emulated by "info methods"
:proc instcommands {o {pattern:optional ""}} {
- ::nx::core::cmd::ClassInfo::methods $o {*}$pattern
+ ::nsf::cmd::ClassInfo::methods $o {*}$pattern
}
:proc instprocs {o {pattern:optional ""}} {
- ::nx::core::cmd::ClassInfo::methods $o -methodtype scripted {*}$pattern
+ ::nsf::cmd::ClassInfo::methods $o -methodtype scripted {*}$pattern
}
:proc parametercmd {o {pattern:optional ""}} {
- ::nx::core::cmd::ClassInfo::methods $o -per-object -methodtype setter {*}$pattern
+ ::nsf::cmd::ClassInfo::methods $o -per-object -methodtype setter {*}$pattern
}
:proc instparametercmd {o {pattern:optional ""}} {
- ::nx::core::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern
+ ::nsf::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern
}
# assertion handling
- :proc instinvar {o} {::nx::core::assertion $o class-invar}
+ :proc instinvar {o} {::nsf::assertion $o class-invar}
}
objectInfo eval {
@@ -340,24 +341,24 @@
:proc default {o method arg var} {::xotcl::info_default Object $o $method $arg $var}
# info options emulated by "info method ..."
- :proc body {o methodName} {::nx::core::cmd::ObjectInfo::method $o body $methodName}
- :proc pre {o methodName} {::nx::core::cmd::ObjectInfo::method $o pre $methodName}
- :proc post {o methodName} {::nx::core::cmd::ObjectInfo::method $o post $methodName}
+ :proc body {o methodName} {::nsf::cmd::ObjectInfo::method $o body $methodName}
+ :proc pre {o methodName} {::nsf::cmd::ObjectInfo::method $o pre $methodName}
+ :proc post {o methodName} {::nsf::cmd::ObjectInfo::method $o post $methodName}
# info options emulated by "info methods"
:proc commands {o {pattern:optional ""}} {
- ::nx::core::cmd::ObjectInfo::methods $o {*}$pattern
+ ::nsf::cmd::ObjectInfo::methods $o {*}$pattern
}
:proc procs {o {pattern:optional ""}} {
- ::nx::core::cmd::ObjectInfo::methods $o -methodtype scripted {*}$pattern
+ ::nsf::cmd::ObjectInfo::methods $o -methodtype scripted {*}$pattern
}
:proc methods {
o -nocmds:switch -noprocs:switch -incontext:switch pattern:optional
} {
set methodtype all
if {$nocmds} {set methodtype scripted}
if {$noprocs} {if {$nocmds} {return ""}; set methodtype builtin}
- set cmd [list ::nx::core::cmd::ObjectInfo::callable $o -methodtype $methodtype]
+ set cmd [list ::nsf::cmd::ObjectInfo::callable $o -methodtype $methodtype]
if {$incontext} {lappend cmd -incontext}
if {[info exists pattern]} {lappend cmd $pattern}
eval $cmd
@@ -367,88 +368,88 @@
set guardsFlag [expr {$guards ? "-guards" : ""}]
set patternArg [expr {[info exists pattern] ? [list $pattern] : ""}]
if {$order && !$guards} {
- set def [::nx::core::cmd::ObjectInfo::filter $o -order {*}$guardsFlag {*}$patternArg]
+ set def [::nsf::cmd::ObjectInfo::filter $o -order {*}$guardsFlag {*}$patternArg]
set def [method_handles_to_xotcl $def]
} else {
- set def [::nx::core::cmd::ObjectInfo::filter $o {*}$guardsFlag {*}$patternArg]
+ set def [::nsf::cmd::ObjectInfo::filter $o {*}$guardsFlag {*}$patternArg]
}
#puts stderr " => $def"
return $def
}
# assertion handling
:proc check {o} {
- ::xotcl::checkoption_internal_to_xotcl1 [::nx::core::assertion $o check]
+ ::xotcl::checkoption_internal_to_xotcl1 [::nsf::assertion $o check]
}
- :proc invar {o} {::nx::core::assertion $o object-invar}
+ :proc invar {o} {::nsf::assertion $o object-invar}
}
- foreach cmd [::info command ::nx::core::cmd::ObjectInfo::*] {
+ foreach cmd [::info command ::nsf::cmd::ObjectInfo::*] {
set cmdName [namespace tail $cmd]
if {$cmdName in [list "callable" "filter" "method" "methods"]} continue
- ::nx::core::alias ::xotcl::objectInfo $cmdName $cmd
- ::nx::core::alias ::xotcl::classInfo $cmdName $cmd
+ ::nsf::alias ::xotcl::objectInfo $cmdName $cmd
+ ::nsf::alias ::xotcl::classInfo $cmdName $cmd
}
- foreach cmd [::info command ::nx::core::cmd::ClassInfo::*] {
+ foreach cmd [::info command ::nsf::cmd::ClassInfo::*] {
set cmdName [namespace tail $cmd]
if {$cmdName in [list "forward" "method" "methods" \
"mixinof" "object-mixin-of" \
"filter" "filterguard" \
"mixin" "mixinguard"]} continue
- ::nx::core::alias ::xotcl::classInfo $cmdName $cmd
+ ::nsf::alias ::xotcl::classInfo $cmdName $cmd
}
- ::nx::core::alias ::xotcl::objectInfo is ::nx::core::objectproperty
- ::nx::core::alias ::xotcl::classInfo is ::nx::core::objectproperty
- ::nx::core::alias ::xotcl::classInfo classparent ::nx::core::cmd::ObjectInfo::parent
- ::nx::core::alias ::xotcl::classInfo classchildren ::nx::core::cmd::ObjectInfo::children
- ::nx::core::alias ::xotcl::classInfo instmixin ::nx::core::cmd::ClassInfo::mixin
- ::nx::core::alias ::xotcl::classInfo instmixinguard ::nx::core::cmd::ClassInfo::mixinguard
- #::nx::core::alias ::xotcl::classInfo instmixinof ::nx::core::cmd::ClassInfo::class-mixin-of
- ::nx::core::forward ::xotcl::classInfo instmixinof ::nx::core::cmd::ClassInfo::mixinof %1 -scope class
- ::nx::core::alias ::xotcl::classInfo instfilter ::nx::core::cmd::ClassInfo::filter
- ::nx::core::alias ::xotcl::classInfo instfilterguard ::nx::core::cmd::ClassInfo::filterguard
- ::nx::core::alias ::xotcl::classInfo instforward ::nx::core::cmd::ClassInfo::forward
- #::nx::core::alias ::xotcl::classInfo mixinof ::nx::core::cmd::ClassInfo::object-mixin-of
- ::nx::core::forward ::xotcl::classInfo mixinof ::nx::core::cmd::ClassInfo::mixinof %1 -scope object
- ::nx::core::alias ::xotcl::classInfo parameter ::nx::classInfo::parameter
+ ::nsf::alias ::xotcl::objectInfo is ::nsf::objectproperty
+ ::nsf::alias ::xotcl::classInfo is ::nsf::objectproperty
+ ::nsf::alias ::xotcl::classInfo classparent ::nsf::cmd::ObjectInfo::parent
+ ::nsf::alias ::xotcl::classInfo classchildren ::nsf::cmd::ObjectInfo::children
+ ::nsf::alias ::xotcl::classInfo instmixin ::nsf::cmd::ClassInfo::mixin
+ ::nsf::alias ::xotcl::classInfo instmixinguard ::nsf::cmd::ClassInfo::mixinguard
+ #::nsf::alias ::xotcl::classInfo instmixinof ::nsf::cmd::ClassInfo::class-mixin-of
+ ::nsf::forward ::xotcl::classInfo instmixinof ::nsf::cmd::ClassInfo::mixinof %1 -scope class
+ ::nsf::alias ::xotcl::classInfo instfilter ::nsf::cmd::ClassInfo::filter
+ ::nsf::alias ::xotcl::classInfo instfilterguard ::nsf::cmd::ClassInfo::filterguard
+ ::nsf::alias ::xotcl::classInfo instforward ::nsf::cmd::ClassInfo::forward
+ #::nsf::alias ::xotcl::classInfo mixinof ::nsf::cmd::ClassInfo::object-mixin-of
+ ::nsf::forward ::xotcl::classInfo mixinof ::nsf::cmd::ClassInfo::mixinof %1 -scope object
+ ::nsf::alias ::xotcl::classInfo parameter ::nx::classInfo::parameter
# assertion handling
- ::nx::core::alias ::xotcl::classInfo invar objectInfo::invar
- ::nx::core::alias ::xotcl::classInfo check objectInfo::check
+ ::nsf::alias ::xotcl::classInfo invar objectInfo::invar
+ ::nsf::alias ::xotcl::classInfo check objectInfo::check
# define info methods from objectInfo on classInfo as well
- ::nx::core::alias classInfo body objectInfo::body
- ::nx::core::alias classInfo commands objectInfo::commands
- ::nx::core::alias classInfo filter objectInfo::filter
- ::nx::core::alias classInfo methods objectInfo::methods
- ::nx::core::alias classInfo procs objectInfo::procs
- ::nx::core::alias classInfo pre objectInfo::pre
- ::nx::core::alias classInfo post objectInfo::post
+ ::nsf::alias classInfo body objectInfo::body
+ ::nsf::alias classInfo commands objectInfo::commands
+ ::nsf::alias classInfo filter objectInfo::filter
+ ::nsf::alias classInfo methods objectInfo::methods
+ ::nsf::alias classInfo procs objectInfo::procs
+ ::nsf::alias classInfo pre objectInfo::pre
+ ::nsf::alias classInfo post objectInfo::post
# emulation of isobject, isclass ...
- Object instproc isobject {{object:substdefault "[self]"}} {::nx::core::objectproperty $object object}
- Object instproc isclass {{class:substdefault "[self]"}} {::nx::core::objectproperty $class class}
- Object instproc ismetaclass {{class:substdefault "[self]"}} {::nx::core::objectproperty $class metaclass}
- Object instproc ismixin {class} {::nx::core::is [self] object -hasmixin $class}
- Object instproc istype {class} {::nx::core::is [self] type $class}
+ Object instproc isobject {{object:substdefault "[self]"}} {::nsf::objectproperty $object object}
+ Object instproc isclass {{class:substdefault "[self]"}} {::nsf::objectproperty $class class}
+ Object instproc ismetaclass {{class:substdefault "[self]"}} {::nsf::objectproperty $class metaclass}
+ Object instproc ismixin {class} {::nsf::is [self] object -hasmixin $class}
+ Object instproc istype {class} {::nsf::is [self] type $class}
- ::nx::core::alias Object contains ::nx::core::classes::nx::Object::contains
+ ::nsf::alias Object contains ::nsf::classes::nx::Object::contains
::xotcl::Class instforward slots %self contains \
- -object {%::nx::core::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}
+ -object {%::nsf::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}
#
# define parametercmd and instparametercmd in terms of ::nx method setter
# define filterguard and instfilterguard in terms of filterguard
# define mixinguard and instmixinguard in terms of mixinguard
#
- ::nx::core::alias Object parametercmd ::nx::core::classes::nx::Object::setter
- ::nx::core::alias Class instparametercmd ::nx::core::classes::nx::Class::setter
+ ::nsf::alias Object parametercmd ::nsf::classes::nx::Object::setter
+ ::nsf::alias Class instparametercmd ::nsf::classes::nx::Class::setter
- ::nx::core::alias Class filterguard ::nx::core::cmd::Object::filterguard
- ::nx::core::alias Class instfilterguard ::nx::core::cmd::Class::filterguard
+ ::nsf::alias Class filterguard ::nsf::cmd::Object::filterguard
+ ::nsf::alias Class instfilterguard ::nsf::cmd::Class::filterguard
- ::nx::core::alias Class mixinguard ::nx::core::cmd::Object::mixinguard
- ::nx::core::alias Class instmixinguard ::nx::core::cmd::Class::mixinguard
+ ::nsf::alias Class mixinguard ::nsf::cmd::Object::mixinguard
+ ::nsf::alias Class instmixinguard ::nsf::cmd::Class::mixinguard
# assertion handling
proc checkoption_xotcl1_to_internal checkoptions {
@@ -493,7 +494,7 @@
set kind [lindex $definition 2]
set name [lindex $definition 3]
} else {
- set prefix [expr {[::nx::core::objectproperty $obj class] ? "inst" : ""}]
+ set prefix [expr {[::nsf::objectproperty $obj class] ? "inst" : ""}]
set kind $modifier
set name [lindex $definition 2]
}
@@ -513,10 +514,10 @@
Object instproc check {checkoptions} {
- ::nx::core::assertion [self] check [::xotcl::checkoption_xotcl1_to_internal $checkoptions]
+ ::nsf::assertion [self] check [::xotcl::checkoption_xotcl1_to_internal $checkoptions]
}
- Object instforward invar ::nx::core::assertion %self object-invar
- Class instforward instinvar ::nx::core::assertion %self class-invar
+ Object instforward invar ::nsf::assertion %self object-invar
+ Class instforward instinvar ::nsf::assertion %self class-invar
Object instproc abstract {methtype methname arglist} {
if {$methtype ne "proc" && $methtype ne "instproc" && $methtype ne "method"} {
@@ -532,20 +533,20 @@
# support for XOTcl specific convenience routines
Object instproc hasclass cl {
- if {[::nx::core::is [self] object -hasmixin $cl]} {return 1}
- ::nx::core::is [self] type $cl
+ if {[::nsf::is [self] object -hasmixin $cl]} {return 1}
+ ::nsf::is [self] type $cl
}
Object instproc filtersearch {filter} {
- set definition [::nx::core::dispatch [self] ::nx::core::cmd::Object::filtersearch $filter]
+ set definition [::nsf::dispatch [self] ::nsf::cmd::Object::filtersearch $filter]
return [method_handle_to_xotcl $definition]
}
Object instproc procsearch {name} {
- set definition [::nx::core::cmd::ObjectInfo::callable [self] -which $name]
+ set definition [::nsf::cmd::ObjectInfo::callable [self] -which $name]
if {$definition ne ""} {
foreach {obj modifier kind} $definition break
if {$modifier ne "object"} {
set kind $modifier
- set perClass [::nx::core::is $obj class]
+ set perClass [::nsf::is $obj class]
} else {
set perClass 0
}
@@ -566,16 +567,16 @@
}
# keep old object interface for XOTcl
- Object proc unsetExitHandler {} {::nx::core::unsetExitHandler $newbody}
- Object proc setExitHandler {newbody} {::nx::core::setExitHandler $newbody}
- Object proc getExitHandler {} {::nx::core::getExitHandler}
+ Object proc unsetExitHandler {} {::nsf::unsetExitHandler $newbody}
+ Object proc setExitHandler {newbody} {::nsf::setExitHandler $newbody}
+ Object proc getExitHandler {} {::nsf::getExitHandler}
# resue some definitions from next scripting
- ::nx::core::alias ::xotcl::Object copy ::nx::core::classes::nx::Object::copy
- ::nx::core::alias ::xotcl::Object move ::nx::core::classes::nx::Object::move
- ::nx::core::alias ::xotcl::Object defaultmethod ::nx::core::classes::nx::Object::defaultmethod
+ ::nsf::alias ::xotcl::Object copy ::nsf::classes::nx::Object::copy
+ ::nsf::alias ::xotcl::Object move ::nsf::classes::nx::Object::move
+ ::nsf::alias ::xotcl::Object defaultmethod ::nsf::classes::nx::Object::defaultmethod
- ::nx::core::alias ::xotcl::Class -per-object __unknown ::nx::Class::__unknown
+ ::nsf::alias ::xotcl::Class -per-object __unknown ::nx::Class::__unknown
proc myproc {args} {linsert $args 0 [::xotcl::self]}
proc myvar {var} {.requireNamespace; return [::xotcl::self]::$var}
@@ -807,8 +808,8 @@
if {[info exists cmd]} {unset cmd}
- proc ::xotcl::configure args {::nx::core::configure {*}$args}
- proc ::xotcl::finalize {} {::nx::core::finalize}
+ proc ::xotcl::configure args {::nsf::configure {*}$args}
+ proc ::xotcl::finalize {} {::nsf::finalize}
# Documentation stub object -> just ignore per default.
# if xoDoc is loaded, documentation will be activated
@@ -817,7 +818,7 @@
set ::xotcl::confdir ~/.xotcl
set ::xotcl::logdir $::xotcl::confdir/log
- namespace import ::nx::core::tmpdir
+ namespace import ::nsf::tmpdir
# if we do this, "::xotcl::Class create Role -superclass Attribute" will fail.
#interp alias {} ::xotcl::Attribute {} ::nx::Attribute
@@ -826,6 +827,6 @@
namespace export Object Class Attribute myproc myvar my self next @
}
-foreach ns {::nx::core ::nx ::xotcl} {
+foreach ns {::nsf ::nx ::xotcl} {
puts stderr "$ns exports [namespace eval $ns {lsort [namespace export]}]"
}
\ No newline at end of file
Index: library/xotcl/tests/slottest.xotcl
===================================================================
diff -u -rb75c46b9676c6aeff6a95a12f8cafeb420530751 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision b75c46b9676c6aeff6a95a12f8cafeb420530751)
+++ library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -169,18 +169,18 @@
Object o1
o1 set i 0
-::nx::core::alias o1 Incr -objscope ::incr
+::nsf::alias o1 Incr -objscope ::incr
? {o1 incr i} 1 "method incr"
? {o1 Incr i} 1002 "aliased tcl incr"
? {o1 incr i} 2003 "method incr"
? {o1 Incr i} 3004 "aliased tcl incr"
-::nx::core::alias ::xotcl::Object Set -objscope ::set
+::nsf::alias ::xotcl::Object Set -objscope ::set
? {o1 set i 1} 1 "method set"
? {o1 set i} 1 "method set"
? {o1 Set i 1} 1 "aliased tcl set"
? {o1 Set i} 1 "aliased tcl set"
-::nx::core::alias o1 Set -objscope ::set
+::nsf::alias o1 Set -objscope ::set
? {o1 Set i 1} 1 "aliased object tcl set"
? {o1 Set i} 1 "aliased object tcl set"
::xotcl::Object instforward SSet -earlybinding -objscope ::set
@@ -191,15 +191,15 @@
o1 set z 100
#o1 forward z o1 [list %argclindex [list set set]] %proc
#o1 proc get name {my set $name}
-o1 forward get -earlybinding ::nx::core::setvar %self %1
+o1 forward get -earlybinding ::nsf::setvar %self %1
? {o1 get z 101} 101
? {o1 get z} "101"
? {o1 get z} 101 "get value via new parametercmd get"
? {o1 get z 124} 124 "set value via new parametercmd get"
-o1 forward zz -earlybinding ::nx::core::setvar %self %proc
+o1 forward zz -earlybinding ::nsf::setvar %self %proc
? {o1 zz 123} 123
? {o1 zz} 123
@@ -319,7 +319,7 @@
? {a0 procsearch f3} "::a0 proc f3"
? {a0 procsearch f4} "::a0 forward f4"
? {a0 procsearch set} "::xotcl::Object instcmd set"
-? {A slot foo info callable -which assign} "::nx::ObjectParameterSlot alias assign ::nx::core::setvar"
+? {A slot foo info callable -which assign} "::nx::ObjectParameterSlot alias assign ::nsf::setvar"
# redefine setter for foo of class A
A slot foo method assign {domain var val} {
@@ -536,7 +536,7 @@
? {o1 myf 100} 200
o1 set x 42
-o1 forward x -earlybinding ::nx::core::setvar %self %proc
+o1 forward x -earlybinding ::nsf::setvar %self %proc
? [list o1 x] 42
? [list o1 x 41] 41
? {o1 x} "get parametercmd via forward (earlybinding)"
@@ -559,7 +559,7 @@
? {o1 myfdset y} "get instvar value via forward -earlybinding"
? {o1 myfdset y 123} "set instvar value via forward -earlybinding"
-::nx::core::alias o1 myset -objscope ::set
+::nsf::alias o1 myset -objscope ::set
o1 myset x 101
? {o1 myset x} 101
@@ -575,7 +575,7 @@
P create p2 -age 345 -s 567
? {p2 age} "parametercmd read"
-? {::nx::core::setvar p2 age} "via setinstvar"
+? {::nsf::setvar p2 age} "via setinstvar"
? {p2 s} "parameter read with setter"
Index: library/xotcl/tests/speedtest.xotcl
===================================================================
diff -u -rb07223692b7ed8b9b1cfc81f202f73c066456c7c -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/xotcl/tests/speedtest.xotcl (.../speedtest.xotcl) (revision b07223692b7ed8b9b1cfc81f202f73c066456c7c)
+++ library/xotcl/tests/speedtest.xotcl (.../speedtest.xotcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -253,14 +253,14 @@
# should be still the same number as above
Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount
-Test new -cmd {Object new -volatile} -expected ::nx::core::__\#F9 -count 2000 \
- -post {foreach o [Object info instances ::nx::core::__*] {$o destroy}}
+Test new -cmd {Object new -volatile} -expected ::nsf::__\#F9 -count 2000 \
+ -post {foreach o [Object info instances ::nsf::__*] {$o destroy}}
# should be still the same number as above
Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount
-Test new -cmd {Object new} -expected ::nx::core::__\#lQ -count 2000 \
- -post {foreach o [Object info instances ::nx::core::__*] {$o destroy}}
+Test new -cmd {Object new} -expected ::nsf::__\#lQ -count 2000 \
+ -post {foreach o [Object info instances ::nsf::__*] {$o destroy}}
# should be still the same number as above
Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount
Index: library/xotcl/tests/testx.xotcl
===================================================================
diff -u -r89b5047e54e47a88a7de75d8523a07ffa5743407 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 89b5047e54e47a88a7de75d8523a07ffa5743407)
+++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -517,12 +517,12 @@
o m
::errorCheck [o set count] 2 "filter count"
o filter ""
- set filterstate [::nx::core::configure filter off]
+ set filterstate [::nsf::configure filter off]
o set count 0
o m
::errorCheck [o set count]-$filterstate 0-1 "filter off + old state"
o filter ""
- ::nx::core::configure filter on
+ ::nsf::configure filter on
set ::r ""
Object instproc f args {
Index: tests/aliastest.tcl
===================================================================
diff -u -r6166d76909482a0a4c1296cb959462d71c688922 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/aliastest.tcl (.../aliastest.tcl) (revision 6166d76909482a0a4c1296cb959462d71c688922)
+++ tests/aliastest.tcl (.../aliastest.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -6,7 +6,7 @@
# The system methods of Object are either alias or forwarders
? {lsort [::nx::ObjectParameterSlot info methods -methodtype alias]} {assign get}
- ? {::nx::ObjectParameterSlot info method definition get} "::nx::ObjectParameterSlot alias get ::nx::core::setvar"
+ ? {::nx::ObjectParameterSlot info method definition get} "::nx::ObjectParameterSlot alias get ::nsf::setvar"
# define an alias and retrieve its definition
set cmd "::nx::Object alias -objscope set ::set"
@@ -22,9 +22,9 @@
}
Class create Foo
- ::nx::core::alias ::Foo foo ::nx::core::classes::Base::foo
+ ::nsf::alias ::Foo foo ::nsf::classes::Base::foo
- ? {Foo info method definition foo} "::Foo alias foo ::nx::core::classes::Base::foo"
+ ? {Foo info method definition foo} "::Foo alias foo ::nsf::classes::Base::foo"
Foo create f1
? {f1 foo} 1
@@ -42,7 +42,7 @@
Base method foo {{-x 1}} {return $x}
- ::nx::core::alias ::Foo foo ::nx::core::classes::Base::foo
+ ::nsf::alias ::Foo foo ::nsf::classes::Base::foo
? {Base info methods -methodtype scripted} {foo} "defined again"
? {Foo info methods -methodtype alias} {foo} "aliased again"
@@ -63,7 +63,7 @@
T method foo args { return [current class]->[current method] }
- ::nx::core::alias T FOO ::nx::core::classes::T::foo
+ ::nsf::alias T FOO ::nsf::classes::T::foo
? {t foo} ::T->foo
? {t FOO} ::T->foo
@@ -74,28 +74,28 @@
# puts stderr "double indirection"
T method foo args { return [current class]->[current method] }
- ::nx::core::alias T FOO ::nx::core::classes::T::foo
- ::nx::core::alias S BAR ::nx::core::classes::T::FOO
+ ::nsf::alias T FOO ::nsf::classes::T::foo
+ ::nsf::alias S BAR ::nsf::classes::T::FOO
? {T info methods -methodtype alias} "FOO"
- ? {T info method definition FOO} "::T alias FOO ::nx::core::classes::T::foo"
+ ? {T info method definition FOO} "::T alias FOO ::nsf::classes::T::foo"
? {lsort [T info methods]} {FOO foo}
? {S info methods} {BAR}
T method FOO {} {}
? {T info methods} {foo}
? {S info methods} {BAR}
? {s BAR} ::S->foo
? {t foo} ::T->foo
- ? {S info method definition BAR} "::S alias BAR ::nx::core::classes::T::FOO"
+ ? {S info method definition BAR} "::S alias BAR ::nsf::classes::T::FOO"
T method foo {} {}
? {T info methods} {}
? {S info methods} {}
T method foo args { return [current class]->[current method] }
- ::nx::core::alias T FOO ::nx::core::classes::T::foo
- ::nx::core::alias S BAR ::nx::core::classes::T::FOO
+ ::nsf::alias T FOO ::nsf::classes::T::foo
+ ::nsf::alias S BAR ::nsf::classes::T::FOO
? {lsort [T info methods]} {FOO foo}
? {S info methods} {BAR}
@@ -105,9 +105,9 @@
T method foo args { return [current class]->[current method] }
T object method bar args { return [current class]->[current method] }
- ::nx::core::alias T -per-object FOO ::nx::core::classes::T::foo
- ::nx::core::alias T -per-object BAR ::T::FOO
- ::nx::core::alias T -per-object ZAP ::T::BAR
+ ::nsf::alias T -per-object FOO ::nsf::classes::T::foo
+ ::nsf::alias T -per-object BAR ::T::FOO
+ ::nsf::alias T -per-object ZAP ::T::BAR
? {T info methods} {foo}
? {lsort [T object info methods -methodtype alias]} {BAR FOO ZAP}
? {lsort [T object info methods]} {BAR FOO ZAP bar}
@@ -149,8 +149,8 @@
# per-object methods as per-object aliases
#
T object method m1 args { return [current class]->[current method] }
- ::nx::core::alias T -per-object M1 ::T::m1
- ::nx::core::alias T -per-object M11 ::T::M1
+ ::nsf::alias T -per-object M1 ::T::m1
+ ::nsf::alias T -per-object M11 ::T::M1
? {lsort [T object info methods]} {M1 M11 bar m1}
? {T m1} ->m1
? {T M1} ->m1
@@ -167,12 +167,12 @@
#
proc foo args { return [current class]->[current method] }
- ::nx::core::alias T FOO1 ::foo
- ::nx::core::alias T -per-object FOO2 ::foo
+ ::nsf::alias T FOO1 ::foo
+ ::nsf::alias T -per-object FOO2 ::foo
#
# ! per-object alias referenced as per-class alias !
#
- ::nx::core::alias T BAR ::T::FOO2
+ ::nsf::alias T BAR ::T::FOO2
? {lsort [T object info methods]} {FOO2 bar}
? {lsort [T info methods]} {BAR FOO1}
? {T FOO2} ->foo
@@ -200,9 +200,9 @@
proc bar2 args { upvar 2 _ __; return $__}
}
- ::nx::core::alias T FOO ::ns1::foo
- ::nx::core::alias T BAR ::ns1::bar
- ::nx::core::alias T BAR2 ::ns1::bar2
+ ::nsf::alias T FOO ::ns1::foo
+ ::nsf::alias T BAR ::ns1::bar
+ ::nsf::alias T BAR2 ::ns1::bar2
? {lsort [T info methods]} {BAR BAR2 FOO}
set ::_ GOTYA
? {t FOO} ::T->foo
@@ -218,12 +218,12 @@
U create u
? {namespace exists ::U} 0
U object method zap args { return [current class]->[current method] }
- ::nx::core::alias ::U -per-object ZAP ::U::zap
+ ::nsf::alias ::U -per-object ZAP ::U::zap
U requireNamespace
? {namespace exists ::U} 1
U object method bar args { return [current class]->[current method] }
- ::nx::core::alias U -per-object BAR ::U::bar
+ ::nsf::alias U -per-object BAR ::U::bar
? {lsort [U object info methods]} {BAR ZAP bar zap}
? {U BAR} ->bar
? {U ZAP} ->zap
@@ -255,8 +255,8 @@
proc ::foo args { return [:bar ${:z}]-[set :z]-[:bar [set :z]] }
- ::nx::core::alias V FOO1 ::foo
- ::nx::core::alias V -per-object FOO2 ::foo
+ ::nsf::alias V FOO1 ::foo
+ ::nsf::alias V -per-object FOO2 ::foo
? {lsort [V object info methods]} {FOO2 bar}
? {lsort [V info methods]} {FOO1 bar}
@@ -270,15 +270,15 @@
}
#
-# Tests for the ::nx::core::alias store, used for introspection for
+# Tests for the ::nsf::alias store, used for introspection for
# aliases. The alias store (an associative variable) is mostly
# necessary for for the direct aliases (e.g. aliases to C implemented
# tcl commands), for which we have no stubs at the place where the
# alias was registered.
#
#
-# structure of the ::nx::core::alias store:
+# structure of the ::nsf::alias store:
# ,, ->
#
@@ -287,95 +287,95 @@
o method bar args {;}
-? {info vars ::nx::core::alias} ::nx::core::alias
-? {array exists ::nx::core::alias} 1
+? {info vars ::nsf::alias} ::nsf::alias
+? {array exists ::nsf::alias} 1
proc ::foo args {;}
-::nx::core::alias ::o FOO ::foo
-::nx::core::alias ::C FOO ::foo
-? {info exists ::nx::core::alias(::o,FOO,1)} 1
-? {info exists ::nx::core::alias(::C,FOO,0)} 1
-? {array get ::nx::core::alias ::o,FOO,1} "::o,FOO,1 ::foo"
-? {array get ::nx::core::alias ::C,FOO,0} "::C,FOO,0 ::foo"
+::nsf::alias ::o FOO ::foo
+::nsf::alias ::C FOO ::foo
+? {info exists ::nsf::alias(::o,FOO,1)} 1
+? {info exists ::nsf::alias(::C,FOO,0)} 1
+? {array get ::nsf::alias ::o,FOO,1} "::o,FOO,1 ::foo"
+? {array get ::nsf::alias ::C,FOO,0} "::C,FOO,0 ::foo"
? {o info method definition FOO} "::o alias FOO ::foo"
? {C info method definition FOO} "::C alias FOO ::foo"
-::nx::core::alias o FOO ::o::bar
-? {info exists ::nx::core::alias(::o,FOO,1)} 1
-? {array get ::nx::core::alias ::o,FOO,1} "::o,FOO,1 ::o::bar"
+::nsf::alias o FOO ::o::bar
+? {info exists ::nsf::alias(::o,FOO,1)} 1
+? {array get ::nsf::alias ::o,FOO,1} "::o,FOO,1 ::o::bar"
? {o info method definition FOO} "::o alias FOO ::o::bar"
# AliasDelete in XOTclRemoveObjectMethod
o method FOO {} {}
-? {info exists ::nx::core::alias(::o,FOO,1)} 0
-? {array get ::nx::core::alias ::o,FOO,1} ""
+? {info exists ::nsf::alias(::o,FOO,1)} 0
+? {array get ::nsf::alias ::o,FOO,1} ""
? {o info method definition FOO} ""
# AliasDelete in XOTclRemoveClassMethod
C method FOO {} {}
-? {info exists ::nx::core::alias(::C,FOO,0)} 0
-? {array get ::nx::core::alias ::C,FOO,0} ""
+? {info exists ::nsf::alias(::C,FOO,0)} 0
+? {array get ::nsf::alias ::C,FOO,0} ""
? {C info method definition FOO} ""
-::nx::core::alias ::o BAR ::foo
-::nx::core::alias ::C BAR ::foo
+::nsf::alias ::o BAR ::foo
+::nsf::alias ::C BAR ::foo
# AliasDelete in XOTclAddObjectMethod
-? {info exists ::nx::core::alias(::o,BAR,1)} 1
+? {info exists ::nsf::alias(::o,BAR,1)} 1
::o method BAR {} {;}
-? {info exists ::nx::core::alias(::o,BAR,1)} 0
+? {info exists ::nsf::alias(::o,BAR,1)} 0
# AliasDelete in XOTclAddInstanceMethod
-? {info exists ::nx::core::alias(::C,BAR,0)} 1
+? {info exists ::nsf::alias(::C,BAR,0)} 1
::C method BAR {} {;}
-? {info exists ::nx::core::alias(::C,BAR,0)} 0
+? {info exists ::nsf::alias(::C,BAR,0)} 0
# AliasDelete in aliasCmdDeleteProc
-::nx::core::alias o FOO ::foo
-? {info exists ::nx::core::alias(::o,FOO,1)} 1
+::nsf::alias o FOO ::foo
+? {info exists ::nsf::alias(::o,FOO,1)} 1
rename ::foo ""
-? {info exists ::nx::core::alias(::o,FOO,1)} 0
+? {info exists ::nsf::alias(::o,FOO,1)} 0
-::nx::core::alias o FOO ::o::bar
-::nx::core::alias o BAR ::o::FOO
-? {info exists ::nx::core::alias(::o,FOO,1)} 1
-? {info exists ::nx::core::alias(::o,BAR,1)} 1
+::nsf::alias o FOO ::o::bar
+::nsf::alias o BAR ::o::FOO
+? {info exists ::nsf::alias(::o,FOO,1)} 1
+? {info exists ::nsf::alias(::o,BAR,1)} 1
o method bar {} {}
-? {info exists ::nx::core::alias(::o,FOO,1)} 0
-? {info exists ::nx::core::alias(::o,BAR,1)} 0
+? {info exists ::nsf::alias(::o,FOO,1)} 0
+? {info exists ::nsf::alias(::o,BAR,1)} 0
#
# pulling the rug out from the proc-alias deletion mechanism
#
proc ::foo args {;}
-::nx::core::alias C FOO ::foo
-? {info exists ::nx::core::alias(::C,FOO,0)} 1
-unset ::nx::core::alias(::C,FOO,0)
-? {info exists ::nx::core::alias(::C,FOO,0)} 0
+::nsf::alias C FOO ::foo
+? {info exists ::nsf::alias(::C,FOO,0)} 1
+unset ::nsf::alias(::C,FOO,0)
+? {info exists ::nsf::alias(::C,FOO,0)} 0
? {C info method definition FOO} ""
? {C info methods -methodtype alias} FOO
rename ::foo ""
? {C info methods -methodtype alias} ""
-? {info exists ::nx::core::alias(::C,FOO,0)} 0
+? {info exists ::nsf::alias(::C,FOO,0)} 0
? {C info method definition FOO} ""
#
# test renaming of Tcl proc (actually sensed by the alias, though not
# reflected by the alias definition store)
# a) is this acceptable?
-# b) sync ::nx::core::alias upon "info method definition" calls? is this feasible,
+# b) sync ::nsf::alias upon "info method definition" calls? is this feasible,
# e.g. through rename traces?
#
C create c
proc ::foo args { return [current]->[current method]}
-? {info exists ::nx::core::alias(::C,FOO,0)} 0
-::nx::core::alias C FOO ::foo
-? {info exists ::nx::core::alias(::C,FOO,0)} 1
+? {info exists ::nsf::alias(::C,FOO,0)} 0
+::nsf::alias C FOO ::foo
+? {info exists ::nsf::alias(::C,FOO,0)} 1
? {C info methods -methodtype alias} FOO
rename ::foo ::foo2
-? {info exists ::nx::core::alias(::C,FOO,0)} 1
+? {info exists ::nsf::alias(::C,FOO,0)} 1
? {C info methods -methodtype alias} FOO
? {c FOO} ::c->foo2
? {C info method definition FOO} "::C alias FOO ::foo"; # should be ::foo2 (!)
Index: tests/destroytest.tcl
===================================================================
diff -u -r89b5047e54e47a88a7de75d8523a07ffa5743407 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/destroytest.tcl (.../destroytest.tcl) (revision 89b5047e54e47a88a7de75d8523a07ffa5743407)
+++ tests/destroytest.tcl (.../destroytest.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -3,7 +3,7 @@
Test parameter count 10
-::nx::core::alias ::nx::Object set -objscope ::set
+::nsf::alias ::nx::Object set -objscope ::set
Class create O -superclass Object {
:method init {} {
@@ -27,18 +27,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
:destroy
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBBB"
- ? {::nx::core::objectproperty c1 object} 1 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 0 "$::case object deleted"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 0 "$::case object deleted"
? "set ::firstDestroy" 1 "firstDestroy called"
@@ -52,18 +52,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
:destroy
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBBB"
- ? {::nx::core::objectproperty c1 object} 1 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 1 "$::case object deleted"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 1 "$::case object deleted"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
@@ -77,18 +77,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
[:info class] create [current]
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBBB"
- ? {::nx::core::objectproperty c1 object} 1 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 1 "$::case object deleted"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 1 "$::case object deleted"
? "set ::firstDestroy" 0 "firstDestroy called"
#
@@ -103,18 +103,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
rename [current] ""
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
- ? {::nx::core::objectproperty c1 object} 1 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 0 "$::case object still exists after proc"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 0 "$::case object still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
@@ -130,19 +130,19 @@
C method foo {} {
puts stderr "==== $::case [current]"
rename [current] ""
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
- ? {::nx::core::objectproperty c1 object} 1 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
+puts stderr ======[::nsf::objectproperty c1 object]
puts stderr ======[c1 set x]
-? {::nx::core::objectproperty c1 object} 1 "$::case object still exists after proc"
+? {::nsf::objectproperty c1 object} 1 "$::case object still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
@@ -158,18 +158,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
rename o [current]
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
- ? {::nx::core::objectproperty c1 object} 1 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 1 "$::case object still exists after proc"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 1 "$::case object still exists after proc"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
@@ -189,7 +189,7 @@
}
C create c1
c1 foo
-? {::nx::core::objectproperty c1 object} 1 "$::case object still exists after proc"
+? {::nsf::objectproperty c1 object} 1 "$::case object still exists after proc"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
@@ -209,28 +209,28 @@
C method foo {} {
puts stderr "==== $::case [current]"
namespace delete ::test
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#
# If the following line is commented in, the namespace is deleted
# here. Is there a bug with nsPtr->activationCount
#
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
- puts stderr "???? [current] exists [::nx::core::objectproperty [current] object]"
- ? "::nx::core::objectproperty [current] object" 0 ;# WHY?
- puts stderr "???? [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "???? [current] exists [::nsf::objectproperty [current] object]"
+ ? "::nsf::objectproperty [current] object" 0 ;# WHY?
+ puts stderr "???? [current] exists [::nsf::objectproperty [current] object]"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "$::case destroy not yet called"
}
}
test::C create test::c1
test::c1 foo
-puts stderr ======[::nx::core::objectproperty test::c1 object]
-? {::nx::core::objectproperty test::c1 object} 0 "object still exists after proc"
+puts stderr ======[::nsf::objectproperty test::c1 object]
+? {::nsf::objectproperty test::c1 object} 0 "object still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "destroy was called when poping stack frame"
-? {::nx::core::objectproperty ::test::C object} 0 "class still exists after proc"
+? {::nsf::objectproperty ::test::C object} 0 "class still exists after proc"
? {namespace exists ::test::C} 0 "namespace ::test::C still exists after proc"
? {namespace exists ::test} 1 "parent ::test namespace still exists after proc"
? {namespace exists ::xotcl::classes::test::C} 0 "namespace ::xotcl::classes::test::C still exists after proc"
@@ -249,25 +249,25 @@
C method foo {} {
puts stderr "==== $::case [current]"
namespace delete ::test
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#
# If the following line is commented in, the namespace is deleted
# here. Is there a bug with nsPtr->activationCount
#
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBBB"
- puts stderr "???? [current] exists [::nx::core::objectproperty [current] object]"
- ? "::nx::core::objectproperty [current] object" 0 "$::case object still exists in proc";# WHY?
- puts stderr "???? [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "???? [current] exists [::nsf::objectproperty [current] object]"
+ ? "::nsf::objectproperty [current] object" 0 "$::case object still exists in proc";# WHY?
+ puts stderr "???? [current] exists [::nsf::objectproperty [current] object]"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"; # NOT YET CALLED
}
}
test::C create test::c1
test::c1 foo
-puts stderr ======[::nx::core::objectproperty test::c1 object]
-? {::nx::core::objectproperty test::c1 object} 0 "$::case object still exists after proc"
+puts stderr ======[::nsf::objectproperty test::c1 object]
+? {::nsf::objectproperty test::c1 object} 0 "$::case object still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called" ;# toplevel destroy was blocked
@@ -287,20 +287,20 @@
puts stderr "AAAA"
# the following isobject call has a problem in Tcl_GetCommandFromObj(),
# which tries to access invalid memory
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBBB"
- ? {::nx::core::objectproperty ::o::c1 object} 0 "$::case object still exists in proc"
+ ? {::nsf::objectproperty ::o::c1 object} 0 "$::case object still exists in proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
}
C create o::c1
o::c1 foo
-puts stderr ======[::nx::core::objectproperty ::o::c1 object]
-? {::nx::core::objectproperty ::o::c1 object} 0 "$::case object o::c1 still exists after proc"
-? {::nx::core::objectproperty o object} 0 "$::case object o still exists after proc"
+puts stderr ======[::nsf::objectproperty ::o::c1 object]
+? {::nsf::objectproperty ::o::c1 object} 0 "$::case object o::c1 still exists after proc"
+? {::nsf::objectproperty o object} 0 "$::case object o still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
@@ -317,18 +317,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
o destroy
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
- ? {::nx::core::objectproperty ::o::c1 object} 0 "$::case object still exists in proc"
+ ? {::nsf::objectproperty ::o::c1 object} 0 "$::case object still exists in proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
}
C create o::c1
o::c1 foo
-puts stderr ======[::nx::core::objectproperty ::o::c1 object]
-? {::nx::core::objectproperty ::o::c1 object} 0 "$::case object still exists after proc"
+puts stderr ======[::nsf::objectproperty ::o::c1 object]
+? {::nsf::objectproperty ::o::c1 object} 0 "$::case object still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
@@ -345,18 +345,18 @@
C method foo {} {
puts stderr "==== $::case [current]"
proc [current] {args} {puts HELLO}
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
- ? {::nx::core::objectproperty c1 object} 0 "$::case object still exists in proc"
+ ? {::nsf::objectproperty c1 object} 0 "$::case object still exists in proc"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 0 "$::case object still exists after proc"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 0 "$::case object still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
@@ -372,22 +372,22 @@
C method foo {} {
puts stderr "==== $::case [current]"
C destroy
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
#? [:info class] ::xotcl::Object "object reclassed"
? [:info class] ::C "object reclassed?"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
- ? {::nx::core::objectproperty c1 object} 1 "object still exists in proc"
- #? {::nx::core::objectproperty ::C class} 0 "class still exists in proc"
- ? {::nx::core::objectproperty ::C class} 1 "class still exists in proc"
+ ? {::nsf::objectproperty c1 object} 1 "object still exists in proc"
+ #? {::nsf::objectproperty ::C class} 0 "class still exists in proc"
+ ? {::nsf::objectproperty ::C class} 1 "class still exists in proc"
}
C create c1
c1 foo
-puts stderr ======[::nx::core::objectproperty c1 object]
-? {::nx::core::objectproperty c1 object} 1 "object still exists after proc"
+puts stderr ======[::nsf::objectproperty c1 object]
+? {::nsf::objectproperty c1 object} 1 "object still exists after proc"
? [c1 info class] ::nx::Object "after proc: object reclassed?"
? "set ::firstDestroy" 0 "firstDestroy called"
? "set ::ObjectDestroy" 0 "ObjectDestroy called"
@@ -402,7 +402,7 @@
C method foo {} {
puts stderr "==== $::case [current]"
C destroy
- puts stderr "AAAA [current] exists [::nx::core::objectproperty [current] object]"
+ puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
puts stderr "BBB"
@@ -412,14 +412,14 @@
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
? [:info class] ::C "object reclassed"
#? [:info class] ::xotcl::Object "object reclassed"
- ? {::nx::core::objectproperty ::C::c1 object} 1 "object still exists in proc"
- ? {::nx::core::objectproperty ::C class} 1 "class still exists in proc"
+ ? {::nsf::objectproperty ::C::c1 object} 1 "object still exists in proc"
+ ? {::nsf::objectproperty ::C class} 1 "class still exists in proc"
}
C create ::C::c1
C::c1 foo
-#puts stderr ======[::nx::core::objectproperty ::C::c1 object]
-? {::nx::core::objectproperty ::C::c1 object} 0 "object still exists after proc"
-? {::nx::core::objectproperty ::C class} 0 "class still exists after proc"
+#puts stderr ======[::nsf::objectproperty ::C::c1 object]
+? {::nsf::objectproperty ::C::c1 object} 0 "object still exists after proc"
+? {::nsf::objectproperty ::C class} 0 "class still exists after proc"
? "set ::firstDestroy" 1 "firstDestroy called"
? "set ::ObjectDestroy" 1 "ObjectDestroy called"
@@ -429,14 +429,14 @@
Object create x
Object create x::y
x destroy
-? {::nx::core::objectproperty x object} 0 "parent object gone"
-? {::nx::core::objectproperty x::y object} 0 "child object gone"
+? {::nsf::objectproperty x object} 0 "parent object gone"
+? {::nsf::objectproperty x::y object} 0 "child object gone"
set case "deleting aliased object"
Test case deleting-aliased-object
Object create o
Object create o2
-::nx::core::alias o x o2
+::nsf::alias o x o2
? {o x} ::o2 "call object via alias"
? {o x info vars} "" "call info on aliased object"
? {o2 set x 10} 10 "set variable on object"
@@ -455,27 +455,27 @@
Test case deleting-object-with-alias-to-object
Object create o
Object create o3
-::nx::core::alias o x o3
+::nsf::alias o x o3
o destroy
-? {::nx::core::objectproperty o object} 0 "parent object gone"
-? {::nx::core::objectproperty o3 object} 1 "aliased object still here"
+? {::nsf::objectproperty o object} 0 "parent object gone"
+? {::nsf::objectproperty o3 object} 1 "aliased object still here"
o3 destroy
-? {::nx::core::objectproperty o3 object} 0 "aliased object destroyed"
+? {::nsf::objectproperty o3 object} 0 "aliased object destroyed"
set case "create an alias, and delete cmd via aggregation"
Test case create-alias-delete-via-aggregation
Object create o
Object create o3
-::nx::core::alias o x o3
+::nsf::alias o x o3
o::x destroy
-? {::nx::core::objectproperty o3 object} 0 "aliased object destroyed"
+? {::nsf::objectproperty o3 object} 0 "aliased object destroyed"
o destroy
set case "create an alias, and recreate obj"
Test case create-alias-and-recreate-obj
Object create o
Object create o3
-::nx::core::alias o x o3
+::nsf::alias o x o3
Object create o3
o3 set a 13
? {o x set a} 13 "aliased object works after recreate"
@@ -486,8 +486,8 @@
Class create C
Object create o
Object create o3
-::nx::core::alias o a o3
-::nx::core::alias C b o
+::nsf::alias o a o3
+::nsf::alias C b o
C create c1
? {c1 b set B 2} 2 "call 1st level"
? {c1 b a set A 3} 3 "call 2nd level"
@@ -505,12 +505,12 @@
Class create C
Object create o
Object create o3
-::nx::core::alias o a o3
-::nx::core::alias C b o
+::nsf::alias o a o3
+::nsf::alias C b o
C create c1
C destroy
-? {::nx::core::objectproperty o object} 1 "object o still here"
-? {::nx::core::objectproperty o3 object} 1 "object o3 still here"
+? {::nsf::objectproperty o object} 1 "object o still here"
+? {::nsf::objectproperty o3 object} 1 "object o3 still here"
o destroy
o3 destroy
c1 destroy
@@ -527,12 +527,12 @@
# reuse the namespace for a class/object
Class create ::module
- ? {::nx::core::objectproperty ::module class} 1
+ ? {::nsf::objectproperty ::module class} 1
# delete the object/class ... and namespace
::module destroy
- ? {::nx::core::objectproperty ::module class} 0
+ ? {::nsf::objectproperty ::module class} 0
}
Test case namespace-import {
@@ -546,25 +546,25 @@
Class create ::module {
:create mod1
}
- ? {::nx::core::objectproperty ::module::Foo class} 1
- ? {::nx::core::objectproperty ::module::foo class} 0
- ? {::nx::core::objectproperty ::module::foo object} 1
- ? {::nx::core::objectproperty ::module class} 1
+ ? {::nsf::objectproperty ::module::Foo class} 1
+ ? {::nsf::objectproperty ::module::foo class} 0
+ ? {::nsf::objectproperty ::module::foo object} 1
+ ? {::nsf::objectproperty ::module class} 1
Object create ::o { :requireNamespace }
namespace eval ::o {namespace import ::module::*}
- ? {::nx::core::objectproperty ::o::Foo class} 1
- ? {::nx::core::objectproperty ::o::foo object} 1
+ ? {::nsf::objectproperty ::o::Foo class} 1
+ ? {::nsf::objectproperty ::o::foo object} 1
# do not destroy namespace imported objects/classes
::o destroy
- ? {::nx::core::objectproperty ::o::Foo class} 0
- ? {::nx::core::objectproperty ::o::foo object} 0
+ ? {::nsf::objectproperty ::o::Foo class} 0
+ ? {::nsf::objectproperty ::o::foo object} 0
- ? {::nx::core::objectproperty ::module::Foo class} 1
- ? {::nx::core::objectproperty ::module::foo object} 1
+ ? {::nsf::objectproperty ::module::Foo class} 1
+ ? {::nsf::objectproperty ::module::foo object} 1
::module destroy
}
Index: tests/doc.tcl
===================================================================
diff -u -r30173337f3b4d0d9c224713b2c86c622b26f3046 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/doc.tcl (.../doc.tcl) (revision 30173337f3b4d0d9c224713b2c86c622b26f3046)
+++ tests/doc.tcl (.../doc.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -307,7 +307,7 @@
{@author gustaf.neumann@wu-wien.ac.at}
}
set entity [EntityClass process $block]
- ? [list ::nx::core::is $entity object] 1
+ ? [list ::nsf::is $entity object] 1
? [list $entity info is type ::nx::doc::@object] 1
? [list $entity @author] "stefan.sobernig@wu.ac.at gustaf.neumann@wu-wien.ac.at";
? [list $entity text] "some more text and another line for the description";
@@ -320,7 +320,7 @@
{@see ::o}
}
set entity [EntityClass process $block]
- ? [list ::nx::core::is $entity object] 1
+ ? [list ::nsf::is $entity object] 1
? [list $entity info is type ::nx::doc::@command] 1
? [list $entity text] "some text on the command";
? [list $entity @see] "::o";
@@ -360,21 +360,21 @@
eval $script
doc process ::Foo
set entity [@object id ::Foo]
- ? [list ::nx::core::is $entity object] 1
+ ? [list ::nsf::is $entity object] 1
? [list $entity info is type ::nx::doc::@object] 1
? [list $entity text] "The class Foo defines the behaviour for all Foo objects";
? [list $entity @author] "gustaf.neumann@wu-wien.ac.at ssoberni@wu.ac.at"
# TODO: Fix the [@param id] programming scheme to allow (a) for
# entities to be passed and the (b) documented structures
#set entity [@param id ::Foo class attr1]
set entity [@param id $entity attr1]
- ? [list ::nx::core::is $entity object] 1
+ ? [list ::nsf::is $entity object] 1
? [list $entity info is type ::nx::doc::@param] 1
? [list $entity @see] "::nx::Attribute ::nx::MetaSlot";
set entity [@method id ::Foo class foo]
? [list [@object id ::Foo] @method] $entity
- ? [list ::nx::core::is $entity object] 1
+ ? [list ::nsf::is $entity object] 1
? [list $entity info is type ::nx::doc::@method] 1
? [list $entity text] "This describes the foo method";
@@ -458,7 +458,7 @@
set i [doc process $script]
set entity [@object id ::Bar]
- ? [list $i eval [list ::nx::core::is $entity object]] 1
+ ? [list $i eval [list ::nsf::is $entity object]] 1
? [list $i eval [list $entity info is type ::nx::doc::@object]] 1
? [list $i eval [list $entity text]] "The class Bar defines the behaviour for all Bar objects";
? [list $i eval [list $entity @author]] "gustaf.neumann@wu-wien.ac.at ssoberni@wu.ac.at"
@@ -467,13 +467,13 @@
# entities to be passed and the (b) documented structures
#set entity [@param id ::Bar class attr1]
set entity [@param id $entity attr1]
- ? [list $i eval [list ::nx::core::is $entity object]] 1
+ ? [list $i eval [list ::nsf::is $entity object]] 1
? [list $i eval [list $entity info is type ::nx::doc::@param]] 1
? [list $i eval [list $entity @see]] "::nx::Attribute ::nx::MetaSlot";
set entity [@method id ::Bar class foo]
? [list $i eval [list [@object id ::Bar] @method]] $entity
- ? [list $i eval [list ::nx::core::is $entity object]] 1
+ ? [list $i eval [list ::nsf::is $entity object]] 1
? [list $i eval [list $entity info is type ::nx::doc::@method]] 1
? [list $i eval [list $entity text]] "This describes the foo method in the method body";
@@ -485,7 +485,7 @@
}
set entity [@method id ::Bar object foo]
? [list $i eval [list [@object id ::Bar] @object-method]] $entity
- ? [list $i eval [list ::nx::core::is $entity object]] 1
+ ? [list $i eval [list ::nsf::is $entity object]] 1
? [list $i eval [list $entity info is type ::nx::doc::@method]] 1
? [list $i eval [list $entity text]] "This describes the per-object foo method in the method body";
@@ -509,7 +509,7 @@
error $msg
}
}
- ? [list $i eval [list ::nx::core::is [@package id nx::doc] object]] 1
+ ? [list $i eval [list ::nsf::is [@package id nx::doc] object]] 1
puts stderr [$i eval [list [@package id nx::doc] text]]
puts stderr [$i eval [list [@package id nx::doc] @require]]
set path [file join /tmp nextdoc]
@@ -559,11 +559,11 @@
# TODO: is [autoname -instance] really needed?
# is autoname needed in Next Scripting?
- # TODO: why is XOTclNextObjCmd/::nx::core::next not in gentclAPI.decls?
+ # TODO: why is XOTclNextObjCmd/::nsf::next not in gentclAPI.decls?
# why should it be there? there are pros and cons, and very little benefit, or?
# TODO: where to locate the @ comments (in predefined.xotcl, in
- # gentclAPI.decls)? how to deal with ::nx::core::* vs. ::nx::*
+ # gentclAPI.decls)? how to deal with ::nsf::* vs. ::nx::*
# TODO: which values are returned from Object->configure() and
# passed to init()? how to document residualargs()?
@@ -584,7 +584,7 @@
# what means "keep". next scripting should be mininmal,
# "instvar" is not needed and error-prone. We have now
- # "::nx::var import" and ::nx::core::importvar
+ # "::nx::var import" and ::nsf::importvar
# (of you want, similar to variable or global).
# TODO: verify the use of filtersearch()? should it return a method
@@ -657,7 +657,7 @@
# what are member-creating operations? if you mean "method-creating methods"
# they should (in next scripting) (i.e. necessary for e.g. method modifiers).
- # TODO: the objectsystems subcommand of ::nx::core::configure does
+ # TODO: the objectsystems subcommand of ::nsf::configure does
# not really fit in there because it does not allow for configuring
# anything. it is a mere introspection-only command. relocate (can
# we extend standard [info] somehow, i.e., [info objectsystems]
@@ -680,8 +680,8 @@
# but there, the object property is just for quering.
# Another option is define and "info"
#
- # ::nx::core::info object OBJECT metaclass
- # ::nx::core::info objectsystems
+ # ::nsf::info object OBJECT metaclass
+ # ::nsf::info objectsystems
#
# but if we would fold these into tcl-info, conflicts with
# tcl will arise.
Index: tests/info-method.tcl
===================================================================
diff -u -r35c67391973a07983d0b0dfe70706e6a69fbdbfc -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/info-method.tcl (.../info-method.tcl) (revision 35c67391973a07983d0b0dfe70706e6a69fbdbfc)
+++ tests/info-method.tcl (.../info-method.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -36,7 +36,7 @@
? {c1 info method definition foo} "::c1 method foo {} {puts foo}"
? {c1 info callable -which foo} "::c1 method foo {} {puts foo}"
-? {C info method name m} "::nx::core::classes::C::m"
+? {C info method name m} "::nsf::classes::C::m"
? {C object info method name mpo} "::C::mpo"
? {C info method definition m} {::C method m x {return proc-[self proc]}}
Index: tests/interceptor-slot.tcl
===================================================================
diff -u -r183ec0e7c071586238bf5ed90a05dbbda91d4582 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/interceptor-slot.tcl (.../interceptor-slot.tcl) (revision 183ec0e7c071586238bf5ed90a05dbbda91d4582)
+++ tests/interceptor-slot.tcl (.../interceptor-slot.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -25,9 +25,9 @@
# per-object mixins
? {c1 info precedence} "::C ::nx::Object"
c1 mixin add M
-? {::nx::core::relation c1 object-mixin} ::M
+? {::nsf::relation c1 object-mixin} ::M
? {catch {c1 mixin UNKNOWN}} 1
-? {::nx::core::relation c1 object-mixin} "::M"
+? {::nsf::relation c1 object-mixin} "::M"
# add again the same mixin
c1 mixin add M
@@ -43,10 +43,10 @@
# adding, removing per-object mixins for classes through relation
# "object-mixin"
#
-::nx::core::relation C object-mixin M
+::nsf::relation C object-mixin M
? {C info precedence} "::M ::nx::Class ::nx::Object"
? {C object info mixin} "::M"
-::nx::core::relation C object-mixin ""
+::nsf::relation C object-mixin ""
? {C info precedence} "::nx::Class ::nx::Object"
#
@@ -83,9 +83,9 @@
#
C object mixin add M
? {C info precedence} "::M ::nx::Class ::nx::Object"
-? {::nx::core::relation C object-mixin} ::M
+? {::nsf::relation C object-mixin} ::M
? {catch {C object mixin add UNKNOWN}} 1
-? {::nx::core::relation C object-mixin} "::M"
+? {::nsf::relation C object-mixin} "::M"
C object mixin ""
? {C info precedence} "::nx::Class ::nx::Object"
Index: tests/method-modifiers.tcl
===================================================================
diff -u -r6166d76909482a0a4c1296cb959462d71c688922 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/method-modifiers.tcl (.../method-modifiers.tcl) (revision 6166d76909482a0a4c1296cb959462d71c688922)
+++ tests/method-modifiers.tcl (.../method-modifiers.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -62,7 +62,7 @@
C public setter s0
C protected setter s1
? {c1 s0 0} 0
-? {::nx::core::dispatch c1 s1 1} 1
+? {::nsf::dispatch c1 s1 1} 1
C object setter s3
? {C s3 3} 3
@@ -73,31 +73,31 @@
? {c2 plain_method} "plain_method"
? {c2 public_method} "public_method"
? {catch {c2 protected_method}} 1
- ? {::nx::core::dispatch c2 protected_method} "protected_method"
+ ? {::nsf::dispatch c2 protected_method} "protected_method"
}
# class level forwards
Test case class-level-forwards {
? {c2 plain_forward} "plain_method"
? {c2 public_forward} "public_method"
? {catch {c2 protected_forward}} 1
- ? {::nx::core::dispatch c2 protected_forward} "protected_method"
+ ? {::nsf::dispatch c2 protected_forward} "protected_method"
}
# class level setter
Test case class-level-setter {
? {c2 plain_setter 1} "1"
? {c2 public_setter 2} "2"
? {catch {c2 protected_setter 3}} 1
- ? {::nx::core::dispatch c2 protected_setter 4} "4"
+ ? {::nsf::dispatch c2 protected_setter 4} "4"
}
# class level alias ....TODO: wanted behavior of [current method]? not "plain_alias"?
Test case class-level-alias {
? {c2 plain_alias} "plain_method"
? {c2 public_alias} "public_method"
? {catch {c2 protected_alias}} 1
- ? {::nx::core::dispatch c2 protected_alias} "protected_method"
+ ? {::nsf::dispatch c2 protected_alias} "protected_method"
}
###########
@@ -107,31 +107,31 @@
? {C plain_object_method} "plain_object_method"
? {C public_object_method} "public_object_method"
? {catch {C protected_object_method}} 1
- ? {::nx::core::dispatch C protected_object_method} "protected_object_method"
+ ? {::nsf::dispatch C protected_object_method} "protected_object_method"
}
# class-object level forwards
Test case class-object-level-forwards {
? {C plain_object_forward} "plain_object_method"
? {C public_object_forward} "public_object_method"
? {catch {C protected_object_forward}} 1
- ? {::nx::core::dispatch C protected_object_forward} "protected_object_method"
+ ? {::nsf::dispatch C protected_object_forward} "protected_object_method"
}
# class-object level setter
Test case class-object-level-setter {
? {C plain_object_setter 1} "1"
? {C public_object_setter 2} "2"
? {catch {C protected_object_setter 3}} 1
- ? {::nx::core::dispatch C protected_object_setter 4} "4"
+ ? {::nsf::dispatch C protected_object_setter 4} "4"
}
# class-object level alias ....TODO: wanted behavior of [current method]? not "plain_alias"?
Test case class-object-level-alias {
? {C plain_object_alias} "plain_object_method"
? {C public_object_alias} "public_object_method"
? {catch {C protected_object_alias}} 1
- ? {::nx::core::dispatch C protected_object_alias} "protected_object_method"
+ ? {::nsf::dispatch C protected_object_alias} "protected_object_method"
}
###########
@@ -141,30 +141,30 @@
? {c1 plain_object_method} "plain_object_method"
? {c1 public_object_method} "public_object_method"
? {catch {c1 protected_object_method}} 1
- ? {::nx::core::dispatch c1 protected_object_method} "protected_object_method"
+ ? {::nsf::dispatch c1 protected_object_method} "protected_object_method"
}
# object level forwards
Test case object-level-forwards {
? {c1 plain_object_forward} "plain_object_method"
? {c1 public_object_forward} "public_object_method"
? {catch {c1 protected_object_forward}} 1
- ? {::nx::core::dispatch c1 protected_object_forward} "protected_object_method"
+ ? {::nsf::dispatch c1 protected_object_forward} "protected_object_method"
}
# object level setter
Test case object-level-setter
? {c1 plain_object_setter 1} "1"
? {c1 public_object_setter 2} "2"
? {catch {c1 protected_object_setter 3}} 1
-? {::nx::core::dispatch c1 protected_object_setter 4} "4"
+? {::nsf::dispatch c1 protected_object_setter 4} "4"
# object level alias ....TODO: wanted behavior of [current method]? not "plain_alias"?
Test case object-level-alias {
? {c1 plain_object_alias} "plain_object_method"
? {c1 public_object_alias} "public_object_method"
? {catch {c1 protected_object_alias}} 1
- ? {::nx::core::dispatch c1 protected_object_alias} "protected_object_method"
+ ? {::nsf::dispatch c1 protected_object_alias} "protected_object_method"
? {lsort [c1 info methods]} \
"plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter"
@@ -236,7 +236,7 @@
Class create C {
set x [:attribute a]
- ? [list set _ $x] "::nx::core::classes::C::a"
+ ? [list set _ $x] "::nsf::classes::C::a"
# attribute with default
:attribute {b b1}
Index: tests/mixinoftest.tcl
===================================================================
diff -u -r6821564a411db17e6c9c781910346e74591da6e5 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/mixinoftest.tcl (.../mixinoftest.tcl) (revision 6821564a411db17e6c9c781910346e74591da6e5)
+++ tests/mixinoftest.tcl (.../mixinoftest.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -314,7 +314,7 @@
# redefinition and softrecreate
###########################################
Test case pcm-redefine-soft
-::nx::core::configure softrecreate true
+::nsf::configure softrecreate true
Class create A
Class create B -mixin A
Class create C -superclass B
@@ -348,7 +348,7 @@
# with softrecreate off
###########################################
Test case precedence
-::nx::core::configure softrecreate false
+::nsf::configure softrecreate false
Class create O
Class create A -superclass O
Class create B -superclass A
@@ -380,7 +380,7 @@
# with softrecreate on
###########################################
Test case alternate-precedence
-::nx::core::configure softrecreate false
+::nsf::configure softrecreate false
Class create O
Class create A -superclass O
Class create B -superclass A
@@ -413,7 +413,7 @@
# with softrecreate on
###########################################
Test case recreate-precedence
-::nx::core::configure softrecreate true
+::nsf::configure softrecreate true
Class create O
Class create A -superclass O
Class create B -superclass A
@@ -445,7 +445,7 @@
# with softrecreate on
###########################################
Test case recreate-alternate-precedence
-::nx::core::configure softrecreate true
+::nsf::configure softrecreate true
Class create O
Class create A -superclass O
Class create B -superclass A
Index: tests/object-system.tcl
===================================================================
diff -u -r6821564a411db17e6c9c781910346e74591da6e5 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/object-system.tcl (.../object-system.tcl) (revision 6821564a411db17e6c9c781910346e74591da6e5)
+++ tests/object-system.tcl (.../object-system.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -16,58 +16,58 @@
}
}
-? {::nx::core::objectproperty Object object} 1
-? {::nx::core::objectproperty Object class} 1
-? {::nx::core::objectproperty Object metaclass} 0
+? {::nsf::objectproperty Object object} 1
+? {::nsf::objectproperty Object class} 1
+? {::nsf::objectproperty Object metaclass} 0
? {Object info superclass} ""
? {Object info class} ::nx::Class
-? {::nx::core::objectproperty Class object} 1
-? {::nx::core::objectproperty Class class} 1
-? {::nx::core::objectproperty Class metaclass} 1
+? {::nsf::objectproperty Class object} 1
+? {::nsf::objectproperty Class class} 1
+? {::nsf::objectproperty Class metaclass} 1
? {Class info superclass} ::nx::Object
? {Class info class} ::nx::Class
Object create o
-? {::nx::core::objectproperty Object object} 1
-? {::nx::core::objectproperty o class} 0
-? {::nx::core::objectproperty o metaclass} 0
+? {::nsf::objectproperty Object object} 1
+? {::nsf::objectproperty o class} 0
+? {::nsf::objectproperty o metaclass} 0
? {o info class} ::nx::Object
? {Object info instances o} ::o
? {Object info instances ::o} ::o
Class create C0
-? {::nx::core::objectproperty C0 class} 1
-? {::nx::core::objectproperty C0 metaclass} 0
+? {::nsf::objectproperty C0 class} 1
+? {::nsf::objectproperty C0 metaclass} 0
? {C0 info superclass} ::nx::Object
? {C0 info class} ::nx::Class
#? {lsort [Class info vars]} "__default_metaclass __default_superclass"
Class create M -superclass ::nx::Class
-? {::nx::core::objectproperty M object} 1
-? {::nx::core::objectproperty M class} 1
-? {::nx::core::objectproperty M metaclass} 1
+? {::nsf::objectproperty M object} 1
+? {::nsf::objectproperty M class} 1
+? {::nsf::objectproperty M metaclass} 1
? {M info superclass} ::nx::Class
? {M info class} ::nx::Class
M create C
-? {::nx::core::objectproperty C object} 1
-? {::nx::core::objectproperty C class} 1
-? {::nx::core::objectproperty C metaclass} 0
+? {::nsf::objectproperty C object} 1
+? {::nsf::objectproperty C class} 1
+? {::nsf::objectproperty C metaclass} 0
? {C info superclass} ::nx::Object
? {C info class} ::M
C create c1
-? {::nx::core::objectproperty c1 object} 1
-? {::nx::core::objectproperty c1 class} 0
-? {::nx::core::objectproperty c1 metaclass} 0
+? {::nsf::objectproperty c1 object} 1
+? {::nsf::objectproperty c1 class} 0
+? {::nsf::objectproperty c1 metaclass} 0
? {c1 info class} ::C
Class create M2 -superclass M
-? {::nx::core::objectproperty M2 object} 1
-? {::nx::core::objectproperty M2 class} 1
-? {::nx::core::objectproperty M2 metaclass} 1
+? {::nsf::objectproperty M2 object} 1
+? {::nsf::objectproperty M2 class} 1
+? {::nsf::objectproperty M2 metaclass} 1
? {M2 info superclass} ::M
? {M2 info class} ::nx::Class
@@ -78,38 +78,38 @@
# destroy meta-class M, reclass meta-class instances to the base
# meta-class and set subclass of M to the root meta-class
M destroy
-? {::nx::core::objectproperty C object} 1
-? {::nx::core::objectproperty C class} 1
-? {::nx::core::objectproperty C metaclass} 0
+? {::nsf::objectproperty C object} 1
+? {::nsf::objectproperty C class} 1
+? {::nsf::objectproperty C metaclass} 0
? {C info superclass} ::nx::Object
? {C info class} ::nx::Class
-? {::nx::core::objectproperty M2 metaclass} 1
+? {::nsf::objectproperty M2 metaclass} 1
? {M2 info superclass} ::nx::Class
? {m2 info superclass} ::nx::Object
? {m2 info class} ::M2
# destroy class M, reclass class instances to the base class
C destroy
-? {::nx::core::objectproperty c1 objec} 1
-? {::nx::core::objectproperty c1 class} 0
-? {::nx::core::objectproperty c1 metaclass} 0
+? {::nsf::objectproperty c1 objec} 1
+? {::nsf::objectproperty c1 class} 0
+? {::nsf::objectproperty c1 metaclass} 0
? {c1 info class} ::nx::Object
# basic parameter tests
Class create C -parameter {{x 1} {y 2}}
-? {::nx::core::objectproperty C object} 1
-? {::nx::core::objectproperty C::slot object} 1
+? {::nsf::objectproperty C object} 1
+? {::nsf::objectproperty C::slot object} 1
? {C info children} ::C::slot
C copy X
-? {::nx::core::objectproperty X object} 1
+? {::nsf::objectproperty X object} 1
? {X info vars} ""
? {C info vars} ""
-? {::nx::core::objectproperty X::slot object} 1
+? {::nsf::objectproperty X::slot object} 1
#? {C::slot info vars} __parameter
? {C info parameter} {{x 1} {y 2}}
@@ -125,75 +125,75 @@
o method bar {x} {return goo-$x}
# dispatch without colon names
-::nx::core::dispatch o eval set :x 1
+::nsf::dispatch o eval set :x 1
? {o info vars} x "simple dispatch has set variable x"
? {::nx::var set o x} 1 "simple dispatch has set variable x to 1"
-? {::nx::core::dispatch o foo} "goo" "simple dispatch with one arg works"
-? {::nx::core::dispatch o bar 1} "goo-1" "simple dispatch with two args works"
+? {::nsf::dispatch o foo} "goo" "simple dispatch with one arg works"
+? {::nsf::dispatch o bar 1} "goo-1" "simple dispatch with two args works"
o destroy
# dispatch with colon names
Object create o {set :x 1}
-::nx::core::dispatch ::o ::incr x
+::nsf::dispatch ::o ::incr x
? {o eval {set :x}} 1 "cmd dispatch without -objscope did not modify the instance variable"
-::nx::core::dispatch ::o -objscope ::incr x
+::nsf::dispatch ::o -objscope ::incr x
? {o eval {set :x}} 2 "cmd dispatch -objscope modifies the instance variable"
-? {catch {::nx::core::dispatch ::o -objscope ::xxx x}} 1 "cmd dispatch with unknown command"
+? {catch {::nsf::dispatch ::o -objscope ::xxx x}} 1 "cmd dispatch with unknown command"
o destroy
puts stderr ===MINI-OBJECTSYSTEM
# test object system
# create a minimal object system without internally dipatched methods
-::nx::core::createobjectsystem ::object ::class
+::nsf::createobjectsystem ::object ::class
-? {::nx::core::objectproperty ::object object} 1
-? {::nx::core::objectproperty ::object class} 1
-? {::nx::core::objectproperty ::object metaclass} 0
-? {::nx::core::relation ::object class} ::class
-? {::nx::core::relation ::object superclass} ""
+? {::nsf::objectproperty ::object object} 1
+? {::nsf::objectproperty ::object class} 1
+? {::nsf::objectproperty ::object metaclass} 0
+? {::nsf::relation ::object class} ::class
+? {::nsf::relation ::object superclass} ""
-? {::nx::core::objectproperty ::class object} 1
-? {::nx::core::objectproperty ::class class} 1
-? {::nx::core::objectproperty ::class metaclass} 1
-? {::nx::core::relation ::class class} ::class
-? {::nx::core::relation ::class superclass} ::object
+? {::nsf::objectproperty ::class object} 1
+? {::nsf::objectproperty ::class class} 1
+? {::nsf::objectproperty ::class metaclass} 1
+? {::nsf::relation ::class class} ::class
+? {::nsf::relation ::class superclass} ::object
# define non-standard methos to create/destroy objects and classes
-::nx::core::alias ::class + ::nx::core::cmd::Class::create
-::nx::core::alias ::object - ::nx::core::cmd::Object::destroy
+::nsf::alias ::class + ::nsf::cmd::Class::create
+::nsf::alias ::object - ::nsf::cmd::Object::destroy
# create a class named C
::class + C
-? {::nx::core::objectproperty ::C object} 1
-? {::nx::core::objectproperty ::C class} 1
-? {::nx::core::objectproperty ::C metaclass} 0
-? {::nx::core::relation ::C class} ::class
-? {::nx::core::relation ::C superclass} ::object
+? {::nsf::objectproperty ::C object} 1
+? {::nsf::objectproperty ::C class} 1
+? {::nsf::objectproperty ::C metaclass} 0
+? {::nsf::relation ::C class} ::class
+? {::nsf::relation ::C superclass} ::object
# create an instance of C
C + c1
-? {::nx::core::objectproperty ::c1 object} 1
-? {::nx::core::objectproperty ::c1 class} 0
-? {::nx::core::objectproperty ::c1 metaclass} 0
-? {::nx::core::relation ::c1 class} ::C
+? {::nsf::objectproperty ::c1 object} 1
+? {::nsf::objectproperty ::c1 class} 0
+? {::nsf::objectproperty ::c1 metaclass} 0
+? {::nsf::relation ::c1 class} ::C
# destroy instance and class
c1 -
-? {::nx::core::objectproperty ::c1 object} 0
-? {::nx::core::objectproperty ::C class} 1
+? {::nsf::objectproperty ::c1 object} 0
+? {::nsf::objectproperty ::C class} 1
C -
-? {::nx::core::objectproperty ::C class} 0
+? {::nsf::objectproperty ::C class} 0
::nx::Class create ::C
-? {catch {::nx::core::objectproperty ::C type ::UNKNOWN}} 1
+? {catch {::nsf::objectproperty ::C type ::UNKNOWN}} 1
? {catch {::C info is type ::xyz::Bar}} 1
-? {catch {::nx::core::objectproperty ::CCCC type ::nx::Object}} 1
+? {catch {::nsf::objectproperty ::CCCC type ::nx::Object}} 1
::C destroy
Index: tests/parameters.tcl
===================================================================
diff -u -r6166d76909482a0a4c1296cb959462d71c688922 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/parameters.tcl (.../parameters.tcl) (revision 6166d76909482a0a4c1296cb959462d71c688922)
+++ tests/parameters.tcl (.../parameters.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -7,9 +7,9 @@
set o [Object create o]
puts o=$o
- ? {::nx::core::objectproperty ::o object} 1
+ ? {::nsf::objectproperty ::o object} 1
}
-? {::nx::core::objectproperty ::o object} 0
+? {::nsf::objectproperty ::o object} 0
#exit
#######################################################
@@ -24,49 +24,49 @@
Class create M
c1 mixin M
- ? {::nx::core::parametercheck object o1} 1
- ? {::nx::core::parametercheck integer 1} 1
+ ? {::nsf::parametercheck object o1} 1
+ ? {::nsf::parametercheck integer 1} 1
- ? {::nx::core::objectproperty o1 object} 1
- ? {::nx::core::objectproperty c1 type C} 1
+ ? {::nsf::objectproperty o1 object} 1
+ ? {::nsf::objectproperty c1 type C} 1
- ? {::nx::core::is c1 object -type C} 1
- ? {::nx::core::is c1 object -hasmixin M -type C} 1
- ? {::nx::core::is c1 object -hasmixin M1 -type C} 0
- ? {::nx::core::is c1 object -hasmixin M -type C0} 0
- ? {::nx::core::is o1 object} 1
- ? {::nx::core::is 1 integer} 1
- ? {::nx::core::is c1 type C} 1
- ? {::nx::core::is o type C} 0
- ? {::nx::core::is o object -type C} 0
- ? {::nx::core::is o object -hasmixin C} 0
+ ? {::nsf::is c1 object -type C} 1
+ ? {::nsf::is c1 object -hasmixin M -type C} 1
+ ? {::nsf::is c1 object -hasmixin M1 -type C} 0
+ ? {::nsf::is c1 object -hasmixin M -type C0} 0
+ ? {::nsf::is o1 object} 1
+ ? {::nsf::is 1 integer} 1
+ ? {::nsf::is c1 type C} 1
+ ? {::nsf::is o type C} 0
+ ? {::nsf::is o object -type C} 0
+ ? {::nsf::is o object -hasmixin C} 0
#exit
- ? {::nx::core::parametercheck class o1} {expected class but got "o1" for parameter value}
- ? {::nx::core::parametercheck -nocomplain class o1} 0
- ? {::nx::core::parametercheck class Test} 1
- ? {::nx::core::parametercheck object,multivalued [list o1 Test]} 1
+ ? {::nsf::parametercheck class o1} {expected class but got "o1" for parameter value}
+ ? {::nsf::parametercheck -nocomplain class o1} 0
+ ? {::nsf::parametercheck class Test} 1
+ ? {::nsf::parametercheck object,multivalued [list o1 Test]} 1
- ? {::nx::core::parametercheck integer,multivalued [list 1 2 3]} 1
- ? {::nx::core::parametercheck integer,multivalued [list 1 2 3 a]} \
+ ? {::nsf::parametercheck integer,multivalued [list 1 2 3]} 1
+ ? {::nsf::parametercheck integer,multivalued [list 1 2 3 a]} \
{invalid value in "1 2 3 a": expected integer but got "a" for parameter value}
- ? {::nx::core::parametercheck object,type=::C c1} 1
- ? {::nx::core::parametercheck object,type=::C o} \
+ ? {::nsf::parametercheck object,type=::C c1} 1
+ ? {::nsf::parametercheck object,type=::C o} \
{expected object but got "o" for parameter value} \
"object, but different type"
- ? {::nx::core::parametercheck object,type=::C c} \
+ ? {::nsf::parametercheck object,type=::C c} \
{expected object but got "c" for parameter value} \
"no object"
- ? {::nx::core::parametercheck object,type=::nx::Object c1} 1 "general type"
+ ? {::nsf::parametercheck object,type=::nx::Object c1} 1 "general type"
# do not allow "currently unknown" user defined types in parametercheck
- ? {::nx::core::parametercheck in1 aaa} {invalid value constraints "in1"}
+ ? {::nsf::parametercheck in1 aaa} {invalid value constraints "in1"}
- ? {::nx::core::parametercheck lower c} 1 "lower case char"
- ? {::nx::core::parametercheck lower abc} 1 "lower case chars"
- ? {::nx::core::parametercheck lower Abc} {expected lower but got "Abc" for parameter value}
+ ? {::nsf::parametercheck lower c} 1 "lower case char"
+ ? {::nsf::parametercheck lower abc} 1 "lower case chars"
+ ? {::nsf::parametercheck lower Abc} {expected lower but got "Abc" for parameter value}
? {string is lower abc} 1 "tcl command 'string is lower'"
- ? {::nx::core::parametercheck {i:integer 1} 2} {invalid value constraints "i:integer 1"}
+ ? {::nsf::parametercheck {i:integer 1} 2} {invalid value constraints "i:integer 1"}
}
#######################################################
@@ -81,7 +81,7 @@
}
}
- ? {::nx::core::parametercheck sex,slot=::paramManager female} "1"
+ ? {::nsf::parametercheck sex,slot=::paramManager female} "1"
}
#######################################################
# cononical feature table
@@ -291,7 +291,7 @@
"don't allow relation option as method parameter"
? {D method foo {a:double} {return $a}} \
- {::nx::core::classes::D::foo} \
+ {::nsf::classes::D::foo} \
"allow 'string is XXXX' for argument checking"
? {d1 foo 1} 1 "check int as double"
? {d1 foo 1.1} 1.1 "check double as double"
@@ -867,11 +867,11 @@
# values into emtpy strings.
}
- ? {::nx::core::parametercheck mType,slot=::tmpObj,multivalued {1 0}} \
+ ? {::nsf::parametercheck mType,slot=::tmpObj,multivalued {1 0}} \
{invalid value in "1 0": expected false but got 1} \
"fail on first value"
- ? {::nx::core::parametercheck mType,slot=::tmpObj,multivalued {0 0 0}} 1 "all pass"
- ? {::nx::core::parametercheck mType,slot=::tmpObj,multivalued {0 1}} \
+ ? {::nsf::parametercheck mType,slot=::tmpObj,multivalued {0 0 0}} 1 "all pass"
+ ? {::nsf::parametercheck mType,slot=::tmpObj,multivalued {0 1}} \
{invalid value in "0 1": expected false but got 1} \
"fail o last value"
}
@@ -891,7 +891,7 @@
}
}
- ? {::nx::core::parametercheck integer,slot=::mySlot 1} 1
+ ? {::nsf::parametercheck integer,slot=::mySlot 1} 1
? {o foo 3} 4
}
@@ -926,17 +926,17 @@
Object create o
Class create C
- ? {::nx::core::setter o a} "::o::a"
- ? {::nx::core::setter C c} "::nx::core::classes::C::c"
+ ? {::nsf::setter o a} "::o::a"
+ ? {::nsf::setter C c} "::nsf::classes::C::c"
? {o info method definition a} "::o setter a"
? {o info method parameter a} "a"
? {o info method args a} "a"
? {C info method definition c} "::C setter c"
? {o a 1} "1"
- ? {::nx::core::setter o a:integer} "::o::a"
- ? {::nx::core::setter o ints:integer,multivalued} "::o::ints"
- ? {::nx::core::setter o o:object} "::o::o"
+ ? {::nsf::setter o a:integer} "::o::a"
+ ? {::nsf::setter o ints:integer,multivalued} "::o::ints"
+ ? {::nsf::setter o o:object} "::o::o"
? {o info method name ints} "::o::ints"
? {o info method definition ints} "::o setter ints:integer,multivalued"
@@ -954,8 +954,8 @@
? {o ints {10 100 1000}} {10 100 1000}
? {o ints hugo} {invalid value in "hugo": expected integer but got "hugo" for parameter ints}
? {o o o} o
- ? {::nx::core::setter o {d default}} {parameter "d" is not allowed to have default "default"}
- ? {::nx::core::setter o -x} {method name "-x" must not start with a dash}
+ ? {::nsf::setter o {d default}} {parameter "d" is not allowed to have default "default"}
+ ? {::nsf::setter o -x} {method name "-x" must not start with a dash}
}
#######################################################
Index: tests/protected.tcl
===================================================================
diff -u -r6166d76909482a0a4c1296cb959462d71c688922 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/protected.tcl (.../protected.tcl) (revision 6166d76909482a0a4c1296cb959462d71c688922)
+++ tests/protected.tcl (.../protected.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -24,19 +24,19 @@
? {c1 bar-SET} {1}
? {c1 bar-foo} {foo}
-::nx::core::methodproperty C SET protected true
+::nsf::methodproperty C SET protected true
? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
-? {::nx::core::dispatch c1 SET x 2} {2} "dispatch of protected methods works"
+? {::nsf::dispatch c1 SET x 2} {2} "dispatch of protected methods works"
? {c1 foo} {foo}
? {c1 bar} {bar}
? {c1 bar-SET} {1}
? {c1 bar-foo} {foo}
? {catch {c2 bar-SET} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
? {c2 bar-foo} {foo}
-::nx::core::methodproperty C foo protected true
+::nsf::methodproperty C foo protected true
? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
-? {::nx::core::dispatch c1 SET x 2} {2} "dispatch of protected methods works"
+? {::nsf::dispatch c1 SET x 2} {2} "dispatch of protected methods works"
? {c1 bar} {bar} "other method work"
? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
? {c1 bar-SET} {1} "internal call of protected C implementend method"
@@ -45,15 +45,15 @@
? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
# unset protected
-? {::nx::core::methodproperty C SET protected} 1
-::nx::core::methodproperty C SET protected false
-? {::nx::core::methodproperty C SET protected} 0
-? {::nx::core::methodproperty C foo protected} 1
-::nx::core::methodproperty C foo protected false
-? {::nx::core::methodproperty C foo protected} 0
+? {::nsf::methodproperty C SET protected} 1
+::nsf::methodproperty C SET protected false
+? {::nsf::methodproperty C SET protected} 0
+? {::nsf::methodproperty C foo protected} 1
+::nsf::methodproperty C foo protected false
+? {::nsf::methodproperty C foo protected} 0
? {c1 SET x 3} 3
-? {::nx::core::dispatch c1 SET x 2} {2}
+? {::nsf::dispatch c1 SET x 2} {2}
? {c1 foo} {foo}
? {c1 bar} {bar}
? {c1 bar-SET} {1}
@@ -63,27 +63,27 @@
# define a protected method
C protected method foo {} {return [current method]}
-? {::nx::core::methodproperty C SET protected} 0
+? {::nsf::methodproperty C SET protected} 0
? {c1 SET x 3} 3
-? {::nx::core::dispatch c1 SET x 4} {4}
+? {::nsf::dispatch c1 SET x 4} {4}
? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
? {c1 bar} {bar}
? {c1 bar-SET} {1}
? {c1 bar-foo} foo
? {c2 bar-SET} 1
? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
-? {::nx::core::methodproperty C SET redefine-protected true} 1
+? {::nsf::methodproperty C SET redefine-protected true} 1
? {catch {C method SET {a b c} {...}} errorMsg; set errorMsg} \
{Method 'SET' of ::C can not be overwritten. Derive e.g. a sub-class!}
-? {::nx::core::methodproperty C foo redefine-protected true} 1
+? {::nsf::methodproperty C foo redefine-protected true} 1
? {catch {C method foo {a b c} {...}} errorMsg; set errorMsg} \
{Method 'foo' of ::C can not be overwritten. Derive e.g. a sub-class!}
# check a predefined protection
? {catch {::nx::Class method dealloc {a b c} {...}} errorMsg; set errorMsg} \
{Method 'dealloc' of ::nx::Class can not be overwritten. Derive e.g. a sub-class!}
# try to redefined via alias
-? {catch {::nx::core::alias Class dealloc ::set} errorMsg; set errorMsg} \
+? {catch {::nsf::alias Class dealloc ::set} errorMsg; set errorMsg} \
{Method 'dealloc' of ::nx::Class can not be overwritten. Derive e.g. a sub-class!}
# try to redefine via forward
? {catch {C forward SET ::set} errorMsg; set errorMsg} \
@@ -95,7 +95,7 @@
# overwrite-protect object specific method
Object create o
o method foo {} {return 13}
-::nx::core::methodproperty o foo redefine-protected true
+::nsf::methodproperty o foo redefine-protected true
? {catch {o method foo {} {return 14}} errorMsg; set errorMsg} \
{Method 'foo' of ::o can not be overwritten. Derive e.g. a sub-class!}
Index: tests/var-access.tcl
===================================================================
diff -u -rafc4ba278d628aaa440e2f8d84c4ef46c380a8ab -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/var-access.tcl (.../var-access.tcl) (revision afc4ba278d628aaa440e2f8d84c4ef46c380a8ab)
+++ tests/var-access.tcl (.../var-access.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -3,16 +3,16 @@
namespace eval ::nx::var1 {
namespace ensemble create -map {
- exists ::nx::core::existsvar
- import ::nx::core::importvar
- set ::nx::core::setvar
+ exists ::nsf::existsvar
+ import ::nsf::importvar
+ set ::nsf::setvar
}
}
::nx::Object create ::nx::var2 {
- :alias exists ::nx::core::existsvar
- :alias import ::nx::core::importvar
- :alias set ::nx::core::setvar
+ :alias exists ::nsf::existsvar
+ :alias import ::nsf::importvar
+ :alias set ::nsf::setvar
}
Test parameter count 10000
@@ -29,7 +29,7 @@
o eval {incr :x}
}
:method foo2 {} {
- ::nx::core::importvar o x
+ ::nsf::importvar o x
incr x
}
:method foo3 {} {
@@ -42,9 +42,9 @@
}
}
- ? {::nx::core::setvar o x} 1
- ? {::nx::core::existsvar o x} 1
- ? {::nx::core::existsvar o y} 0
+ ? {::nsf::setvar o x} 1
+ ? {::nsf::existsvar o x} 1
+ ? {::nsf::existsvar o y} 0
? {::nx::var1 set o x} 1
? {::nx::var1 exists o x} 1
@@ -57,16 +57,16 @@
? {p foo0} 2
? {p foo1} 2
- ? {::nx::core::setvar o x} 10002
+ ? {::nsf::setvar o x} 10002
? {p foo2} 10003
- ? {::nx::core::setvar o x} 20003
+ ? {::nsf::setvar o x} 20003
? {p foo3} 20004
- ? {::nx::core::setvar o x} 30004
+ ? {::nsf::setvar o x} 30004
? {p foo4} 30005
- ? {::nx::core::setvar o x} 40005
+ ? {::nsf::setvar o x} 40005
}
puts stderr =====END
Index: tests/varresolutiontest.tcl
===================================================================
diff -u -r89b5047e54e47a88a7de75d8523a07ffa5743407 -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92
--- tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision 89b5047e54e47a88a7de75d8523a07ffa5743407)
+++ tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92)
@@ -5,12 +5,12 @@
Test parameter count 1
-::nx::core::alias ::nx::Object objeval -objscope ::eval
-::nx::core::alias ::nx::Object array -objscope ::array
-::nx::core::alias ::nx::Object lappend -objscope ::lappend
-::nx::core::alias ::nx::Object incr -objscope ::incr
-::nx::core::alias ::nx::Object set -objscope ::set
-::nx::core::alias ::nx::Object unset -objscope ::unset
+::nsf::alias ::nx::Object objeval -objscope ::eval
+::nsf::alias ::nx::Object array -objscope ::array
+::nsf::alias ::nx::Object lappend -objscope ::lappend
+::nsf::alias ::nx::Object incr -objscope ::incr
+::nsf::alias ::nx::Object set -objscope ::set
+::nsf::alias ::nx::Object unset -objscope ::unset
###########################################
# Basic tests for var resolution under
@@ -47,7 +47,7 @@
# vartables on the stack
:requireNamespace
global g
- ::nx::core::importvar o2 i
+ ::nsf::importvar o2 i
set x 1
set :y 2
set ::z 3
@@ -56,28 +56,28 @@
set :a(:b) 1
set :a(::c) 1
}
-? {::nx::core::importvar o2 j} \
+? {::nsf::importvar o2 j} \
"importvar cannot import variable 'j' into method scope; not called from a method frame"
-o method foo {} {::nx::core::importvar [current] :a}
+o method foo {} {::nsf::importvar [current] :a}
? {o foo} "variable name \":a\" must not contain namespace separator or colon prefix"
-o method foo {} {::nx::core::importvar [current] ::a}
+o method foo {} {::nsf::importvar [current] ::a}
? {o foo} "variable name \"::a\" must not contain namespace separator or colon prefix"
-o method foo {} {::nx::core::importvar [current] a(:b)}
+o method foo {} {::nsf::importvar [current] a(:b)}
? {o foo} "can't make instance variable a(:b) on ::o: Variable cannot be an element in an array; use e.g. an alias."
-o method foo {} {::nx::core::importvar [current] {a(:b) ab}}
+o method foo {} {::nsf::importvar [current] {a(:b) ab}}
? {o foo} ""
-o method foo {} {::nx::core::existsvar [current] ::a}
+o method foo {} {::nsf::existsvar [current] ::a}
? {o foo} "variable name \"::a\" must not contain namespace separator or colon prefix"
-o method foo {} {::nx::core::existsvar [current] a(:b)}
+o method foo {} {::nsf::existsvar [current] a(:b)}
? {o foo} 1
-o method foo {} {::nx::core::existsvar [current] a(::c)}
+o method foo {} {::nsf::existsvar [current] a(::c)}
? {o foo} 1
set ::o::Y 5
@@ -105,7 +105,7 @@
Object create o {
:requireNamespace
global g
- ::nx::core::importvar o2 i
+ ::nsf::importvar o2 i
set x 1
set :y 2
set ::z 3
@@ -169,7 +169,7 @@
? {::o set x} 3
? {namespace eval ::o {info exists x}} 1
? {::o unset x} ""
-? {::nx::core::existsvar o x} 0
+? {::nsf::existsvar o x} 0
? {o eval {info exists :x}} 0
? {info vars ::x} ""
? {namespace eval ::o {info exists x}} 0
@@ -400,13 +400,13 @@
array set ::tmpArray {key value}
Class create ::C
-::nx::core::alias ::C Set -objscope ::set
-::nx::core::alias ::C Unset -objscope ::unset
+::nsf::alias ::C Set -objscope ::set
+::nsf::alias ::C Unset -objscope ::unset
::C create ::c
namespace eval ::c {}
? {namespace exists ::c} 1
-? {::nx::core::objectproperty ::c object} 1
+? {::nsf::objectproperty ::c object} 1
? {::c info hasnamespace} 0
? {::c Set w 2; expr {[::c Set w] == $::w}} 0
@@ -428,9 +428,9 @@
# with a required namespace and without
##################################################
Test case eval-variants
-::nx::core::alias ::nx::Object objeval -objscope ::eval
-::nx::core::alias ::nx::Object softeval -nonleaf ::eval
-::nx::core::alias ::nx::Object softeval2 ::eval
+::nsf::alias ::nx::Object objeval -objscope ::eval
+::nsf::alias ::nx::Object softeval -nonleaf ::eval
+::nsf::alias ::nx::Object softeval2 ::eval
set G 1
@@ -592,9 +592,9 @@
# Test with proc scopes
##################################################
Test case proc-scopes
-::nx::core::alias ::nx::Object objscoped-eval -objscope ::eval
-::nx::core::alias ::nx::Object nonleaf-eval -nonleaf ::eval
-::nx::core::alias ::nx::Object plain-eval ::eval
+::nsf::alias ::nx::Object objscoped-eval -objscope ::eval
+::nsf::alias ::nx::Object nonleaf-eval -nonleaf ::eval
+::nsf::alias ::nx::Object plain-eval ::eval
proc foo-via-initcmd {} {
foreach v {x xxx} {unset -nocomplain ::$v}
@@ -690,10 +690,10 @@
Class create M2
C mixin M1
- ? {::nx::core::relation C class-mixin} "::module::M1"
+ ? {::nsf::relation C class-mixin} "::module::M1"
C mixin add M2
- ? {::nx::core::relation C class-mixin} "::module::M2 ::module::M1"
+ ? {::nsf::relation C class-mixin} "::module::M2 ::module::M1"
}