Index: generic/predefined.h =================================================================== diff -u -rf0f0b5422a37c8d05f6b835de37fda6bb7347dfd -rdaafc0f0261f6b47a01c7cc8975acdd66f91f360 --- generic/predefined.h (.../predefined.h) (revision f0f0b5422a37c8d05f6b835de37fda6bb7347dfd) +++ generic/predefined.h (.../predefined.h) (revision daafc0f0261f6b47a01c7cc8975acdd66f91f360) @@ -21,7 +21,7 @@ "namespace import ::nx::core::next ::nx::core::self\n" "foreach cmd [info command ::nx::core::cmd::Object::*] {\n" "set cmdName [namespace tail $cmd]\n" -"if {$cmdName in [list \"instvar\"]} continue\n" +"if {$cmdName in [list \"exists\" \"instvar\"]} continue\n" "::nx::core::alias Object $cmdName $cmd}\n" "::nx::core::alias Object eval -nonleaf ::eval\n" "foreach cmd [info command ::nx::core::cmd::Class::*] {\n" @@ -160,7 +160,8 @@ "if {![::nx::core::objectproperty ${slotParent} object]} {\n" "::nx::Object create ${slotParent}}\n" "return ${slotParent}::$name}\n" -"::nx::MetaSlot method createFromParameterSyntax {target -per-object:switch\n" +"::nx::MetaSlot method createFromParameterSyntax {\n" +"target -per-object:switch\n" "{-initblock \"\"}\n" "value default:optional} {\n" "set opts [list]\n" @@ -207,7 +208,7 @@ "if {[llength $att]>1} {foreach {att default} $att break}\n" "if {[info exists default]} {\n" "foreach i [::nx::core::cmd::ClassInfo::instances $class] {\n" -"if {![$i exists $att]} {\n" +"if {![::nx::core::existsvar $i $att]} {\n" "if {[string match {*\\[*\\]*} $default]} {\n" "set value [::nx::core::dispatch $i -objscope ::eval subst $default]} else {\n" "set value $default}\n" @@ -232,7 +233,7 @@ "::nx::ObjectParameterSlot public method add {obj prop value {pos 0}} {\n" "if {![set :multivalued]} {\n" "error \"Property $prop of [set :domain]->$obj ist not multivalued\"}\n" -"if {[$obj exists $prop]} {\n" +"if {[::nx::core::existsvar $obj $prop]} {\n" "::nx::core::setvar $obj $prop [linsert [::nx::core::setvar $obj $prop] $pos $value]} else {\n" "::nx::core::setvar $obj $prop [list $value]}}\n" "::nx::ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} {\n" @@ -382,6 +383,7 @@ "::nx::core::register_system_slots ::nx\n" "proc ::nx::core::register_system_slots {} {}\n" "::nx::MetaSlot __invalidateobjectparameter\n" +"# @param incremental Allows for using the fine-grained modification (i.e., setting) of the managed variable {e.g., through an incremental {{{add}}})\n" "::nx::MetaSlot create ::nx::Attribute -superclass ::nx::ObjectParameterSlot\n" "createBootstrapAttributeSlots ::nx::Attribute {\n" "{value_check once}\n" @@ -400,9 +402,9 @@ "::nx::Attribute protected method init {} {\n" "::nx::core::next ;# do first ordinary slot initialization\n" "set __initcmd \"\"\n" -"if {[:exists default]} {} elseif [:exists initcmd] {\n" +"if {[info exists :default]} {} elseif [info exists :initcmd] {\n" "append __initcmd \":trace add variable [list ${:name}] read \\\n" -"\\[list [::nx::core::current object] __default_from_cmd \\[::nx::core::current object\\] [list [set :initcmd]]\\]\\n\"} elseif [:exists valuecmd] {\n" +"\\[list [::nx::core::current object] __default_from_cmd \\[::nx::core::current object\\] [list [set :initcmd]]\\]\\n\"} elseif [info exists :valuecmd] {\n" "append __initcmd \":trace add variable [list ${:name}] read \\\n" "\\[list [::nx::core::current object] __value_from_cmd \\[::nx::core::current object\\] [list [set :valuecmd]]\\]\"}\n" "array set \"\" [:toParameterSyntax ${:name}]\n" @@ -414,7 +416,7 @@ "::nx::core::next}} else {\n" ":method assign [list obj var value:$(mparam),slot=[::nx::core::current object]] {\n" "::nx::core::setvar $obj $var $value}}}\n" -"if {[:exists valuechangedcmd]} {\n" +"if {[info exists :valuechangedcmd]} {\n" "append __initcmd \":trace add variable [list ${:name}] write \\\n" "\\[list [::nx::core::current object] __value_changed_cmd \\[::nx::core::current object\\] [list [set :valuechangedcmd]]\\]\"}\n" "if {$__initcmd ne \"\"} {\n" Index: generic/predefined.xotcl =================================================================== diff -u -rf0f0b5422a37c8d05f6b835de37fda6bb7347dfd -rdaafc0f0261f6b47a01c7cc8975acdd66f91f360 --- generic/predefined.xotcl (.../predefined.xotcl) (revision f0f0b5422a37c8d05f6b835de37fda6bb7347dfd) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision daafc0f0261f6b47a01c7cc8975acdd66f91f360) @@ -42,7 +42,7 @@ # foreach cmd [info command ::nx::core::cmd::Object::*] { set cmdName [namespace tail $cmd] - if {$cmdName in [list "instvar"]} continue + if {$cmdName in [list "exists" "instvar"]} continue ::nx::core::alias Object $cmdName $cmd } @@ -445,9 +445,11 @@ return ${slotParent}::$name } - ::nx::MetaSlot method createFromParameterSyntax {target -per-object:switch - {-initblock ""} - value default:optional} { + ::nx::MetaSlot method createFromParameterSyntax { + target -per-object:switch + {-initblock ""} + value default:optional + } { set opts [list] set colonPos [string first : $value] if {$colonPos == -1} { @@ -518,7 +520,7 @@ # 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} @@ -541,7 +543,7 @@ # checking subclasses is not required during bootstrap foreach i [::nx::core::cmd::ClassInfo::instances $class] { - if {![$i exists $att]} { + if {![::nx::core::existsvar $i $att]} { if {[string match {*\[*\]*} $default]} { set value [::nx::core::dispatch $i -objscope ::eval subst $default] } else { @@ -557,8 +559,7 @@ #puts stderr "Bootstrapslot for $class calls __invalidateobjectparameter" $class __invalidateobjectparameter } - - + ############################################ # Define slots for slots ############################################ @@ -619,6 +620,7 @@ # # 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 [::nx::core::current object]]"} {methodname} @@ -639,7 +641,7 @@ if {![set :multivalued]} { error "Property $prop of [set :domain]->$obj ist not multivalued" } - if {[$obj exists $prop]} { + if {[::nx::core::existsvar $obj $prop]} { ::nx::core::setvar $obj $prop [linsert [::nx::core::setvar $obj $prop] $pos $value] } else { ::nx::core::setvar $obj $prop [list $value] @@ -692,7 +694,7 @@ ${:methodname} } } - + ################################################################# # We have no working objectparameter yet, since it requires a # minimal slot infrastructure to build object parameters from @@ -775,7 +777,8 @@ #puts stderr "[::nx::core::current method] ${name} returns [list oparam $objparamdefinition mparam $methodparamdefinition]" return [list oparam $objparamdefinition mparam $methodparamdefinition] } - + + proc ::nx::core::parametersFromSlots {obj} { set parameterdefinitions [list] foreach slot [::nx::objectInfo slotobjects $obj] { @@ -789,7 +792,7 @@ } return $parameterdefinitions } - + # @method ::nx::Object#objectparameter ::nx::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} { #puts stderr "... objectparameter [::nx::core::current object]" @@ -804,8 +807,8 @@ #puts stderr "*** parameter definition for [::nx::core::current object]: $parameterdefinitions" return $parameterdefinitions } - + ############################################ # RelationSlot ############################################ @@ -852,7 +855,7 @@ error "$value is not a $prop of $obj (valid are: $old)" } } - + ::nx::RelationSlot public method delete {-nocomplain:switch obj prop value} { #puts stderr RelationSlot-delete-[::nx::core::current args] $obj $prop [:delete_value $obj $prop [$obj info $prop] $value] @@ -861,6 +864,7 @@ ::nx::RelationSlot public method get {obj prop} { ::nx::core::relation $obj $prop } + ::nx::RelationSlot public method add {obj prop value {pos 0}} { if {![set :multivalued]} { error "Property $prop of ${:domain}->$obj ist not multivalued" @@ -872,8 +876,8 @@ ::nx::RelationSlot public method delete {-nocomplain:switch obj prop value} { uplevel [list ::nx::core::relation $obj $prop [:delete_value $obj $prop [::nx::core::relation $obj $prop] $value]] } - - + + ############################################ # system slots ############################################ @@ -951,16 +955,18 @@ ::nx::RelationSlot create ${os}::Class::slot::object-mixin ::nx::RelationSlot create ${os}::Class::slot::object-filter -elementtype "" } + ::nx::core::register_system_slots ::nx proc ::nx::core::register_system_slots {} {} + ############################################ # Attribute slots ############################################ ::nx::MetaSlot __invalidateobjectparameter # @object ::nx::Attribute - # + # Attribute slots are used to manage the access, mutation, and # querying of instance variables. There is a helper method {{@method # ::nx::Object class attribute}} to define the attributes of classes @@ -982,7 +988,7 @@ # @param arg # @superclass ::nx::doc::entities::object::nx::ObjectParameterSlot ::nx::MetaSlot create ::nx::Attribute -superclass ::nx::ObjectParameterSlot - + createBootstrapAttributeSlots ::nx::Attribute { {value_check once} incremental @@ -1010,11 +1016,11 @@ ::nx::core::next ;# do first ordinary slot initialization # there might be already default values registered on the class set __initcmd "" - if {[:exists default]} { - } elseif [:exists initcmd] { + if {[info exists :default]} { + } elseif [info exists :initcmd] { append __initcmd ":trace add variable [list ${:name}] read \ \[list [::nx::core::current object] __default_from_cmd \[::nx::core::current object\] [list [set :initcmd]]\]\n" - } elseif [:exists valuecmd] { + } elseif [info exists :valuecmd] { append __initcmd ":trace add variable [list ${:name}] read \ \[list [::nx::core::current object] __value_from_cmd \[::nx::core::current object\] [list [set :valuecmd]]\]" } @@ -1039,7 +1045,7 @@ } } - if {[:exists valuechangedcmd]} { + if {[info exists :valuechangedcmd]} { append __initcmd ":trace add variable [list ${:name}] write \ \[list [::nx::core::current object] __value_changed_cmd \[::nx::core::current object\] [list [set :valuechangedcmd]]\]" } Index: library/lib/xotcl1.xotcl =================================================================== diff -u -r3f0573cc75724179f416942b974373e5a62ec05e -rdaafc0f0261f6b47a01c7cc8975acdd66f91f360 --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 3f0573cc75724179f416942b974373e5a62ec05e) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision daafc0f0261f6b47a01c7cc8975acdd66f91f360) @@ -342,7 +342,7 @@ if {$noprocs} {if {$nocmds} {return ""}; set methodtype builtin} set cmd [list ::nx::core::cmd::ObjectInfo::callable $o -methodtype $methodtype] if {$incontext} {lappend cmd -incontext} - if {[::info exists pattern]} {lappend cmd $pattern} + if {[info exists pattern]} {lappend cmd $pattern} eval $cmd } # object filter mapping @@ -694,7 +694,7 @@ } :public object method contains script { - if {[:exists provide]} { + if {[info exists :provide]} { package provide [set :provide] [set :version] } else { package provide [::xotcl::self] [set :version] Index: library/serialize/Serializer.xotcl =================================================================== diff -u -r3f0573cc75724179f416942b974373e5a62ec05e -rdaafc0f0261f6b47a01c7cc8975acdd66f91f360 --- library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision 3f0573cc75724179f416942b974373e5a62ec05e) +++ library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision daafc0f0261f6b47a01c7cc8975acdd66f91f360) @@ -508,7 +508,7 @@ :method collectVars o { set setcmd [list] foreach v [lsort [$o info vars]] { - if {![:exists ignoreVarsRE] || ![regexp [set :ignoreVarsRE] ${o}::$v]} { + if {![info exists :ignoreVarsRE] || ![regexp [set :ignoreVarsRE] ${o}::$v]} { if {[$o eval [list ::array exists :$v]]} { lappend setcmd [list array set :$v [$o eval [list array get :$v]]] } else { Index: tests/varresolutiontest.tcl =================================================================== diff -u -re277bc35923104b11181d60d4ed377653b337d40 -rdaafc0f0261f6b47a01c7cc8975acdd66f91f360 --- tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision e277bc35923104b11181d60d4ed377653b337d40) +++ tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision daafc0f0261f6b47a01c7cc8975acdd66f91f360) @@ -23,10 +23,10 @@ ? {o info vars} "" ? {info exists ::globalVar} 1 ? {set ::globalVar} 1 -? {o exists globalVar} 0 +? {o eval {info exists :globalVar}} 0 ? {o array exists globalVar} 0 o array set globalVar {1 2} -? {o exists globalVar} 1 +? {o eval {info exists :globalVar}} 1 ? {o info vars} globalVar ? {o array exists globalVar} 1 ? {set ::globalVar} 1 @@ -69,11 +69,11 @@ ? {info exists ::z} 1 ? {set ::z} 3 ? {lsort [o info vars]} {X Y g i x y} -? {o exists x} 1 -? {o exists y} 1 -? {o exists z} 0 -? {o exists X} 1 -? {o exists Y} 1 +? {o eval {info exists :x}} 1 +? {o eval {info exists :y}} 1 +? {o eval {info exists :z}} 0 +? {o eval {info exists :X}} 1 +? {o eval {info exists :Y}} 1 ? {o set y} 2 ? {set ::g} 1 @@ -101,11 +101,11 @@ ? {info exists ::z} 1 ? {set ::z} 3 ? {lsort [o info vars]} {X Y y} -? {o exists x} 0 -? {o exists y} 1 -? {o exists z} 0 -? {o exists X} 1 -? {o exists Y} 1 +? {o eval {info exists :x}} 0 +? {o eval {info exists :y}} 1 +? {o eval {info exists :z}} 0 +? {o eval {info exists :X}} 1 +? {o eval {info exists :Y}} 1 ? {o set y} 2 ? {set ::g} 1 @@ -153,13 +153,13 @@ ? {namespace eval ::o {info exists x}} 1 ? {::o unset x} "" ? {::nx::core::existsvar o x} 0 -? {o exists x} 0 +? {o eval {info exists :x}} 0 ? {info vars ::x} "" ? {namespace eval ::o {info exists x}} 0 o lappend y 3 ? {namespace eval ::o {llength y}} 1 ? {namespace eval ::o {unset y}} "" -? {::o exists y} 0 +? {o eval {info exists :y}} 0 o destroy ########################################### @@ -202,17 +202,17 @@ ? {catch {unset ::x}} 0 ? {::o set ::o::x 1} 1 -? {o exists x} [::o set ::o::x] +? {o eval {info exists :x}} [::o set ::o::x] ? {namespace eval ::o unset x} "" -? {o exists x} 0 +? {o eval {info exists x}} 0 # Note, relatively qualified var names (not prefixed with ::*) # are always resolved relative to the per-object namespace ? {catch {::o set o::x 1} msg} 1 ? {::o set oo::x 1} 1 -? {o::oo exists x} [::o set oo::x] +? {o::oo eval {info exists :x}} [::o set oo::x] ? {o unset oo::x} "" -? {o::oo exists x} 0 +? {o::oo eval {info exists :x}} 0 o destroy @@ -422,8 +422,8 @@ set :x 1 ? {info exists G} 1 } -? {o exists x} 1 -? {o exists xxx} 0 +? {o eval {info exists :x}} 1 +? {o eval {info exists :xxx}} 0 ? {info exists ::xxx} 0 unset -nocomplain ::xxx @@ -435,8 +435,8 @@ ? {info exists G} 1 } -? {o exists a} 1 -? {o exists aaa} 1 +? {o eval {info exists :a}} 1 +? {o eval {info exists :aaa}} 1 ? {info exists ::aaa} 0 unset -nocomplain ::aaa @@ -449,8 +449,8 @@ set :b 1 ? {info exists G} 1 } -? {o exists b} 1 -? {o exists bbb} 0 +? {o eval {info exists :b}} 1 +? {o eval {info exists :bbb}} 0 ? {info vars ::bbb} "" unset -nocomplain ::bbb @@ -461,8 +461,8 @@ set :z 1 ? {info exists G} 1 } -? {o exists z} 0 -? {o exists zzz} 0 +? {o eval {info exists :z}} 0 +? {o eval {info exists :zzz}} 0 ? {info vars ::zzz} ::zzz unset -nocomplain ::zzz @@ -479,24 +479,24 @@ set ccc 1 set :c 1 } -? {o exists c} 1 -? {o exists ccc} 1 +? {o eval {info exists :c}} 1 +? {o eval {info exists :ccc}} 1 # softeval behaves like the creation initcmd (just set dot vars) o softeval { set ddd 1 set :d 1 } -? {o exists d} 1 -? {o exists ddd} 0 +? {o eval {info exists :d}} 1 +? {o eval {info exists :ddd}} 0 # softeval2 never sets variables o softeval2 { set zzz 1 set :z 1 } -? {o exists z} 0 -? {o exists zzz} 0 +? {o eval {info exists :z}} 0 +? {o eval {info exists :zzz}} 0 ? {lsort [o info vars]} "c ccc d" o destroy @@ -511,32 +511,32 @@ set xxx 1 set :x 1 } -? {o exists x} 1 -? {o exists xxx} 0 +? {o eval {info exists :x}} 1 +? {o eval {info exists :xxx}} 0 # objeval does an objcope, all vars are instance variables o objeval { set aaa 1 set :a 1 } -? {o exists a} 1 -? {o exists aaa} 1 +? {o eval {info exists :a}} 1 +? {o eval {info exists :aaa}} 1 # softeval should behave like the creation initcmd (just set dot vars) o softeval { set bbb 1 set :b 1 } -? {o exists b} 1 -? {o exists bbb} 0 +? {o eval {info exists :b}} 1 +? {o eval {info exists :bbb}} 0 # softeval2 never sets instance variables o softeval2 { set zzz 1 set :z 1 } -? {o exists z} 0 -? {o exists zzz} 0 +? {o eval {info exists :z}} 0 +? {o eval {info exists :zzz}} 0 ? {lsort [o info vars]} "a aaa b x" o destroy @@ -550,24 +550,24 @@ set ccc 1 set :c 1 } -? {o exists c} 1 -? {o exists ccc} 1 +? {o eval {info exists :c}} 1 +? {o eval {info exists :ccc}} 1 # softeval2 should behave like the creation initcmd (just set dot vars) o softeval { set ddd 1 set :d 1 } -? {o exists d} 1 -? {o exists ddd} 0 +? {o eval {info exists :d}} 1 +? {o eval {info exists :ddd}} 0 # softeval2 never sets variables o softeval2 { set zzz 1 set :z 1 } -? {o exists z} 0 -? {o exists zzz} 0 +? {o eval {info exists :z}} 0 +? {o eval {info exists :zzz}} 0 ? {lsort [o info vars]} "c ccc d" o destroy @@ -587,7 +587,7 @@ set :x 1 set ::result G=[info exists G],p=[info exists p] } - return [o exists x]-[o exists xxx]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result + return [o eval {info exists :x}]-[o eval {info exists :xxx}]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result } proc foo {type} { @@ -599,7 +599,7 @@ set :x 1 set ::result G=[info exists G],p=[info exists p] } - return [o exists x]-[o exists xxx]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result + return [o eval {info exists :x}]-[o eval {info exists :xxx}]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result } proc foo-tcl {what} { @@ -614,7 +614,7 @@ eval {eval $body} ns-eval {namespace eval [namespace current] $body} } - return [o exists x]-[o exists xxx]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result + return [o eval {info exists :x}]-[o eval {info exists :xxx}]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result } set G 1