Index: doc/migration1-2.html
===================================================================
diff -u -reef622da1b387cfd1dd68babeb0bfecfbae5caa3 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- doc/migration1-2.html (.../migration1-2.html) (revision eef622da1b387cfd1dd68babeb0bfecfbae5caa3)
+++ doc/migration1-2.html (.../migration1-2.html) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -86,7 +86,7 @@
::xotcl::use xotcl2
Class create C2 {
- .method foo {} {puts "hello world"}
+ :method foo {} {puts "hello world"}
}
}
</pre>
@@ -130,8 +130,8 @@
<i>C</i> proc <i>bar args</i> {...}<br>
</code></td>
<td><code>Class create <i>C</i> {<br>
- .method <i>foo args</i> {...}<br>
- .object method <i>bar args</i> {...}<br>
+ :method <i>foo args</i> {...}<br>
+ :object method <i>bar args</i> {...}<br>
}<br></code><hr>
<code>Class create <i>C</i><br>
<i>C</i> method <i>foo args</i> {...}<br>
@@ -144,11 +144,11 @@
<i>o</i> proc <i>foo args</i> {...}<br>
</code></td>
<td><code>Object create <i>o</i> {<br>
- set .<i>x 1</i><br>
- .method <i>foo args</i> {...}<br>
+ set :<i>x 1</i><br>
+ :method <i>foo args</i> {...}<br>
}<br></code><hr>
<code>Object create <i>o</i><br>
- <i>o</i> eval {set <i>.x 1</i>}</i><br>
+ <i>o</i> eval {set <i>:x 1</i>}</i><br>
<i># ::xotcl::setinstvar o x 1</i><br>
<i>o</i> method <i>foo args</i> {...}<br>
</code></td>
@@ -179,14 +179,14 @@
<i>o</i> proc <i>baz</i> {} {...}<br>
</code></td>
<td><code>Class create <i>C</i> {<br>
- .method <i>foo args</i> {...}<br>
- .method <i>bar args</i> {<br>
- .<i>foo 1 2 3</i> ;# invoke own method<br>
+ :method <i>foo args</i> {...}<br>
+ :method <i>bar args</i> {<br>
+ :<i>foo 1 2 3</i> ;# invoke own method<br>
<i>o baz</i> ;# invoke others method<br>
}<br>
}</br>
Object create <i>o</i> {<br>
- .method <i>baz</i> {} {...}<br>
+ :method <i>baz</i> {} {...}<br>
}</br>
</code></td>
</tr>
@@ -209,11 +209,11 @@
}<br>
</code></td>
<td><code>Class create <i>C</i> {<br>
- .method <i>foo args</i> {...}<br>
+ :method <i>foo args</i> {...}<br>
<i># method scoped variable a</i><br>
set a 1 <br>
<i># instance variable b</i><br>
- set .b 2<br>
+ set :b 2<br>
<i># global variable/namespaced variable c</i><br>
set ::c 3<br>
}<br>
@@ -222,23 +222,23 @@
</tr>
<tr>
<td><code>my set <i>varname value</i></code></td>
- <td><code>set .<i>varname value</i></code></td>
+ <td><code>set :<i>varname value</i></code></td>
</tr>
<tr>
<td><code>set <i>newVar</i> [my set <i>otherVar</i>]</code></td>
- <td><code>set <i>newVar</i> [set <i>.otherVar</i>]</code><br><hr>
- <code>set <i>newVar</i> ${.otherVar}</i></code><br>
+ <td><code>set <i>newVar</i> [set <i>:otherVar</i>]</code><br><hr>
+ <code>set <i>newVar</i> ${:otherVar}</i></code><br>
</td>
</tr>
<tr>
<td><code>my instvar <i>newVar</i><br>
set <i>newVar value</i> </code>
</td>
- <td><code>set <i>.newVar value</i></td>
+ <td><code>set <i>:newVar value</i></td>
</tr>
<tr>
<td><code>my exists <i>varname</i></code></td>
- <td><code>info .<i>varname</i></code></td>
+ <td><code>info :<i>varname</i></code></td>
</tr>
</table>
@@ -247,11 +247,11 @@
<tr><th>XOTcl 1</th><th>XOTcl 2</th></tr>
<tr>
<td><code><i>obj</i> set <i>varname value</i></code></td>
- <td><code><i>obj</i> eval [list set <i>.varname value</i>]</code></td>
+ <td><code><i>obj</i> eval [list set <i>:varname value</i>]</code></td>
</tr>
<tr>
<td><code>set <i>newVar</i> [<i>obj</i> set <i>otherVar</i>]</code></td>
- <td><code>set <i>newVar</i> [<i>obj</i> eval {set <i>.otherVar</i>}]</code><br>
+ <td><code>set <i>newVar</i> [<i>obj</i> eval {set <i>:otherVar</i>}]</code><br>
</td>
</tr>
<tr>
@@ -263,7 +263,7 @@
</tr>
<tr>
<td><code><i>obj</i> exists <i>varname</i></code></td>
- <td><code><i>obj</i> eval {info exists <i>.varname</i>}</code></td>
+ <td><code><i>obj</i> eval {info exists <i>:varname</i>}</code></td>
</tr>
</table>
@@ -688,5 +688,5 @@
<hr>
<address></address>
-<!-- hhmts start --> Last modified: Tue Jan 12 11:35:29 CET 2010 <!-- hhmts end -->
+<!-- hhmts start --> Last modified: Fri Jan 15 13:15:37 CET 2010 <!-- hhmts end -->
</body> </html>
Index: doc/tutorial2.html
===================================================================
diff -u -r9ee8d01537389a88bbbb560acb5f811d3e77422a -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- doc/tutorial2.html (.../tutorial2.html) (revision 9ee8d01537389a88bbbb560acb5f811d3e77422a)
+++ doc/tutorial2.html (.../tutorial2.html) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -308,24 +308,24 @@
<it>#</it>
<tt>Class create</tt> Stack {
- <tt>.method</tt> init {} { <it># Constructor</it>
- <tt>set</tt> .things ""
+ <tt>:method</tt> init {} { <it># Constructor</it>
+ <tt>set</tt> :things ""
}
- <tt>.method</tt> push {thing} {
- <tt>set</tt> .things [<tt>linsert</tt> ${.things} 0 $thing]
+ <tt>:method</tt> push {thing} {
+ <tt>set</tt> :things [<tt>linsert</tt> ${:things} 0 $thing]
<tt>return</tt> $thing
}
- <tt>.method</tt> pop {} {
- <tt>set</tt> top [<tt>lindex</tt> ${.things} 0]
- <tt>set</tt> .things [<tt>lrange</tt> ${.things} 1 end]
+ <tt>:method</tt> pop {} {
+ <tt>set</tt> top [<tt>lindex</tt> ${:things} 0]
+ <tt>set</tt> :things [<tt>lrange</tt> ${:things} 1 end]
<tt>return</tt> $top
}
}
</pre>
<p>
-The three methods are defined via <tt>.method</tt> (which means:
+The three methods are defined via <tt>:method</tt> (which means:
define a method for the current class). Variables are set with the
Tcl command <tt>set</tt>. Variable names starting with a dot "<tt>.</tt>"
are treated as instance variables (variables of an instance of the
@@ -380,16 +380,16 @@
<it>#</it>
<tt>Object create</tt> stack {
- <tt>set</tt> .things ""
+ <tt>set</tt> :things ""
- <tt>.method</tt> push {thing} {
- <tt>set</tt> .things [<tt>linsert</tt> ${.things} 0 $thing]
+ <tt>:method</tt> push {thing} {
+ <tt>set</tt> :things [<tt>linsert</tt> ${:things} 0 $thing]
<tt>return</tt> $thing
}
- <tt>.method</tt> pop {} {
- <tt>set</tt> top [<tt>lindex</tt> ${.things} 0]
- <tt>set</tt> .things [<tt>lrange</tt> ${.things} 1 end]
+ <tt>:method</tt> pop {} {
+ <tt>set</tt> top [<tt>lindex</tt> ${:things} 0]
+ <tt>set</tt> :things [<tt>lrange</tt> ${:things} 1 end]
<tt>return</tt> $top
}
}
@@ -408,19 +408,19 @@
<it>#</it>
<tt>Class create</tt> Safety {
- <tt>.method</tt> init {} { <it># Constructor</it>
- <tt>set</tt> .count 0
+ <tt>:method</tt> init {} { <it># Constructor</it>
+ <tt>set</tt> :count 0
<tt>next</tt>
}
- <tt>.method</tt> push {thing} {
- <tt>incr</tt> .count
+ <tt>:method</tt> push {thing} {
+ <tt>incr</tt> :count
<tt>next</tt>
}
- <tt>.method</tt> pop {} {
- <tt>if</tt> {${.count} == 0} <tt>then</tt> { <tt>error</tt> "Stack empty!" }
- <tt>incr</tt> .count -1
+ <tt>:method</tt> pop {} {
+ <tt>if</tt> {${:count} == 0} <tt>then</tt> { <tt>error</tt> "Stack empty!" }
+ <tt>incr</tt> :count -1
<tt>next</tt>
}
}
@@ -477,7 +477,7 @@
Stack <tt>create</tt> s4 {
- <tt>.method </tt> push {value} {
+ <tt>:method </tt> push {value} {
<tt>if </tt> {![<tt>string is</tt> integer $value]} {
<tt>error</tt> "value $value is not an integer"
}
@@ -507,8 +507,8 @@
Class <tt>create</tt> Stack {
<it># ...</it>
- <tt>.object method</tt> available_stacks {} {
- <tt>return</tt> [<tt>llength</tt> [<tt>.info</tt> instances]]
+ <tt>:object method</tt> available_stacks {} {
+ <tt>return</tt> [<tt>llength</tt> [<tt>:info</tt> instances]]
}
}
@@ -585,7 +585,7 @@
</pre>
<p>
We may add a player by using method. Methods can be defined
-in XOTcl2 either by <tt>.method</tt> in the class creation block, or
+in XOTcl2 either by <tt>:method</tt> in the class creation block, or
via "<tt><em>ClassName</em> method ...</tt>". The added players (as
well as other club members) are aggregated in
the object of the soccer team (denoted by :: namespace syntax).
@@ -606,7 +606,7 @@
SoccerTeam <tt>method</tt> transferPlayer {playername destinationTeam} {
<it># We use the aggregation introspection option <tt>children</tt> in order</it>
<it># to get all club members</it>
- <tt>foreach</tt> player [<tt>.info</tt> children] {
+ <tt>foreach</tt> player [<tt>:info</tt> children] {
<it># But we only remove matching playernames of type "Player". We do</it>
<it># not want to remove another club member type who has the same</it>
<it># name.</it>
@@ -624,12 +624,12 @@
</p>
<pre CLASS="code">
SoccerTeam <tt>method</tt> printMembers {} {
- <tt>puts</tt> "Members of ${.name}:"
- <tt>foreach</tt> m [<tt>.info</tt> children] {<tt>puts</tt> " [$m name]"}
+ <tt>puts</tt> "Members of ${:name}:"
+ <tt>foreach</tt> m [<tt>:info</tt> children] {<tt>puts</tt> " [$m name]"}
}
SoccerTeam <tt>method</tt> printPlayers {} {
- <tt>puts</tt> "Players of ${.name}:"
- <tt>foreach</tt> m [<tt>.info</tt> children] {
+ <tt>puts</tt> "Players of ${:name}:"
+ <tt>foreach</tt> m [<tt>:info</tt> children] {
<tt>if</tt> {[$m info is type Player]} {<tt>puts</tt> " [$m name]"}
}
}
@@ -659,7 +659,7 @@
</p>
<pre CLASS="code">
Player instinvar {
- {${.playerRole} <tt>in</tt> [<tt>list</tt> "NONE" "PLAYER" "GOALY"]}
+ {${:playerRole} <tt>in</tt> [<tt>list</tt> "NONE" "PLAYER" "GOALY"]}
}
</pre>
<p>
@@ -694,8 +694,8 @@
<pre CLASS="code">
<tt>Class create</tt> Singer {
- <tt>.method</tt> sing text {
- <tt>puts</tt> "${.name} sings: $text, lala."
+ <tt>:method</tt> sing text {
+ <tt>puts</tt> "${:name} sings: $text, lala."
}
}
</pre>
@@ -723,7 +723,7 @@
</p>
<pre CLASS="code">
Player <tt>method</tt> class args {
- <tt>unset</tt> .playerRole
+ <tt>unset</tt> :playerRole
<tt>next</tt>
}
</pre>
@@ -776,7 +776,7 @@
</p>
<pre CLASS="code">
<tt>Class</tt> TransferObserver {
- <tt>.method</tt> transferPlayer {pname destinationTeam} {
+ <tt>:method</tt> transferPlayer {pname destinationTeam} {
<tt>puts</tt> "Player '$pname' is transfered to Team '[$destinationTeam name]'"
<tt>next</tt>
}
Index: generic/predefined.h
===================================================================
diff -u -reef622da1b387cfd1dd68babeb0bfecfbae5caa3 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- generic/predefined.h (.../predefined.h) (revision eef622da1b387cfd1dd68babeb0bfecfbae5caa3)
+++ generic/predefined.h (.../predefined.h) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -33,38 +33,38 @@
"if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}\n"
"::xotcl::method [self] -per-object $name $arguments $body {*}$conditions}\n"
"Class eval {\n"
-".method object {what args} {\n"
+":method object {what args} {\n"
"if {$what in [list \"alias\" \"forward\" \"method\" \"setter\"]} {\n"
"return [::xotcl::dispatch [self] ::xotcl::classes::xotcl2::Object::$what {*}$args]}\n"
"if {$what in [list \"info\"]} {\n"
"return [::xotcl2::objectInfo [lindex $args 0] [self] {*}[lrange $args 1 end]]}\n"
"if {$what in [list \"filter\" \"mixin\"]} {\n"
-"return [.object-$what {*}$args]}\n"
+"return [:object-$what {*}$args]}\n"
"if {$what in [list \"filterguard\" \"mixinguard\"]} {\n"
"return [::xotcl::dispatch [self] ::xotcl::cmd::Object::$what {*}$args]}}\n"
-".method unknown {m args} {\n"
+":method unknown {m args} {\n"
"error \"Method '$m' unknown for [self].\\\n"
"Consider '[self] create $m $args' instead of '[self] $m $args'\"}\n"
"::xotcl::methodproperty [self] unknown protected 1}\n"
"Object eval {\n"
-".method public {args} {\n"
+":method public {args} {\n"
"set p [lsearch -regexp $args {^(method|alias|forward|setter)$}]\n"
"if {$p == -1} {error \"$args is not a method defining method\"}\n"
-"set r [{*}.$args]\n"
+"set r [{*}:$args]\n"
"::xotcl::methodproperty [self] $r protected false\n"
"return $r}\n"
-".method protected {args} {\n"
+":method protected {args} {\n"
"set p [lsearch -regexp $args {^(method|alias|forward|setter)$}]\n"
"if {$p == -1} {error \"$args is not a method defining command\"}\n"
-"set r [{*}.$args]\n"
+"set r [{*}:$args]\n"
"::xotcl::methodproperty [self] $r [self proc] true\n"
"return $r}\n"
-".protected method unknown {m args} {\n"
+":protected method unknown {m args} {\n"
"if {![self isnext]} {\n"
"error \"[self]: unable to dispatch method '$m'\"}}\n"
-".protected method init args {}\n"
-".protected method defaultmethod {} {::xotcl::self}\n"
-".protected method objectparameter {} {;}}\n"
+":protected method init args {}\n"
+":protected method defaultmethod {} {::xotcl::self}\n"
+":protected method objectparameter {} {;}}\n"
"::xotcl::forward Object forward ::xotcl::forward %self -per-object\n"
"::xotcl::forward Class forward ::xotcl::forward %self\n"
"Class protected object method __unknown {name} {}\n"
@@ -87,17 +87,17 @@
"Object create ::xotcl2::objectInfo\n"
"Object create ::xotcl2::classInfo\n"
"objectInfo eval {\n"
-".alias is ::xotcl::is\n"
-".public method info {obj} {\n"
+":alias is ::xotcl::is\n"
+":public method info {obj} {\n"
"set methods [list]\n"
"foreach name [::xotcl::cmd::ObjectInfo::methods [self]] {\n"
"if {$name eq \"unknown\"} continue\n"
"lappend methods $name}\n"
"return \"valid options are: [join [lsort $methods] {, }]\"}\n"
-".method unknown {method obj args} {\n"
+":method unknown {method obj args} {\n"
"error \"[::xotcl::self] unknown info option \\\"$method\\\"; [$obj info info]\"}}\n"
"classInfo eval {\n"
-".public method mixinof {obj -closure:switch {-scope all} pattern:optional} {\n"
+":public method mixinof {obj -closure:switch {-scope all} pattern:optional} {\n"
"set withClosure [expr {$closure ? \"-closure\" : \"\"}]\n"
"set withPattern [expr {[info exists pattern] ? $pattern : \"\"}]\n"
"if {$scope eq \"all\"} {\n"
@@ -106,11 +106,11 @@
"lappend r {*}[$c info instances {*}$withPattern]}\n"
"return [lsort -unique $r]} else {\n"
"return [::xotcl::cmd::ClassInfo::$scope-mixin-of $obj {*}$withClosure {*}$withPattern]}}\n"
-".alias is ::xotcl::is\n"
-".alias classparent ::xotcl::cmd::ObjectInfo::parent\n"
-".alias classchildren ::xotcl::cmd::ObjectInfo::children\n"
-".alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info]\n"
-".alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info]}\n"
+":alias is ::xotcl::is\n"
+":alias classparent ::xotcl::cmd::ObjectInfo::parent\n"
+":alias classchildren ::xotcl::cmd::ObjectInfo::children\n"
+":alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info]\n"
+":alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info]}\n"
"foreach cmd [info command ::xotcl::cmd::ObjectInfo::*] {\n"
"::xotcl::alias ::xotcl2::objectInfo [namespace tail $cmd] $cmd\n"
"::xotcl::alias ::xotcl2::classInfo [namespace tail $cmd] $cmd}\n"
@@ -134,8 +134,8 @@
"error \\\"Abstract method $methname $arglist called\\\"} else {::xotcl::next}\n"
"\"\n"
"if {${per-object}} {\n"
-".method -per-object $methname $arglist $body} else {\n"
-".method $methname $arglist $body}}\n"
+":method -per-object $methname $arglist $body} else {\n"
+":method $methname $arglist $body}}\n"
"proc ::xotcl::unsetExitHandler {} {\n"
"proc ::xotcl::__exitHandler {} {}}\n"
"proc ::xotcl::setExitHandler {newbody} {::proc ::xotcl::__exitHandler {} $newbody}\n"
@@ -228,8 +228,8 @@
"::xotcl::alias ::xotcl::Slot get ::xotcl::setinstvar\n"
"::xotcl::alias ::xotcl::Slot assign ::xotcl::setinstvar\n"
"::xotcl::Slot 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 {![set :multivalued]} {\n"
+"error \"Property $prop of [set :domain]->$obj ist not multivalued\"}\n"
"if {[$obj exists $prop]} {\n"
"::xotcl::setinstvar $obj $prop [linsert [::xotcl::setinstvar $obj $prop] $pos $value]} else {\n"
"::xotcl::setinstvar $obj $prop [list $value]}}\n"
@@ -240,26 +240,26 @@
"error \"$value is not a $prop of $obj (valid are: $old)\"}}\n"
"::xotcl::Slot method unknown {method args} {\n"
"set methods [list]\n"
-"foreach m [.info callable] {\n"
+"foreach m [:info callable] {\n"
"if {[::xotcl2::Object info callable $m] ne \"\"} continue\n"
"if {[string match __* $m]} continue\n"
"lappend methods $m}\n"
"error \"Method '$method' unknown for slot [::xotcl::self]; valid are: {[lsort $methods]]}\"}\n"
"::xotcl::Slot public method destroy {} {\n"
-"if {${.domain} ne \"\" && [::xotcl::is ${.domain} object]} {\n"
-"${.domain} __invalidateobjectparameter}\n"
+"if {${:domain} ne \"\" && [::xotcl::is ${:domain} object]} {\n"
+"${:domain} __invalidateobjectparameter}\n"
"next}\n"
"::xotcl::Slot method init {args} {\n"
-"if {${.domain} eq \"\"} {\n"
-"set .domain [::xotcl::self callingobject]}\n"
-"if {${.domain} ne \"\"} {\n"
-"if {![info exists .methodname]} {\n"
-"set .methodname ${.name}}\n"
-"${.domain} __invalidateobjectparameter\n"
-"set cl [expr {${.per-object} ? \"Object\" : \"Class\"}]\n"
-"::xotcl::dispatch ${.domain} ::xotcl::classes::xotcl2::${cl}::forward \\\n"
-"${.name} ${.manager} [list %1 [${.manager} defaultmethods]] %self \\\n"
-"${.methodname}}}\n"
+"if {${:domain} eq \"\"} {\n"
+"set :domain [::xotcl::self callingobject]}\n"
+"if {${:domain} ne \"\"} {\n"
+"if {![info exists :methodname]} {\n"
+"set :methodname ${:name}}\n"
+"${:domain} __invalidateobjectparameter\n"
+"set cl [expr {${:per-object} ? \"Object\" : \"Class\"}]\n"
+"::xotcl::dispatch ${:domain} ::xotcl::classes::xotcl2::${cl}::forward \\\n"
+"${:name} ${:manager} [list %1 [${:manager} defaultmethods]] %self \\\n"
+"${:methodname}}}\n"
"::xotcl::MetaSlot create ::xotcl::InfoSlot\n"
"createBootstrapAttributeSlots ::xotcl::InfoSlot {\n"
"{multivalued true}\n"
@@ -268,39 +268,39 @@
"::xotcl::InfoSlot public method get {obj prop} {\n"
"$obj info $prop}\n"
"::xotcl::InfoSlot public method add {obj prop value {pos 0}} {\n"
-"if {![set .multivalued]} {\n"
-"error \"Property $prop of ${.domain}->$obj ist not multivalued\"}\n"
+"if {![set :multivalued]} {\n"
+"error \"Property $prop of ${:domain}->$obj ist not multivalued\"}\n"
"$obj $prop [linsert [$obj info $prop] $pos $value]}\n"
"::xotcl::InfoSlot protected method delete_value {obj prop old value} {\n"
"if {[string first * $value] > -1 || [string first \\[ $value] > -1} {\n"
-"if {${.elementtype} ne \"\" && ![string match ::* $value]} {\n"
+"if {${:elementtype} ne \"\" && ![string match ::* $value]} {\n"
"set value ::$value}\n"
-"return [lsearch -all -not -glob -inline $old $value]} elseif {${.elementtype} ne \"\"} {\n"
+"return [lsearch -all -not -glob -inline $old $value]} elseif {${:elementtype} ne \"\"} {\n"
"if {[string first :: $value] == -1} {\n"
"if {![::xotcl::is $value object]} {\n"
"error \"$value does not appear to be an object\"}\n"
"set value [::xotcl::dispatch $value -objscope ::xotcl::self]}\n"
-"if {![::xotcl::is ${.elementtype} class]} {\n"
-"error \"$value does not appear to be of type ${.elementtype}\"}}\n"
+"if {![::xotcl::is ${:elementtype} class]} {\n"
+"error \"$value does not appear to be of type ${:elementtype}\"}}\n"
"set p [lsearch -exact $old $value]\n"
"if {$p > -1} {\n"
"return [lreplace $old $p $p]} else {\n"
"error \"$value is not a $prop of $obj (valid are: $old)\"}}\n"
"::xotcl::InfoSlot public method delete {-nocomplain:switch obj prop value} {\n"
-"$obj $prop [.delete_value $obj $prop [$obj info $prop] $value]}\n"
+"$obj $prop [:delete_value $obj $prop [$obj info $prop] $value]}\n"
"::xotcl::MetaSlot alloc ::xotcl::InterceptorSlot\n"
"::xotcl::relation ::xotcl::InterceptorSlot superclass ::xotcl::InfoSlot\n"
"::xotcl::alias ::xotcl::InterceptorSlot set ::xotcl::relation ;# for backwards compatibility\n"
"::xotcl::alias ::xotcl::InterceptorSlot assign ::xotcl::relation\n"
"::xotcl::InterceptorSlot public method get {obj prop} {\n"
"::xotcl::relation $obj $prop}\n"
"::xotcl::InterceptorSlot public method add {obj prop value {pos 0}} {\n"
-"if {![set .multivalued]} {\n"
-"error \"Property $prop of ${.domain}->$obj ist not multivalued\"}\n"
+"if {![set :multivalued]} {\n"
+"error \"Property $prop of ${:domain}->$obj ist not multivalued\"}\n"
"set oldSetting [::xotcl::relation $obj $prop]\n"
"uplevel [list ::xotcl::relation $obj $prop [linsert $oldSetting $pos $value]]}\n"
"::xotcl::InterceptorSlot public method delete {-nocomplain:switch obj prop value} {\n"
-"uplevel [list ::xotcl::relation $obj $prop [.delete_value $obj $prop [::xotcl::relation $obj $prop] $value]]}\n"
+"uplevel [list ::xotcl::relation $obj $prop [:delete_value $obj $prop [::xotcl::relation $obj $prop] $value]]}\n"
"proc ::xotcl::register_system_slots {os} {\n"
"${os}::Object alloc ${os}::Class::slot\n"
"${os}::Object alloc ${os}::Object::slot\n"
@@ -344,56 +344,56 @@
"if {$keep_old_value} {::xotcl::setinstvar $obj __oldvalue($var) $value}}\n"
"::xotcl::Attribute method check_multiple_values {values predicate type obj var} {\n"
"foreach value $values {\n"
-".check_single_value -keep_old_value false $value $predicate $type $obj $var}\n"
+":check_single_value -keep_old_value false $value $predicate $type $obj $var}\n"
"::xotcl::setinstvar $obj __oldvalue($var) $value}\n"
"::xotcl::Attribute method mk_type_checker {} {\n"
"set __initcmd \"\"\n"
-"if {[.exists type]} {\n"
-"if {[::xotcl::is ${.type} class]} {\n"
+"if {[:exists type]} {\n"
+"if {[::xotcl::is ${:type} class]} {\n"
"set predicate [subst -nocommands {\n"
-"[::xotcl::is \\$value object] && [::xotcl::is \\$value type ${.type}]}]} elseif {[llength ${.type}]>1} {\n"
-"set predicate \"\\[${.type} \\$value\\]\"} else {\n"
-"set predicate \"\\[.type=${.type} ${.name} \\$value\\]\"}\n"
-"append .valuechangedcmd [subst {\n"
-"[expr {${.multivalued} ? \".check_multiple_values\" : \".check_single_value\"}] \\[::xotcl::setinstvar \\$obj ${.name}\\] \\\n"
-"{$predicate} [list ${.type}] \\$obj ${.name}}]\n"
+"[::xotcl::is \\$value object] && [::xotcl::is \\$value type ${:type}]}]} elseif {[llength ${:type}]>1} {\n"
+"set predicate \"\\[${:type} \\$value\\]\"} else {\n"
+"set predicate \"\\[:type=${:type} ${:name} \\$value\\]\"}\n"
+"append :valuechangedcmd [subst {\n"
+"[expr {${:multivalued} ? \":check_multiple_values\" : \":check_single_value\"}] \\[::xotcl::setinstvar \\$obj ${:name}\\] \\\n"
+"{$predicate} [list ${:type}] \\$obj ${:name}}]\n"
"append __initcmd [subst -nocommands {\n"
-"if {[.exists ${.name}]} {set .__oldvalue(${.name}) [set .${.name}]}\\n}]}\n"
+"if {[:exists ${:name}]} {set :__oldvalue(${:name}) [set :${:name}]}\\n}]}\n"
"return $__initcmd}\n"
"::xotcl::Attribute method init {} {\n"
"next ;# do first ordinary slot initialization\n"
"set __initcmd \"\"\n"
-"if {[.exists default]} {} elseif [.exists initcmd] {\n"
-"append __initcmd \".trace add variable [list ${.name}] read \\\n"
-"\\[list [::xotcl::self] __default_from_cmd \\[::xotcl::self\\] [list [set .initcmd]]\\]\\n\"} elseif [.exists valuecmd] {\n"
-"append __initcmd \".trace add variable [list ${.name}] read \\\n"
-"\\[list [::xotcl::self] __value_from_cmd \\[::xotcl::self\\] [list [set .valuecmd]]\\]\"}\n"
-"if {[.exists valuechangedcmd]} {\n"
-"append __initcmd \".trace add variable [list ${.name}] write \\\n"
-"\\[list [::xotcl::self] __value_changed_cmd \\[::xotcl::self\\] [list [set .valuechangedcmd]]\\]\"}\n"
+"if {[:exists default]} {} elseif [:exists initcmd] {\n"
+"append __initcmd \":trace add variable [list ${:name}] read \\\n"
+"\\[list [::xotcl::self] __default_from_cmd \\[::xotcl::self\\] [list [set :initcmd]]\\]\\n\"} elseif [:exists valuecmd] {\n"
+"append __initcmd \":trace add variable [list ${:name}] read \\\n"
+"\\[list [::xotcl::self] __value_from_cmd \\[::xotcl::self\\] [list [set :valuecmd]]\\]\"}\n"
+"if {[:exists valuechangedcmd]} {\n"
+"append __initcmd \":trace add variable [list ${:name}] write \\\n"
+"\\[list [::xotcl::self] __value_changed_cmd \\[::xotcl::self\\] [list [set :valuechangedcmd]]\\]\"}\n"
"if {$__initcmd ne \"\"} {\n"
-"set .initcmd $__initcmd}}\n"
+"set :initcmd $__initcmd}}\n"
"::xotcl2::Class create ::xotcl::Slot::Nocheck {\n"
-".method check_single_value args {;}\n"
-".method check_multiple_values args {;}\n"
-".method mk_type_checker args {return \"\"}}\n"
+":method check_single_value args {;}\n"
+":method check_multiple_values args {;}\n"
+":method mk_type_checker args {return \"\"}}\n"
"::xotcl2::Class create ::xotcl::Slot::Optimizer {\n"
-".method method args {::xotcl::next; .optimize}\n"
-".method forward args {::xotcl::next; .optimize}\n"
-".method init args {::xotcl::next; .optimize}\n"
-".public method optimize {} {\n"
-"if {[set .multivalued]} return\n"
-"if {[set .defaultmethods] ne {get assign}} return\n"
-"if {[.info callable -which assign] ne \"::xotcl::Slot alias assign ::xotcl::setinstvar\"} return\n"
-"if {[.info callable -which get] ne \"::xotcl::Slot alias get ::xotcl::setinstvar\"} return\n"
-"::xotcl::setter ${.domain} {*}[expr {${.per-object} ? \"-per-object\" : \"\"}] ${.name}}}\n"
+":method method args {::xotcl::next; :optimize}\n"
+":method forward args {::xotcl::next; :optimize}\n"
+":method init args {::xotcl::next; :optimize}\n"
+":public method optimize {} {\n"
+"if {[set :multivalued]} return\n"
+"if {[set :defaultmethods] ne {get assign}} return\n"
+"if {[:info callable -which assign] ne \"::xotcl::Slot alias assign ::xotcl::setinstvar\"} return\n"
+"if {[:info callable -which get] ne \"::xotcl::Slot alias get ::xotcl::setinstvar\"} return\n"
+"::xotcl::setter ${:domain} {*}[expr {${:per-object} ? \"-per-object\" : \"\"}] ${:name}}}\n"
"::xotcl::Attribute mixin add ::xotcl::Slot::Optimizer\n"
"::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class\n"
"createBootstrapAttributeSlots ::xotcl::ScopedNew {\n"
"{withclass ::xotcl2::Object}\n"
"inobject}\n"
"::xotcl::ScopedNew method init {} {\n"
-".public method new {-childof args} {\n"
+":public method new {-childof args} {\n"
"::xotcl::importvar [::xotcl::self class] {inobject object} withclass\n"
"if {![::xotcl::is $object object]} {\n"
"$withclass create $object}\n"
@@ -470,8 +470,8 @@
"{targetList \"\"}\n"
"{dest \"\"}\n"
"objLength} {\n"
-".method makeTargetList {t} {\n"
-"lappend .targetList $t\n"
+":method makeTargetList {t} {\n"
+"lappend :targetList $t\n"
"if {[::xotcl::is $t object]} {\n"
"if {[$t info hasnamespace]} {\n"
"set children [$t info children]} else {\n"
@@ -480,16 +480,16 @@
"if {![::xotcl::is $c object]} {\n"
"lappend children [namespace children $t]}}\n"
"foreach c $children {\n"
-".makeTargetList $c}}\n"
-".method copyNSVarsAndCmds {orig dest} {\n"
+":makeTargetList $c}}\n"
+":method copyNSVarsAndCmds {orig dest} {\n"
"::xotcl::namespace_copyvars $orig $dest\n"
"::xotcl::namespace_copycmds $orig $dest}\n"
-".method getDest origin {\n"
-"set tail [string range $origin [set .objLength] end]\n"
-"return ::[string trimleft [set .dest]$tail :]}\n"
-".method copyTargets {} {\n"
-"foreach origin [set .targetList] {\n"
-"set dest [.getDest $origin]\n"
+":method getDest origin {\n"
+"set tail [string range $origin [set :objLength] end]\n"
+"return ::[string trimleft [set :dest]$tail :]}\n"
+":method copyTargets {} {\n"
+"foreach origin [set :targetList] {\n"
+"set dest [:getDest $origin]\n"
"if {[::xotcl::is $origin object]} {\n"
"if {[::xotcl::is $origin class]} {\n"
"set cl [[$origin info class] create $dest -noinit]\n"
@@ -498,7 +498,7 @@
"::xotcl::assertion $cl class-invar [::xotcl::assertion $origin class-invar]\n"
"::xotcl::relation $cl class-filter [::xotcl::relation $origin class-filter]\n"
"::xotcl::relation $cl class-mixin [::xotcl::relation $origin class-mixin]\n"
-".copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest} else {\n"
+":copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest} else {\n"
"set obj [[$origin info class] create $dest -noinit]}\n"
"::xotcl::assertion $obj check [::xotcl::assertion $origin check]\n"
"::xotcl::assertion $obj object-invar [::xotcl::assertion $origin object-invar]\n"
@@ -507,7 +507,7 @@
"if {[$origin info hasnamespace]} {\n"
"$obj requireNamespace}} else {\n"
"namespace eval $dest {}}\n"
-".copyNSVarsAndCmds $origin $dest\n"
+":copyNSVarsAndCmds $origin $dest\n"
"foreach i [$origin info forward] {\n"
"eval [concat $dest forward $i [$origin info forward -definition $i]]}\n"
"if {[::xotcl::is $origin class]} {\n"
@@ -522,34 +522,34 @@
"if {[lindex $def 0] eq $origin} {\n"
"set def [concat $dest [lrange $def 1 end]]}\n"
"$dest trace add variable $var $op $def}}}}\n"
-"foreach origin [set .targetList] {\n"
+"foreach origin [set :targetList] {\n"
"if {[::xotcl::is $origin class]} {\n"
-"set dest [.getDest $origin]\n"
+"set dest [:getDest $origin]\n"
"foreach oldslot [$origin info slots] {\n"
"set newslot ${dest}::slot::[namespace tail $oldslot]\n"
"if {[$oldslot domain] eq $origin} {$newslot domain $cl}\n"
"if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}}}}}\n"
-".public method copy {obj dest} {\n"
-"set .objLength [string length $obj]\n"
-"set .dest $dest\n"
-".makeTargetList $obj\n"
-".copyTargets}}\n"
+":public method copy {obj dest} {\n"
+"set :objLength [string length $obj]\n"
+"set :dest $dest\n"
+":makeTargetList $obj\n"
+":copyTargets}}\n"
"::xotcl2::Object public method copy newName {\n"
"if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::self] :]]} {\n"
"[::xotcl::CopyHandler new -volatile] copy [::xotcl::self] $newName}}\n"
"::xotcl2::Object public method move newName {\n"
"if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {\n"
"if {$newName ne \"\"} {\n"
-".copy $newName}\n"
+":copy $newName}\n"
"if {[::xotcl::is [::xotcl::self] class] && $newName ne \"\"} {\n"
-"foreach subclass [.info subclass] {\n"
+"foreach subclass [:info subclass] {\n"
"set scl [$subclass info superclass]\n"
"if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} {\n"
"set scl [lreplace $scl $index $index $newName]\n"
"$subclass superclass $scl}} }\n"
-".destroy}}\n"
+":destroy}}\n"
"::xotcl2::Object create ::xotcl::@ {\n"
-".method unknown args {}}\n"
+":method unknown args {}}\n"
"namespace eval ::xotcl {\n"
"namespace export @ Attribute\n"
"if {![info exists ::env(HOME)]} {set ::env(HOME) /root}\n"
Index: generic/predefined.xotcl
===================================================================
diff -u -reef622da1b387cfd1dd68babeb0bfecfbae5caa3 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- generic/predefined.xotcl (.../predefined.xotcl) (revision eef622da1b387cfd1dd68babeb0bfecfbae5caa3)
+++ generic/predefined.xotcl (.../predefined.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -71,23 +71,23 @@
Class eval {
# method-modifier for object specific methos
- .method object {what args} {
+ :method object {what args} {
if {$what in [list "alias" "forward" "method" "setter"]} {
return [::xotcl::dispatch [self] ::xotcl::classes::xotcl2::Object::$what {*}$args]
}
if {$what in [list "info"]} {
return [::xotcl2::objectInfo [lindex $args 0] [self] {*}[lrange $args 1 end]]
}
if {$what in [list "filter" "mixin"]} {
- return [.object-$what {*}$args]
+ return [:object-$what {*}$args]
}
if {$what in [list "filterguard" "mixinguard"]} {
return [::xotcl::dispatch [self] ::xotcl::cmd::Object::$what {*}$args]
}
}
# define unknown handler for class
- .method unknown {m args} {
+ :method unknown {m args} {
error "Method '$m' unknown for [self].\
Consider '[self] create $m $args' instead of '[self] $m $args'"
}
@@ -99,39 +99,39 @@
Object eval {
# method modifier "public"
- .method public {args} {
+ :method public {args} {
set p [lsearch -regexp $args {^(method|alias|forward|setter)$}]
if {$p == -1} {error "$args is not a method defining method"}
- set r [{*}.$args]
+ set r [{*}:$args]
::xotcl::methodproperty [self] $r protected false
return $r
}
# method modifier "protected"
- .method protected {args} {
+ :method protected {args} {
set p [lsearch -regexp $args {^(method|alias|forward|setter)$}]
if {$p == -1} {error "$args is not a method defining command"}
- set r [{*}.$args]
+ set r [{*}:$args]
::xotcl::methodproperty [self] $r [self proc] true
return $r
}
# unknown handler for Object
- .protected method unknown {m args} {
+ :protected method unknown {m args} {
if {![self isnext]} {
error "[self]: unable to dispatch method '$m'"
}
}
# "init" must exist on Object. per default it is empty.
- .protected method init args {}
+ :protected method init args {}
# this method is called on calls to object without a specified method
- .protected method defaultmethod {} {::xotcl::self}
+ :protected method defaultmethod {} {::xotcl::self}
# provide a placeholder for the bootup process. The real definition
# is based on slots, which are not available at this point.
- .protected method objectparameter {} {;}
+ :protected method objectparameter {} {;}
}
# define forward methods
@@ -184,14 +184,14 @@
Object create ::xotcl2::classInfo
#
- # It would be nice to do here "objectInfo configure {.alias ..}", but
+ # It would be nice to do here "objectInfo configure {alias ..}", but
# we have no working objectparameter yet due to bootstrapping
#
objectInfo eval {
- .alias is ::xotcl::is
+ :alias is ::xotcl::is
# info info
- .public method info {obj} {
+ :public method info {obj} {
set methods [list]
foreach name [::xotcl::cmd::ObjectInfo::methods [self]] {
if {$name eq "unknown"} continue
@@ -200,13 +200,13 @@
return "valid options are: [join [lsort $methods] {, }]"
}
- .method unknown {method obj args} {
+ :method unknown {method obj args} {
error "[::xotcl::self] unknown info option \"$method\"; [$obj info info]"
}
}
classInfo eval {
- .public method mixinof {obj -closure:switch {-scope all} pattern:optional} {
+ :public method mixinof {obj -closure:switch {-scope all} pattern:optional} {
# scope eq "all" or "object" returns objects, scope eq "class" returns classes
set withClosure [expr {$closure ? "-closure" : ""}]
set withPattern [expr {[info exists pattern] ? $pattern : ""}]
@@ -220,11 +220,11 @@
return [::xotcl::cmd::ClassInfo::$scope-mixin-of $obj {*}$withClosure {*}$withPattern]
}
}
- .alias is ::xotcl::is
- .alias classparent ::xotcl::cmd::ObjectInfo::parent
- .alias classchildren ::xotcl::cmd::ObjectInfo::children
- .alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info]
- .alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info]
+ :alias is ::xotcl::is
+ :alias classparent ::xotcl::cmd::ObjectInfo::parent
+ :alias classchildren ::xotcl::cmd::ObjectInfo::children
+ :alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info]
+ :alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info]
}
foreach cmd [info command ::xotcl::cmd::ObjectInfo::*] {
@@ -263,9 +263,9 @@
} else {::xotcl::next}
"
if {${per-object}} {
- .method -per-object $methname $arglist $body
+ :method -per-object $methname $arglist $body
} else {
- .method $methname $arglist $body
+ :method $methname $arglist $body
}
}
@@ -454,8 +454,8 @@
::xotcl::alias ::xotcl::Slot assign ::xotcl::setinstvar
::xotcl::Slot public method add {obj prop value {pos 0}} {
- if {![set .multivalued]} {
- error "Property $prop of [set .domain]->$obj ist not multivalued"
+ if {![set :multivalued]} {
+ error "Property $prop of [set :domain]->$obj ist not multivalued"
}
if {[$obj exists $prop]} {
::xotcl::setinstvar $obj $prop [linsert [::xotcl::setinstvar $obj $prop] $pos $value]
@@ -473,7 +473,7 @@
::xotcl::Slot method unknown {method args} {
set methods [list]
- foreach m [.info callable] {
+ foreach m [:info callable] {
if {[::xotcl2::Object info callable $m] ne ""} continue
if {[string match __* $m]} continue
lappend methods $m
@@ -482,26 +482,26 @@
}
::xotcl::Slot public method destroy {} {
- if {${.domain} ne "" && [::xotcl::is ${.domain} object]} {
- ${.domain} __invalidateobjectparameter
+ if {${:domain} ne "" && [::xotcl::is ${:domain} object]} {
+ ${:domain} __invalidateobjectparameter
}
next
}
::xotcl::Slot method init {args} {
- if {${.domain} eq ""} {
- set .domain [::xotcl::self callingobject]
+ if {${:domain} eq ""} {
+ set :domain [::xotcl::self callingobject]
}
- if {${.domain} ne ""} {
- if {![info exists .methodname]} {
- set .methodname ${.name}
+ if {${:domain} ne ""} {
+ if {![info exists :methodname]} {
+ set :methodname ${:name}
}
- ${.domain} __invalidateobjectparameter
- set cl [expr {${.per-object} ? "Object" : "Class"}]
+ ${:domain} __invalidateobjectparameter
+ set cl [expr {${:per-object} ? "Object" : "Class"}]
# since the domain object might be xotcl1 or xotcl2, use dispatch
- ::xotcl::dispatch ${.domain} ::xotcl::classes::xotcl2::${cl}::forward \
- ${.name} ${.manager} [list %1 [${.manager} defaultmethods]] %self \
- ${.methodname}
+ ::xotcl::dispatch ${:domain} ::xotcl::classes::xotcl2::${cl}::forward \
+ ${:name} ${:manager} [list %1 [${:manager} defaultmethods]] %self \
+ ${:methodname}
}
}
@@ -518,29 +518,29 @@
$obj info $prop
}
::xotcl::InfoSlot public method add {obj prop value {pos 0}} {
- if {![set .multivalued]} {
- error "Property $prop of ${.domain}->$obj ist not multivalued"
+ if {![set :multivalued]} {
+ error "Property $prop of ${:domain}->$obj ist not multivalued"
}
#puts stderr "adding infoslot: $obj $prop [linsert [$obj info $prop] $pos $value]"
$obj $prop [linsert [$obj info $prop] $pos $value]
}
::xotcl::InfoSlot protected method delete_value {obj prop old value} {
if {[string first * $value] > -1 || [string first \[ $value] > -1} {
# string contains meta characters
- if {${.elementtype} ne "" && ![string match ::* $value]} {
+ if {${:elementtype} ne "" && ![string match ::* $value]} {
# prefix string with ::, since all object names have leading ::
set value ::$value
}
return [lsearch -all -not -glob -inline $old $value]
- } elseif {${.elementtype} ne ""} {
+ } elseif {${:elementtype} ne ""} {
if {[string first :: $value] == -1} {
if {![::xotcl::is $value object]} {
error "$value does not appear to be an object"
}
set value [::xotcl::dispatch $value -objscope ::xotcl::self]
}
- if {![::xotcl::is ${.elementtype} class]} {
- error "$value does not appear to be of type ${.elementtype}"
+ if {![::xotcl::is ${:elementtype} class]} {
+ error "$value does not appear to be of type ${:elementtype}"
}
}
set p [lsearch -exact $old $value]
@@ -553,7 +553,7 @@
::xotcl::InfoSlot public method delete {-nocomplain:switch obj prop value} {
#puts stderr infoslot-delete-[self args]
- $obj $prop [.delete_value $obj $prop [$obj info $prop] $value]
+ $obj $prop [:delete_value $obj $prop [$obj info $prop] $value]
}
############################################
@@ -569,15 +569,15 @@
::xotcl::relation $obj $prop
}
::xotcl::InterceptorSlot public method add {obj prop value {pos 0}} {
- if {![set .multivalued]} {
- error "Property $prop of ${.domain}->$obj ist not multivalued"
+ if {![set :multivalued]} {
+ error "Property $prop of ${:domain}->$obj ist not multivalued"
}
set oldSetting [::xotcl::relation $obj $prop]
# use uplevel to avoid namespace surprises
uplevel [list ::xotcl::relation $obj $prop [linsert $oldSetting $pos $value]]
}
::xotcl::InterceptorSlot public method delete {-nocomplain:switch obj prop value} {
- uplevel [list ::xotcl::relation $obj $prop [.delete_value $obj $prop [::xotcl::relation $obj $prop] $value]]
+ uplevel [list ::xotcl::relation $obj $prop [:delete_value $obj $prop [::xotcl::relation $obj $prop] $value]]
}
############################################
@@ -660,31 +660,31 @@
::xotcl::Attribute method check_multiple_values {values predicate type obj var} {
foreach value $values {
- .check_single_value -keep_old_value false $value $predicate $type $obj $var
+ :check_single_value -keep_old_value false $value $predicate $type $obj $var
}
::xotcl::setinstvar $obj __oldvalue($var) $value
}
::xotcl::Attribute method mk_type_checker {} {
set __initcmd ""
- if {[.exists type]} {
- if {[::xotcl::is ${.type} class]} {
+ if {[:exists type]} {
+ if {[::xotcl::is ${:type} class]} {
set predicate [subst -nocommands {
- [::xotcl::is \$value object] && [::xotcl::is \$value type ${.type}]
+ [::xotcl::is \$value object] && [::xotcl::is \$value type ${:type}]
}]
- } elseif {[llength ${.type}]>1} {
- set predicate "\[${.type} \$value\]"
+ } elseif {[llength ${:type}]>1} {
+ set predicate "\[${:type} \$value\]"
} else {
- #set predicate "\[string is ${.type} \$value\]"
- set predicate "\[.type=${.type} ${.name} \$value\]"
+ #set predicate "\[string is ${:type} \$value\]"
+ set predicate "\[:type=${:type} ${:name} \$value\]"
}
#puts stderr predicate=$predicate
- append .valuechangedcmd [subst {
- [expr {${.multivalued} ? ".check_multiple_values" : ".check_single_value"
- }] \[::xotcl::setinstvar \$obj ${.name}\] \
- {$predicate} [list ${.type}] \$obj ${.name}
+ append :valuechangedcmd [subst {
+ [expr {${:multivalued} ? ":check_multiple_values" : ":check_single_value"
+ }] \[::xotcl::setinstvar \$obj ${:name}\] \
+ {$predicate} [list ${:type}] \$obj ${:name}
}]
append __initcmd [subst -nocommands {
- if {[.exists ${.name}]} {set .__oldvalue(${.name}) [set .${.name}]}\n
+ if {[:exists ${:name}]} {set :__oldvalue(${:name}) [set :${:name}]}\n
}]
}
return $__initcmd
@@ -693,43 +693,43 @@
next ;# do first ordinary slot initialization
# there might be already default values registered on the class
set __initcmd ""
- if {[.exists default]} {
- } elseif [.exists initcmd] {
- append __initcmd ".trace add variable [list ${.name}] read \
- \[list [::xotcl::self] __default_from_cmd \[::xotcl::self\] [list [set .initcmd]]\]\n"
- } elseif [.exists valuecmd] {
- append __initcmd ".trace add variable [list ${.name}] read \
- \[list [::xotcl::self] __value_from_cmd \[::xotcl::self\] [list [set .valuecmd]]\]"
+ if {[:exists default]} {
+ } elseif [:exists initcmd] {
+ append __initcmd ":trace add variable [list ${:name}] read \
+ \[list [::xotcl::self] __default_from_cmd \[::xotcl::self\] [list [set :initcmd]]\]\n"
+ } elseif [:exists valuecmd] {
+ append __initcmd ":trace add variable [list ${:name}] read \
+ \[list [::xotcl::self] __value_from_cmd \[::xotcl::self\] [list [set :valuecmd]]\]"
}
- #append __initcmd [.mk_type_checker]
- if {[.exists valuechangedcmd]} {
- append __initcmd ".trace add variable [list ${.name}] write \
- \[list [::xotcl::self] __value_changed_cmd \[::xotcl::self\] [list [set .valuechangedcmd]]\]"
+ #append __initcmd [:mk_type_checker]
+ if {[:exists valuechangedcmd]} {
+ append __initcmd ":trace add variable [list ${:name}] write \
+ \[list [::xotcl::self] __value_changed_cmd \[::xotcl::self\] [list [set :valuechangedcmd]]\]"
}
if {$__initcmd ne ""} {
- set .initcmd $__initcmd
+ set :initcmd $__initcmd
}
}
# mixin class for decativating all value checks in slots
::xotcl2::Class create ::xotcl::Slot::Nocheck {
- .method check_single_value args {;}
- .method check_multiple_values args {;}
- .method mk_type_checker args {return ""}
+ :method check_single_value args {;}
+ :method check_multiple_values args {;}
+ :method mk_type_checker args {return ""}
}
# mixin class for optimizing slots
::xotcl2::Class create ::xotcl::Slot::Optimizer {
- .method method args {::xotcl::next; .optimize}
- .method forward args {::xotcl::next; .optimize}
- .method init args {::xotcl::next; .optimize}
- .public method optimize {} {
- if {[set .multivalued]} return
- if {[set .defaultmethods] ne {get assign}} return
- #puts stderr assign=[.info callable -which assign]
- if {[.info callable -which assign] ne "::xotcl::Slot alias assign ::xotcl::setinstvar"} return
- if {[.info callable -which get] ne "::xotcl::Slot alias get ::xotcl::setinstvar"} return
- #puts stderr "**** optimizing ${.domain} $forwarder ${.name}"
- ::xotcl::setter ${.domain} {*}[expr {${.per-object} ? "-per-object" : ""}] ${.name}
+ :method method args {::xotcl::next; :optimize}
+ :method forward args {::xotcl::next; :optimize}
+ :method init args {::xotcl::next; :optimize}
+ :public method optimize {} {
+ if {[set :multivalued]} return
+ if {[set :defaultmethods] ne {get assign}} return
+ #puts stderr assign=[:info callable -which assign]
+ if {[:info callable -which assign] ne "::xotcl::Slot alias assign ::xotcl::setinstvar"} return
+ if {[:info callable -which get] ne "::xotcl::Slot alias get ::xotcl::setinstvar"} return
+ #puts stderr "**** optimizing ${:domain} $forwarder ${:name}"
+ ::xotcl::setter ${:domain} {*}[expr {${:per-object} ? "-per-object" : ""}] ${:name}
}
}
# register the optimizer per default
@@ -746,7 +746,7 @@
inobject
}
::xotcl::ScopedNew method init {} {
- .public method new {-childof args} {
+ :public method new {-childof args} {
::xotcl::importvar [::xotcl::self class] {inobject object} withclass
if {![::xotcl::is $object object]} {
$withclass create $object
@@ -876,8 +876,8 @@
objLength
} {
- .method makeTargetList {t} {
- lappend .targetList $t
+ :method makeTargetList {t} {
+ lappend :targetList $t
# if it is an object without namespace, it is a leaf
if {[::xotcl::is $t object]} {
if {[$t info hasnamespace]} {
@@ -899,26 +899,26 @@
# a namespace or an obj with namespace may have children
# itself
foreach c $children {
- .makeTargetList $c
+ :makeTargetList $c
}
}
- .method copyNSVarsAndCmds {orig dest} {
+ :method copyNSVarsAndCmds {orig dest} {
::xotcl::namespace_copyvars $orig $dest
::xotcl::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 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]
+ :method copyTargets {} {
+ #puts stderr "COPY will copy targetList = [set :targetList]"
+ foreach origin [set :targetList] {
+ set dest [:getDest $origin]
if {[::xotcl::is $origin object]} {
# copy class information
if {[::xotcl::is $origin class]} {
@@ -929,7 +929,7 @@
::xotcl::assertion $cl class-invar [::xotcl::assertion $origin class-invar]
::xotcl::relation $cl class-filter [::xotcl::relation $origin class-filter]
::xotcl::relation $cl class-mixin [::xotcl::relation $origin class-mixin]
- .copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest
+ :copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest
} else {
# create obj
set obj [[$origin info class] create $dest -noinit]
@@ -945,7 +945,7 @@
} else {
namespace eval $dest {}
}
- .copyNSVarsAndCmds $origin $dest
+ :copyNSVarsAndCmds $origin $dest
foreach i [$origin info forward] {
eval [concat $dest forward $i [$origin info forward -definition $i]]
}
@@ -971,9 +971,9 @@
#puts stderr "====="
}
# alter 'domain' and 'manager' in slot objects for classes
- foreach origin [set .targetList] {
+ foreach origin [set :targetList] {
if {[::xotcl::is $origin class]} {
- set dest [.getDest $origin]
+ set dest [:getDest $origin]
foreach oldslot [$origin info slots] {
set newslot ${dest}::slot::[namespace tail $oldslot]
if {[$oldslot domain] eq $origin} {$newslot domain $cl}
@@ -983,12 +983,12 @@
}
}
- .public method copy {obj dest} {
+ :public method copy {obj dest} {
#puts stderr "[::xotcl::self] copy <$obj> <$dest>"
- set .objLength [string length $obj]
- set .dest $dest
- .makeTargetList $obj
- .copyTargets
+ set :objLength [string length $obj]
+ set :dest $dest
+ :makeTargetList $obj
+ :copyTargets
}
}
@@ -1002,19 +1002,19 @@
::xotcl2::Object public method move newName {
if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {
if {$newName ne ""} {
- .copy $newName
+ :copy $newName
}
### let all subclasses get the copied class as superclass
if {[::xotcl::is [::xotcl::self] class] && $newName ne ""} {
- foreach subclass [.info subclass] {
+ foreach subclass [:info subclass] {
set scl [$subclass info superclass]
if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} {
set scl [lreplace $scl $index $index $newName]
$subclass superclass $scl
}
}
}
- .destroy
+ :destroy
}
}
@@ -1025,7 +1025,7 @@
# documentation stub object -> just ignore per default.
# if xoDoc is loaded, documentation will be activated
::xotcl2::Object create ::xotcl::@ {
- .method unknown args {}
+ :method unknown args {}
}
Index: generic/xotcl.c
===================================================================
diff -u -r99b9e9e9c78df12e482d16bca08ffeb5998b3b02 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- generic/xotcl.c (.../xotcl.c) (revision 99b9e9e9c78df12e482d16bca08ffeb5998b3b02)
+++ generic/xotcl.c (.../xotcl.c) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -1520,7 +1520,7 @@
NsDotVarResolver(Tcl_Interp *interp, CONST char *varName, Tcl_Namespace *nsPtr, int flags, Tcl_Var *varPtr) {
Tcl_CallFrame *varFramePtr;
int new, frameFlags;
- char firstChar;
+ char firstChar, secondChar;
Tcl_Obj *key;
Var *newVar;
@@ -1558,14 +1558,22 @@
}
firstChar = *varName;
+ secondChar = *(varName+1);
- if ((frameFlags & (FRAME_IS_XOTCL_CMETHOD|FRAME_IS_XOTCL_OBJECT)) && firstChar == '.') {
+ if ((frameFlags & (FRAME_IS_XOTCL_CMETHOD|FRAME_IS_XOTCL_OBJECT)) &&
+#if USE_DOT
+ firstChar == '.'
+#endif
+#if USE_COLON
+ firstChar == ':' && secondChar != ':'
+#endif
+ ) {
/*
* Case 3: we are in an XOTcl frame and the variable name starts with a "."
* We skip the dot, but stay in the resolver.
*/
varName ++;
- } else if ((*varName == ':' && *(varName+1) == ':') || NSTail(varName) != varName) {
+ } else if ((firstChar == ':' && secondChar == ':') || NSTail(varName) != varName) {
/*
* Case 4: Check for absolutely/relatively qualified variable names,
@@ -1585,7 +1593,14 @@
* TCL_CONTINUE care for variable creation if necessary.
*/
- if (firstChar != '.' && (frameFlags & FRAME_IS_XOTCL_CMETHOD)) {
+ if (
+#if USE_DOT
+ firstChar != '.'
+#endif
+#if USE_COLON
+ firstChar != ':'
+#endif
+ && (frameFlags & FRAME_IS_XOTCL_CMETHOD)) {
fprintf(stderr, ".... refuse to create var %s\n", varName);
return TCL_CONTINUE;
}
@@ -1712,6 +1727,13 @@
ckfree((char *) vinfoPtr);
}
+#if USE_DOT
+#define FOR_RESOLVER(ptr) (*(ptr) == '.')
+#endif
+#if USE_COLON
+#define FOR_RESOLVER(ptr) (*(ptr) == ':' && *(ptr+1) != ':')
+#endif
+
int InterpCompiledDotVarResolver(Tcl_Interp *interp,
CONST84 char *name, int length, Tcl_Namespace *context,
Tcl_ResolvedVarInfo **rPtr) {
@@ -1721,7 +1743,7 @@
fprintf(stderr, "compiled var resolver for %s, obj %p\n", name, obj);
#endif
- if (obj && *name == '.') {
+ if (obj && FOR_RESOLVER(name)) {
xotclResolvedVarInfo *vInfoPtr = (xotclResolvedVarInfo *) ckalloc(sizeof(xotclResolvedVarInfo));
vInfoPtr->vInfo.fetchProc = CompiledDotVarFetch;
@@ -1744,7 +1766,7 @@
CallFrame *varFramePtr;
int frameFlags;
- if (*cmdName != '.' || flags & TCL_GLOBAL_ONLY) {
+ if (!FOR_RESOLVER(cmdName) || flags & TCL_GLOBAL_ONLY) {
/* ordinary names and global lookups are not for us */
return TCL_CONTINUE;
}
@@ -1805,7 +1827,7 @@
/*fprintf(stderr, "InterpDotVarResolver '%s' flags %.6x\n", varName, flags);*/
- if (*varName != '.' || flags & TCL_GLOBAL_ONLY) {
+ if (!FOR_RESOLVER(varName) || flags & TCL_GLOBAL_ONLY) {
/* ordinary names and global lookups are not for us */
return TCL_CONTINUE;
}
@@ -5852,7 +5874,7 @@
methodName = ObjStr(methodObj);
#if defined(USE_COMPILED_VAR_RESOLVER)
- if (*methodName == '.') {
+ if (FOR_RESOLVER(methodName)) {
methodName ++;
}
#endif
@@ -8682,7 +8704,7 @@
/* if we dispatch a method via ".", we do not want to see the
"." in the %proc, e.g. for the interceptor slots (such as
.mixin, ... */
- if (*methodName == '.') {
+ if (FOR_RESOLVER(methodName)) {
*out = Tcl_NewStringObj(methodName + 1, -1);
} else {
*out = objv[0];
@@ -9167,15 +9189,15 @@
if (Tcl_ListObjGetElements(interp, obj, objc, objv) == TCL_OK && *objc>1) {
flag = ObjStr(*objv[0]);
/*fprintf(stderr, "we have a list starting with '%s'\n", flag);*/
- if (*flag == '-' || *flag == '.') {
+ if (*flag == '-' || *flag == '.') { /* TODO '.' needed? */
*methodName = flag+1;
return LIST_DASH;
}
}
}
flag = ObjStr(obj);
/*fprintf(stderr, "we have a scalar '%s'\n", flag);*/
- if ((*flag == '-' /*|| *flag == '.'*/) && isalpha(*((flag)+1))) {
+ if ((*flag == '-') && isalpha(*((flag)+1))) {
if (firstArg) {
/* if the argument contains a space, try to split */
char *p= flag+1;
@@ -12424,7 +12446,7 @@
if (objc == 2) {
Tcl_Obj **ov;
char *word = ObjStr(objv[1]);
- if (*word != '.' && *word != '-') {
+ if (*word != '.' && *word != '-') { /* TODO '.' needed */
char *p = word;
while (*p && *p != ' ') p++;
if (*p) {
Index: generic/xotcl.h
===================================================================
diff -u -rf6775105babd749f662856c7eff1a903636e80e0 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- generic/xotcl.h (.../xotcl.h) (revision f6775105babd749f662856c7eff1a903636e80e0)
+++ generic/xotcl.h (.../xotcl.h) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -86,6 +86,7 @@
#define USE_COMPILED_VAR_RESOLVER 1
*/
+#define USE_COLON 1
#define USE_COMPILED_VAR_RESOLVER 1
#if !defined(PRE86)
Index: library/lib/test.xotcl
===================================================================
diff -u -rf279bf06b31139084edd5136824a1e2622265e00 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- library/lib/test.xotcl (.../test.xotcl) (revision f279bf06b31139084edd5136824a1e2622265e00)
+++ library/lib/test.xotcl (.../test.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -34,71 +34,71 @@
msg setResult errorReport
pre post
} {
- set .count 0
+ set :count 0
- .public object method case {name} {set .case $name}
+ :public object method case {name} {set :case $name}
- .public object method parameter {name value:optional} {
+ :public object method parameter {name value:optional} {
if {[info exists value]} {
#[[self] slot $name] default $value
[self] slot $name default $value
- .__invalidateobjectparameter
+ :__invalidateobjectparameter
} else {
return [[self] slot $name default]
}
}
- .public object method new args {
- if {[info exists .case]} {
- if {![info exists .ccount(${.case})]} {set .ccount(${.case}) 0}
- set .name ${.case}.[format %.3d [incr .ccount(${.case})]]
+ :public object method new args {
+ if {[info exists :case]} {
+ if {![info exists :ccount(${:case})]} {set :ccount(${:case}) 0}
+ set :name ${:case}.[format %.3d [incr :ccount(${:case})]]
} else {
- set .name t.[format %.3d [incr .count]]
+ set :name t.[format %.3d [incr :count]]
}
- eval .create ${.name} -name ${.name} $args
+ eval :create ${:name} -name ${:name} $args
}
- .public object method run {} {
+ :public object method run {} {
set startTime [clock clicks -milliseconds]
- foreach example [lsort [.info instances -closure]] {
+ foreach example [lsort [:info instances -closure]] {
$example run
}
puts stderr "Total Time: [expr {[clock clicks -milliseconds]-$startTime}] ms"
}
- .public method call {msg cmd} {
- if {[.verbose]} {puts stderr "$msg: $cmd"}
- namespace eval ${.namespace} $cmd
+ :public method call {msg cmd} {
+ if {[:verbose]} {puts stderr "$msg: $cmd"}
+ namespace eval ${:namespace} $cmd
}
- .public method run args {
- if {[info exists .pre]} {.call "pre" ${.pre}}
- if {![info exists .msg]} {set .msg ${.cmd}}
- set r [.call "run" ${.cmd}]
- if {[info exists .setResult]} {set r [eval [set .setResult]]}
- if {$r eq ${.expected}} {
- if {[info exists .count]} {set c ${.count}} {set c 1000}
- if {[.verbose]} {
+ :public method run args {
+ if {[info exists :pre]} {:call "pre" ${:pre}}
+ if {![info exists :msg]} {set :msg ${:cmd}}
+ set r [:call "run" ${:cmd}]
+ if {[info exists :setResult]} {set r [eval [set :setResult]]}
+ if {$r eq ${:expected}} {
+ if {[info exists :count]} {set c ${:count}} {set c 1000}
+ if {[:verbose]} {
puts stderr "running test $c times"
}
if {$c > 1} {
- #set r0 [time ${.cmd} $c]
- #puts stderr "time {time ${.cmd} $c}"
- set r1 [time {time {namespace eval ${.namespace} ${.cmd}} $c}]
+ #set r0 [time ${:cmd} $c]
+ #puts stderr "time {time ${:cmd} $c}"
+ set r1 [time {time {namespace eval ${:namespace} ${:cmd}} $c}]
#regexp {^(-?[0-9]+) +} $r0 _ mS0
regexp {^(-?[0-9]+) +} $r1 _ mS1
set ms [expr {$mS1*1.0/$c}]
- puts stderr "[set .name]:\t[format %6.2f $ms] mms, ${.msg}"
+ puts stderr "[set :name]:\t[format %6.2f $ms] mms, ${:msg}"
} else {
- puts stderr "[set .name]: ${.msg} ok"
+ puts stderr "[set :name]: ${:msg} ok"
}
} else {
- puts stderr "[set .name]:\tincorrect result for '${.msg}'"
- puts stderr "\texpected: '${.expected}', got '$r' [info exists .errorReport]"
- if {[info exists .errorReport]} {eval [set .errorReport]}
+ puts stderr "[set :name]:\tincorrect result for '${:msg}'"
+ puts stderr "\texpected: '${:expected}', got '$r' [info exists :errorReport]"
+ if {[info exists :errorReport]} {eval [set :errorReport]}
exit -1
}
- if {[info exists .post]} {.call "post" ${.post}}
+ if {[info exists :post]} {:call "post" ${:post}}
}
}
Index: library/lib/xotcl1.xotcl
===================================================================
diff -u -reef622da1b387cfd1dd68babeb0bfecfbae5caa3 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision eef622da1b387cfd1dd68babeb0bfecfbae5caa3)
+++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -57,13 +57,13 @@
# define - like in XOTcl 1 - a minimal implementation of "method"
Object instproc method {name arguments body} {
- .proc $name $arguments $body
+ :proc $name $arguments $body
}
Class instproc method {-per-object:switch name arguments body} {
if {${per-object}} {
- .proc $name $arguments $body
+ :proc $name $arguments $body
} else {
- .instproc $name $arguments $body
+ :instproc $name $arguments $body
}
}
@@ -171,7 +171,7 @@
return "valid options are: [join [lsort $methods] {, }]"
}
objectInfo proc unknown {method args} {
- error "[::xotcl::self] unknown info option \"$method\"; [.info info]"
+ error "[::xotcl::self] unknown info option \"$method\"; [:info info]"
}
classInfo proc info {cl} {
@@ -185,7 +185,7 @@
}
classInfo proc unknown {method args} {
- error "[::xotcl::self] unknown info option \"$method\"; [.info info]"
+ error "[::xotcl::self] unknown info option \"$method\"; [:info info]"
}
#
@@ -272,53 +272,53 @@
}
classInfo eval {
- .proc instargs {o method} {::xotcl::info_args Class $o $method}
- .proc args {o method} {::xotcl::info_args Object $o $method}
- .proc instnonposargs {o method} {::xotcl::info_nonposargs Class $o $method}
- .proc nonposargs {o method} {::xotcl::info_nonposargs Object $o $method}
- .proc instdefault {o method arg var} {::xotcl::info_default Class $o $method $arg $var}
- .proc default {o method arg var} {::xotcl::info_default Object $o $method $arg $var}
+ :proc instargs {o method} {::xotcl::info_args Class $o $method}
+ :proc args {o method} {::xotcl::info_args Object $o $method}
+ :proc instnonposargs {o method} {::xotcl::info_nonposargs Class $o $method}
+ :proc nonposargs {o method} {::xotcl::info_nonposargs Object $o $method}
+ :proc instdefault {o method arg var} {::xotcl::info_default Class $o $method $arg $var}
+ :proc default {o method arg var} {::xotcl::info_default Object $o $method $arg $var}
# info options emulated by "info method ..."
- .proc instbody {o methodName} {::xotcl::cmd::ClassInfo::method $o body $methodName}
- .proc instpre {o methodName} {::xotcl::cmd::ClassInfo::method $o precondition $methodName}
- .proc instpost {o methodName} {::xotcl::cmd::ClassInfo::method $o postcondition $methodName}
+ :proc instbody {o methodName} {::xotcl::cmd::ClassInfo::method $o body $methodName}
+ :proc instpre {o methodName} {::xotcl::cmd::ClassInfo::method $o precondition $methodName}
+ :proc instpost {o methodName} {::xotcl::cmd::ClassInfo::method $o postcondition $methodName}
# info options emulated by "info methods"
- .proc instcommands {o {pattern:optional ""}} {
+ :proc instcommands {o {pattern:optional ""}} {
::xotcl::cmd::ClassInfo::methods $o {*}$pattern
}
- .proc instprocs {o {pattern:optional ""}} {
+ :proc instprocs {o {pattern:optional ""}} {
::xotcl::cmd::ClassInfo::methods $o -methodtype scripted {*}$pattern
}
- .proc parametercmd {o {pattern:optional ""}} {
+ :proc parametercmd {o {pattern:optional ""}} {
::xotcl::cmd::ClassInfo::methods $o -per-object -methodtype setter {*}$pattern
}
- .proc instparametercmd {o {pattern:optional ""}} {
+ :proc instparametercmd {o {pattern:optional ""}} {
::xotcl::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern
}
# assertion handling
- .proc instinvar {o} {::xotcl::assertion $o class-invar}
+ :proc instinvar {o} {::xotcl::assertion $o class-invar}
}
objectInfo eval {
- .proc args {o method} {::xotcl::info_args Object $o $method}
- .proc nonposargs {o method} {::xotcl::info_nonposargs Object $o $method}
- .proc default {o method arg var} {::xotcl::info_default Object $o $method $arg $var}
+ :proc args {o method} {::xotcl::info_args Object $o $method}
+ :proc nonposargs {o method} {::xotcl::info_nonposargs Object $o $method}
+ :proc default {o method arg var} {::xotcl::info_default Object $o $method $arg $var}
# info options emulated by "info method ..."
- .proc body {o methodName} {::xotcl::cmd::ObjectInfo::method $o body $methodName}
- .proc pre {o methodName} {::xotcl::cmd::ObjectInfo::method $o pre $methodName}
- .proc post {o methodName} {::xotcl::cmd::ObjectInfo::method $o post $methodName}
+ :proc body {o methodName} {::xotcl::cmd::ObjectInfo::method $o body $methodName}
+ :proc pre {o methodName} {::xotcl::cmd::ObjectInfo::method $o pre $methodName}
+ :proc post {o methodName} {::xotcl::cmd::ObjectInfo::method $o post $methodName}
# info options emulated by "info methods"
- .proc commands {o {pattern:optional ""}} {
+ :proc commands {o {pattern:optional ""}} {
::xotcl::cmd::ObjectInfo::methods $o {*}$pattern
}
- .proc procs {o {pattern:optional ""}} {
+ :proc procs {o {pattern:optional ""}} {
::xotcl::cmd::ObjectInfo::methods $o -methodtype scripted {*}$pattern
}
- .proc methods {
+ :proc methods {
o -nocmds:switch -noprocs:switch -incontext:switch pattern:optional
} {
set methodtype all
@@ -330,7 +330,7 @@
eval $cmd
}
# object filter mapping
- .proc filter {o -order:switch -guards:switch pattern:optional} {
+ :proc filter {o -order:switch -guards:switch pattern:optional} {
set guardsFlag [expr {$guards ? "-guards" : ""}]
set patternArg [expr {[info exists pattern] ? [list $pattern] : ""}]
if {$order && !$guards} {
@@ -344,10 +344,10 @@
return $def
}
# assertion handling
- .proc check {o} {
+ :proc check {o} {
::xotcl::checkoption_internal_to_xotcl1 [::xotcl::assertion $o check]
}
- .proc invar {o} {::xotcl::assertion $o object-invar}
+ :proc invar {o} {::xotcl::assertion $o object-invar}
}
foreach cmd [::info command ::xotcl::cmd::ObjectInfo::*] {
@@ -480,7 +480,7 @@
error "invalid method type '$methtype', \
must be either 'proc', 'instproc' or 'method'."
}
- .$methtype $methname $arglist "
+ :$methtype $methname $arglist "
if {!\[::xotcl::self isnextcall\]} {
error \"Abstract method $methname $arglist called\"
} else {::xotcl::next}
@@ -519,7 +519,7 @@
}
Class instproc allinstances {} {
# TODO: mark it deprecated
- return [.info instances -closure]
+ return [:info instances -closure]
}
# keep old object interface for xotcl 1.*
@@ -664,65 +664,65 @@
{export {}}
} {
- .public object method create {name args} {
+ :public object method create {name args} {
set nq [namespace qualifiers $name]
if {$nq ne "" && ![namespace exists $nq]} {Object create $nq}
next
}
- .public object method extend {name args} {
- .require $name
+ :public object method extend {name args} {
+ :require $name
eval $name configure $args
}
- .public object method contains script {
- if {[.exists provide]} {
- package provide [set .provide] [set .version]
+ :public object method contains script {
+ if {[:exists provide]} {
+ package provide [set :provide] [set :version]
} else {
- package provide [::xotcl::self] [set .version]
+ package provide [::xotcl::self] [set :version]
}
namespace eval [::xotcl::self] {namespace import ::xotcl::*}
namespace eval [::xotcl::self] $script
- foreach e [set .export] {
+ foreach e [set :export] {
set nq [namespace qualifiers $e]
if {$nq ne ""} {
namespace eval [::xotcl::self]::$nq [list namespace export [namespace tail $e]]
} else {
namespace eval [::xotcl::self] [list namespace export $e]
}
}
- foreach e [set .autoexport] {
+ foreach e [set :autoexport] {
namespace eval :: [list namespace import [::xotcl::self]::$e]
}
}
- .public object method unknown args {
+ :public object method unknown args {
#puts stderr "unknown: package $args"
- eval [set .packagecmd] $args
+ eval [set :packagecmd] $args
}
- .public object method verbose value {
- set .verbose $value
+ :public object method verbose value {
+ set :verbose $value
}
- .public object method present args {
+ :public object method present args {
if {$::tcl_version<8.3} {
switch -exact -- [lindex $args 0] {
-exact {set pkg [lindex $args 1]}
default {set pkg [lindex $args 0]}
}
- if {[info exists .loaded($pkg)]} {
- return ${.loaded}($pkg)
+ if {[info exists :loaded($pkg)]} {
+ return ${:loaded}($pkg)
} else {
error "not found"
}
} else {
- eval [set .packagecmd] present $args
+ eval [set :packagecmd] present $args
}
}
- .public object method import {{-into ::} pkg} {
- .require $pkg
+ :public object method import {{-into ::} pkg} {
+ :require $pkg
namespace eval $into [subst -nocommands {
#puts stderr "*** package import ${pkg}::* into [namespace current]"
namespace import ${pkg}::*
@@ -736,31 +736,31 @@
}
}
- .public object method require args {
+ :public object method require args {
#puts "XOTCL package require $args, current=[namespace current]"
- set prevComponent ${.component}
+ set prevComponent ${:component}
if {[catch {set v [eval package present $args]} msg]} {
#puts stderr "we have to load $msg"
switch -exact -- [lindex $args 0] {
-exact {set pkg [lindex $args 1]}
default {set pkg [lindex $args 0]}
}
- set .component $pkg
- lappend .uses($prevComponent) ${.component}
- set v [uplevel \#1 [set .packagecmd] require $args]
- if {$v ne "" && ${.verbose}} {
+ set :component $pkg
+ lappend :uses($prevComponent) ${:component}
+ set v [uplevel \#1 [set :packagecmd] require $args]
+ if {$v ne "" && ${:verbose}} {
set path [lindex [::package ifneeded $pkg $v] 1]
puts "... $pkg $v loaded from '$path'"
- set .loaded($pkg) $v ;# loaded stuff needed for Tcl 8.0
+ set :loaded($pkg) $v ;# loaded stuff needed for Tcl 8.0
}
}
- set .component $prevComponent
+ set :component $prevComponent
return $v
}
- set .component .
- set .verbose 0
- set .packagecmd ::package
+ set :component .
+ set :verbose 0
+ set :packagecmd ::package
}
if {[info exists cmd]} {unset cmd}
Index: library/serialize/Serializer.xotcl
===================================================================
diff -u -reef622da1b387cfd1dd68babeb0bfecfbae5caa3 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision eef622da1b387cfd1dd68babeb0bfecfbae5caa3)
+++ library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -142,38 +142,38 @@
Class create Serializer -parameter {ignoreVarsRE} {
- .method ignore args {
+ :method ignore args {
# Ignore the objects passed via args.
- # .skip is used for filtering only in the topological sort.
+ # :skip is used for filtering only in the topological sort.
foreach element $args {
foreach o [Serializer allChildren $element] {
- set .skip($o) 1
+ set :skip($o) 1
}
}
}
- .method init {} {
+ :method init {} {
# Never serialize the (volatile) serializer object
- .ignore [self]
+ :ignore [self]
}
- .method warn msg {
+ :method warn msg {
if {[info command ns_log] ne ""} {
ns_log Notice $msg
} else {
puts stderr "!!! $msg"
}
}
- .method addPostCmd {cmd} {
- if {$cmd ne ""} {append .post_cmds $cmd "\n"}
+ :method addPostCmd {cmd} {
+ if {$cmd ne ""} {append :post_cmds $cmd "\n"}
}
- .method setObjectSystemSerializer {o serializer} {
- set .serializer($o) $serializer
+ :method setObjectSystemSerializer {o serializer} {
+ set :serializer($o) $serializer
}
- .method isExportedObject {o} {
+ :method isExportedObject {o} {
# Check, whether o is exported. For exported objects.
# we export the object tree.
set oo $o
@@ -189,60 +189,60 @@
}
}
- .method topoSort {set all} {
- if {[array exists .s]} {array unset .s}
- if {[array exists .level]} {array unset .level}
+ :method topoSort {set all} {
+ if {[array exists :s]} {array unset :s}
+ if {[array exists :level]} {array unset :level}
foreach c $set {
if {!$all &&
[string match "::xotcl::*" $c] &&
- ![.isExportedObject $c]} continue
- if {[info exists .skip($c)]} continue
- set .s($c) 1
+ ![:isExportedObject $c]} continue
+ if {[info exists :skip($c)]} continue
+ set :s($c) 1
}
set stratum 0
while {1} {
- set set [array names .s]
+ set set [array names :s]
if {[llength $set] == 0} break
incr stratum
- # .warn "$stratum set=$set"
- set .level($stratum) {}
+ # :warn "$stratum set=$set"
+ set :level($stratum) {}
foreach c $set {
- set oss [set .serializer($c)]
+ set oss [set :serializer($c)]
if {[$oss needsNothing $c [self]]} {
- lappend .level($stratum) $c
+ lappend :level($stratum) $c
}
}
- if {[set .level($stratum)] eq ""} {
- set .level($stratum) $set
- .warn "Cyclic dependency in $set"
+ if {[set :level($stratum)] eq ""} {
+ set :level($stratum) $set
+ :warn "Cyclic dependency in $set"
}
- foreach i [set .level($stratum)] {unset .s($i)}
+ foreach i [set :level($stratum)] {unset :s($i)}
}
}
- .method needsOneOf list {
- foreach e $list {if {[info exists .s($e)]} {return 1}}
+ :method needsOneOf list {
+ foreach e $list {if {[info exists :s($e)]} {return 1}}
return 0
}
- .method serialize-objects {list all} {
- set .post_cmds ""
+ :method serialize-objects {list all} {
+ set :post_cmds ""
# register for introspection purposes "trace" under a different
# name for every object system
foreach oss [ObjectSystemSerializer info instances] {
$oss registerTrace 1
}
- .topoSort $list $all
- #foreach i [lsort [array names .level]] { .warn "$i: [set .level($i)]"}
+ :topoSort $list $all
+ #foreach i [lsort [array names :level]] { :warn "$i: [set :level($i)]"}
set result ""
- foreach l [lsort -integer [array names .level]] {
- foreach i [set .level($l)] {
+ foreach l [lsort -integer [array names :level]] {
+ foreach i [set :level($l)] {
#.warn "serialize $i"
#append result "# Stratum $l\n"
- set oss [set .serializer($i)]
+ set oss [set :serializer($i)]
append result [$oss serialize $i [self]] \n
}
}
@@ -280,80 +280,80 @@
append exports "namespace eval $ns {namespace export $exp}" \n
}
}
- return $pre_cmds$result${.post_cmds}$exports
+ return $pre_cmds$result${:post_cmds}$exports
}
- .method deepSerialize o {
+ :method deepSerialize o {
# assumes $o to be fully qualified
set instances [Serializer allChildren $o]
foreach oss [ObjectSystemSerializer info instances] {
$oss registerSerializer [self] $instances
}
- .serialize-objects $instances 1
+ :serialize-objects $instances 1
}
###############################
# class object specfic methods
###############################
- .object method allChildren o {
+ :object method allChildren o {
# return o and all its children fully qualified
set set [::xotcl::dispatch $o -objscope ::xotcl::self]
foreach c [$o info children] {
- lappend set {*}[.allChildren $c]
+ lappend set {*}[:allChildren $c]
}
return $set
}
- .object method exportMethods list {
- foreach {o p m} $list {set .exportMethods([list $o $p $m]) 1}
+ :object method exportMethods list {
+ foreach {o p m} $list {set :exportMethods([list $o $p $m]) 1}
}
- .object method exportObjects list {
- foreach o $list {set .exportObjects($o) 1}
+ :object method exportObjects list {
+ foreach o $list {set :exportObjects($o) 1}
}
- .object method exportedMethods {} {array names .exportMethods}
- .object method exportedObjects {} {array names .exportObjects}
+ :object method exportedMethods {} {array names :exportMethods}
+ :object method exportedObjects {} {array names :exportObjects}
- .object method resetPattern {} {array unset .ignorePattern}
- .object method addPattern {p} {set .ignorePattern($p) 1}
+ :object method resetPattern {} {array unset :ignorePattern}
+ :object method addPattern {p} {set :ignorePattern($p) 1}
- .object method checkExportedMethods {} {
- foreach k [array names .exportMethods] {
+ :object method checkExportedMethods {} {
+ foreach k [array names :exportMethods] {
foreach {o p m} $k break
set ok 0
- foreach p [array names .ignorePattern] {
+ foreach p [array names :ignorePattern] {
if {[string match $p $o]} {
set ok 1; break
}
}
if {!$ok} {
error "method export is only for classes in\
- [join [array names .ignorePattern] {, }] not for $o"
+ [join [array names :ignorePattern] {, }] not for $o"
}
}
}
- .object method checkExportedObject {} {
- foreach o [array names .exportObjects] {
+ :object method checkExportedObject {} {
+ foreach o [array names :exportObjects] {
if {![::xotcl::is $o object]} {
puts stderr "Serializer exportObject: ignore non-existing object $o"
- unset .exportObjects($o)
+ unset :exportObjects($o)
} else {
# add all child objects
- foreach o [.allChildren $element] {
- set .exportObjects($o) 1
+ foreach o [:allChildren $element] {
+ set :exportObjects($o) 1
}
}
}
}
- .object method all {-ignoreVarsRE -ignore} {
+ :object method all {-ignoreVarsRE -ignore} {
# don't filter anything during serialization
set filterstate [::xotcl::configure filter off]
- set s [.new -childof [self] -volatile]
+ set s [:new -childof [self] -volatile]
if {[info exists ignoreVarsRE]} {$s ignoreVarsRE $ignoreVarsRE}
if {[info exists ignore]} {$s ignore $ignore}
@@ -363,19 +363,19 @@
::xotcl::configure softrecreate [::xotcl::configure softrecreate]
::xotcl::setExitHandler [list [::xotcl::getExitHandler]]
}]\n
- .resetPattern
+ :resetPattern
set instances [list]
foreach oss [ObjectSystemSerializer info instances] {
append r [$oss serialize-all-start $s]
lappend instances {*}[$oss instances $s]
}
# provide error messages for invalid exports
- .checkExportedMethods
+ :checkExportedMethods
# export the objects and classes
- #$s warn "export objects = [array names .exportObjects]"
- #$s warn "export objects = [array names .exportMethods]"
+ #$s warn "export objects = [array names :exportObjects]"
+ #$s warn "export objects = [array names :exportMethods]"
append r [$s serialize-objects $instances 0]
@@ -392,14 +392,14 @@
return $r
}
- .object method methodSerialize {object method prefix} {
- set s [.new -childof [self] -volatile]
+ :object method methodSerialize {object method prefix} {
+ set s [:new -childof [self] -volatile]
concat $object [$s method-serialize $object $method $prefix]
}
- .object method deepSerialize {-ignoreVarsRE -ignore -map args} {
- .resetPattern
- set s [.new -childof [self] -volatile]
+ :object method deepSerialize {-ignoreVarsRE -ignore -map args} {
+ :resetPattern
+ set s [:new -childof [self] -volatile]
if {[info exists ignoreVarsRE]} {$s ignoreVarsRE $ignoreVarsRE}
if {[info exists ignore]} {$s ignore $ignore}
@@ -411,7 +411,7 @@
}
# include Serializer in the serialized code
- .exportObjects [self]
+ :exportObjects [self]
}
@@ -422,7 +422,7 @@
Class create ObjectSystemSerializer {
- .method init {} {
+ :method init {} {
# Include object system serializers and the meta-class in "Serializer all"
Serializer exportObjects [self class]
Serializer exportObjects [self]
@@ -431,48 +431,48 @@
#
# Methods to be executed at the begin and end of serialize all
#
- .method serialize-all-start {s} {
- .getExported
- return [.serializeExportedMethods $s]
+ :method serialize-all-start {s} {
+ :getExported
+ return [:serializeExportedMethods $s]
}
- .method serialize-all-end {s} {
+ :method serialize-all-end {s} {
set cmd ""
- foreach o [list ${.rootClass} ${.rootMetaClass}] {
+ foreach o [list ${:rootClass} ${:rootMetaClass}] {
append cmd \
- [.frameWorkCmd ::xotcl::relation $o object-mixin] \
- [.frameWorkCmd ::xotcl::relation $o class-mixin] \
- [.frameWorkCmd ::xotcl::assertion $o object-invar] \
- [.frameWorkCmd ::xotcl::assertion $o class-invar]
+ [:frameWorkCmd ::xotcl::relation $o object-mixin] \
+ [:frameWorkCmd ::xotcl::relation $o class-mixin] \
+ [:frameWorkCmd ::xotcl::assertion $o object-invar] \
+ [:frameWorkCmd ::xotcl::assertion $o class-invar]
}
return $cmd
}
- .method registerTrace {on} {
+ :method registerTrace {on} {
if {$on} {
- ::xotcl::alias ${.rootClass} __trace__ -objscope ::trace
+ ::xotcl::alias ${:rootClass} __trace__ -objscope ::trace
} else {
- ::xotcl::method ${.rootClass} __trace__ {} {}
+ ::xotcl::method ${:rootClass} __trace__ {} {}
}
}
#
# Handle association between objects and responsible serializers
#
- .method registerSerializer {s instances} {
+ :method registerSerializer {s instances} {
# Communicate responsibility to serializer object $s
foreach i $instances {
- if {![::xotcl::is $i type ${.rootClass}]} continue
+ if {![::xotcl::is $i type ${:rootClass}]} continue
$s setObjectSystemSerializer $i [self]
}
}
- .method instances {s} {
+ :method instances {s} {
# Compute all instances, for which we are responsible and
# notify serializer object $s
set instances [list]
- foreach i [${.rootClass} info instances -closure] {
- if {[.matchesIgnorePattern $i] && ![info exists .exportObjects($i)]} {
+ foreach i [${:rootClass} info instances -closure] {
+ if {[:matchesIgnorePattern $i] && ![info exists :exportObjects($i)]} {
continue
}
$s setObjectSystemSerializer $i [self]
@@ -482,67 +482,67 @@
return $instances
}
- .method getExported {} {
+ :method getExported {} {
#
# get exported objects and methods from main Serializer for
# which this object specific serializer is responsible
#
foreach k [Serializer exportedMethods] {
foreach {o p m} $k break
- if {[::xotcl::is $o type ${.rootClass}]} {set .exportMethods($k) 1}
+ if {[::xotcl::is $o type ${:rootClass}]} {set :exportMethods($k) 1}
}
foreach o [Serializer exportedObjects] {
- if {[::xotcl::is $o type ${.rootClass}]} {set .exportObjects($o) 1}
+ if {[::xotcl::is $o type ${:rootClass}]} {set :exportObjects($o) 1}
}
- foreach p [array names .ignorePattern] {Serializer addPattern $p}
+ foreach p [array names :ignorePattern] {Serializer addPattern $p}
}
###############################
# general method serialization
###############################
- .method classify {o} {
- if {[::xotcl::is $o type ${.rootMetaClass}]} \
+ :method classify {o} {
+ if {[::xotcl::is $o type ${:rootMetaClass}]} \
{return Class} {return Object}
}
- .method collectVars o {
+ :method collectVars o {
set setcmd [list]
foreach v [lsort [$o info vars]] {
- if {![.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]]]
+ if {![: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 {
- lappend setcmd [list set .$v [::xotcl::setinstvar $o $v]]
+ lappend setcmd [list set :$v [::xotcl::setinstvar $o $v]]
}
}
}
return $setcmd
}
- .method frameWorkCmd {cmd o relation -unless} {
+ :method frameWorkCmd {cmd o relation -unless} {
set v [$cmd $o $relation]
if {$v eq ""} {return ""}
if {[info exists unless] && $v eq $unless} {return ""}
return [list $cmd $o $relation $v]\n
}
- .method serializeExportedMethods {s} {
+ :method serializeExportedMethods {s} {
set r ""
- foreach k [array names .exportMethods] {
+ foreach k [array names :exportMethods] {
foreach {o p m} $k break
- if {![.methodExists $o $p $m]} {
+ if {![:methodExists $o $p $m]} {
$s warn "Method does not exist: $o $p $m"
continue
}
- append methods($o) [.serializeExportedMethod $o $p $m]
+ append methods($o) [:serializeExportedMethod $o $p $m]
}
foreach o [array names methods] {set ($o) 1}
- foreach o [list ${.rootClass} ${.rootMetaClass}] {
+ foreach o [list ${:rootClass} ${:rootMetaClass}] {
if {[info exists ($o)]} {unset ($o)}
}
- foreach o [concat ${.rootClass} ${.rootMetaClass} [array names ""]] {
+ foreach o [concat ${:rootClass} ${:rootMetaClass} [array names ""]] {
if {![info exists methods($o)]} continue
append r \n $methods($o)
}
@@ -554,18 +554,18 @@
# general object serialization
###############################
- .method serialize {objectOrClass s} {
- .[.classify $objectOrClass]-serialize $objectOrClass $s
+ :method serialize {objectOrClass s} {
+ :[:classify $objectOrClass]-serialize $objectOrClass $s
}
- .method matchesIgnorePattern {o} {
- foreach p [array names .ignorePattern] {
+ :method matchesIgnorePattern {o} {
+ foreach p [array names :ignorePattern] {
if {[string match $p $o]} {return 1}
}
return 0
}
- .method collect-var-traces {o s} {
+ :method collect-var-traces {o s} {
foreach v [$o info vars] {
set t [$o __trace__ info variable $v]
if {$t ne ""} {
@@ -585,20 +585,20 @@
# general dependency handling
###############################
- .method needsNothing {x s} {
- return [.[.classify $x]-needsNothing $x $s]
+ :method needsNothing {x s} {
+ return [:[:classify $x]-needsNothing $x $s]
}
- .method Class-needsNothing {x s} {
- if {![.Object-needsNothing $x $s]} {return 0}
+ :method Class-needsNothing {x s} {
+ if {![:Object-needsNothing $x $s]} {return 0}
set scs [$x info superclass]
if {[$s needsOneOf $scs]} {return 0}
if {[$s needsOneOf [::xotcl::relation $x class-mixin]]} {return 0}
foreach sc $scs {if {[$s needsOneOf [$sc info slots]]} {return 0}}
return 1
}
- .method Object-needsNothing {x s} {
+ :method Object-needsNothing {x s} {
set p [$x info parent]
if {$p ne "::" && [$s needsOneOf $p]} {return 0}
if {[$s needsOneOf [$x info class]]} {return 0}
@@ -614,11 +614,11 @@
ObjectSystemSerializer create Serializer2 {
- set .rootClass ::xotcl2::Object
- set .rootMetaClass ::xotcl2::Class
- array set .ignorePattern [list "::xotcl2::*" 1 "::xotcl::*" 1]
+ set :rootClass ::xotcl2::Object
+ set :rootMetaClass ::xotcl2::Class
+ array set :ignorePattern [list "::xotcl2::*" 1 "::xotcl::*" 1]
- .method serialize-all-start {s} {
+ :method serialize-all-start {s} {
if {[info command ::Object] ne "" && [namespace origin ::Object] eq "::xotcl2::Object"} {
set intro "::xotcl::use xotcl2"
} else {
@@ -631,16 +631,16 @@
# XOTcl 2 method serialization
###############################
- .method methodExists {object kind name} {
+ :method methodExists {object kind name} {
expr {[$object info method type $name] != ""}
}
- .method serializeExportedMethod {object kind name} {
+ :method serializeExportedMethod {object kind name} {
# todo: object modifier is missing
- return [.method-serialize $object $name ""]
+ return [:method-serialize $object $name ""]
}
- .method method-serialize {o m modifier} {
+ :method method-serialize {o m modifier} {
if {![::xotcl::is $o class]} {set modifier ""}
return [$o {*}$modifier info method definition $m]
}
@@ -649,46 +649,46 @@
# XOTcl 2 object serialization
###############################
- .method Object-serialize {o s} {
- .collect-var-traces $o $s
+ :method Object-serialize {o s} {
+ :collect-var-traces $o $s
append cmd [list [$o info class] create \
[::xotcl::dispatch $o -objscope ::xotcl::self]]
append cmd " -noinit\n"
foreach i [lsort [::xotcl::cmd::ObjectInfo::methods $o]] {
- append cmd [.method-serialize $o $i "object"] "\n"
+ append cmd [:method-serialize $o $i "object"] "\n"
}
append cmd \
- [list $o eval [join [.collectVars $o] "\n "]]\n \
- [.frameWorkCmd ::xotcl::relation $o object-mixin] \
- [.frameWorkCmd ::xotcl::assertion $o object-invar]
+ [list $o eval [join [:collectVars $o] "\n "]]\n \
+ [:frameWorkCmd ::xotcl::relation $o object-mixin] \
+ [:frameWorkCmd ::xotcl::assertion $o object-invar]
if {[::xotcl::is $o type ::xotcl::Slot]} {
# Slots needs to be initialized to ensure
# __invalidateobjectparameter to be called
append cmd [list $o init] \n
}
- $s addPostCmd [.frameWorkCmd ::xotcl::relation $o object-filter]
+ $s addPostCmd [:frameWorkCmd ::xotcl::relation $o object-filter]
return $cmd
}
###############################
# XOTcl 2 class serialization
###############################
- .method Class-serialize {o s} {
+ :method Class-serialize {o s} {
- set cmd [.Object-serialize $o $s]
+ set cmd [:Object-serialize $o $s]
foreach i [lsort [::xotcl::cmd::ClassInfo::methods $o]] {
- append cmd [.method-serialize $o $i ""] "\n"
+ append cmd [:method-serialize $o $i ""] "\n"
}
append cmd \
- [.frameWorkCmd ::xotcl::relation $o superclass -unless ${.rootClass}] \
- [.frameWorkCmd ::xotcl::relation $o class-mixin] \
- [.frameWorkCmd ::xotcl::assertion $o class-invar]
+ [:frameWorkCmd ::xotcl::relation $o superclass -unless ${:rootClass}] \
+ [:frameWorkCmd ::xotcl::relation $o class-mixin] \
+ [:frameWorkCmd ::xotcl::assertion $o class-invar]
- $s addPostCmd [.frameWorkCmd ::xotcl::relation $o class-filter]
+ $s addPostCmd [:frameWorkCmd ::xotcl::relation $o class-filter]
return $cmd\n
}
@@ -707,19 +707,19 @@
ObjectSystemSerializer create Serializer1 {
- set .rootClass ::xotcl::Object
- set .rootMetaClass ::xotcl::Class
- array set .ignorePattern [list "::xotcl::*" 1]
+ set :rootClass ::xotcl::Object
+ set :rootMetaClass ::xotcl::Class
+ array set :ignorePattern [list "::xotcl::*" 1]
- .method serialize-all-start {s} {
+ :method serialize-all-start {s} {
set intro "package require xotcl1"
if {[info command ::Object] ne "" && [namespace origin ::Object] eq "::xotcl::Object"} {
set intro "::xotcl::use xotcl1"
}
return "$intro\n::xotcl::Object instproc trace args {}\n[next]"
}
- .method serialize-all-end {s} {
+ :method serialize-all-end {s} {
return "[next]\n::xotcl::alias ::xotcl::Object trace -objscope ::trace\n"
}
@@ -728,7 +728,7 @@
# XOTcl 1 method serialization
###############################
- .method methodExists {object kind name} {
+ :method methodExists {object kind name} {
switch $kind {
proc - instproc {
return [expr {[$object info ${kind}s $name] ne ""}]
@@ -739,13 +739,13 @@
}
}
- .method serializeExportedMethod {object kind name} {
+ :method serializeExportedMethod {object kind name} {
set code ""
switch $kind {
proc - instproc {
if {[$object info ${kind}s $name] ne ""} {
set prefix [expr {$kind eq "proc" ? "" : "inst"}]
- set code [.method-serialize $object $name $prefix]\n
+ set code [:method-serialize $object $name $prefix]\n
}
}
forward - instforward {
@@ -757,7 +757,7 @@
return $code
}
- .method method-serialize {o m prefix} {
+ :method method-serialize {o m prefix} {
set arglist [list]
foreach v [$o info ${prefix}args $m] {
if {[$o info ${prefix}default $m $v x]} {
@@ -776,14 +776,14 @@
# XOTcl 1 object serialization
###############################
- .method Object-serialize {o s} {
- .collect-var-traces $o $s
+ :method Object-serialize {o s} {
+ :collect-var-traces $o $s
append cmd [list [$o info class] create [::xotcl::dispatch $o -objscope ::xotcl::self]]
# slots needs to be initialized when optimized, since
# parametercmds are not serialized
append cmd " -noinit\n"
foreach i [::xotcl::cmd::ObjectInfo::methods $o -methodtype scripted] {
- append cmd [.method-serialize $o $i ""] "\n"
+ append cmd [:method-serialize $o $i ""] "\n"
}
foreach i [::xotcl::cmd::ObjectInfo::methods $o -methodtype forward] {
append cmd [concat [list $o] forward $i [$o info forward -definition $i]] "\n"
@@ -792,11 +792,11 @@
append cmd [list $o parametercmd $i] "\n"
}
append cmd \
- [list $o eval [join [.collectVars $o] "\n "]] \n \
- [.frameWorkCmd ::xotcl::relation $o object-mixin] \
- [.frameWorkCmd ::xotcl::assertion $o object-invar]
+ [list $o eval [join [:collectVars $o] "\n "]] \n \
+ [:frameWorkCmd ::xotcl::relation $o object-mixin] \
+ [:frameWorkCmd ::xotcl::assertion $o object-invar]
- $s addPostCmd [.frameWorkCmd ::xotcl::relation $o object-filter]
+ $s addPostCmd [:frameWorkCmd ::xotcl::relation $o object-filter]
return $cmd
}
@@ -805,10 +805,10 @@
# XOTcl 1 class serialization
###############################
- .method Class-serialize {o s} {
- set cmd [.Object-serialize $o $s]
+ :method Class-serialize {o s} {
+ set cmd [:Object-serialize $o $s]
foreach i [$o info instprocs] {
- append cmd [.method-serialize $o $i inst] "\n"
+ append cmd [:method-serialize $o $i inst] "\n"
}
foreach i [$o info instforward] {
append cmd [concat [list $o] instforward $i [$o info instforward -definition $i]] "\n"
@@ -826,11 +826,11 @@
append cmd [list ::xotcl::alias $o $methodName {*}$objscope $cmdName]\n
}
append cmd \
- [.frameWorkCmd ::xotcl::relation $o superclass -unless ${.rootClass}] \
- [.frameWorkCmd ::xotcl::relation $o class-mixin] \
- [.frameWorkCmd ::xotcl::assertion $o class-invar]
+ [:frameWorkCmd ::xotcl::relation $o superclass -unless ${:rootClass}] \
+ [:frameWorkCmd ::xotcl::relation $o class-mixin] \
+ [:frameWorkCmd ::xotcl::assertion $o class-invar]
- $s addPostCmd [.frameWorkCmd ::xotcl::relation $o class-filter]
+ $s addPostCmd [:frameWorkCmd ::xotcl::relation $o class-filter]
return $cmd
}
Index: tests/aliastest.xotcl
===================================================================
diff -u -re5b7b9261b0de87bf7a45ff7416ecd967037fa0b -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/aliastest.xotcl (.../aliastest.xotcl) (revision e5b7b9261b0de87bf7a45ff7416ecd967037fa0b)
+++ tests/aliastest.xotcl (.../aliastest.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -14,7 +14,7 @@
# define an alias and retrieve its definition
Class create Base {
- .method foo {{-x 1}} {return $x}
+ :method foo {{-x 1}} {return $x}
}
Class create Foo
@@ -216,17 +216,17 @@
# dot-resolver/ dot-dispatcher used in aliased proc
Class create V {
- set .z 1
+ set :z 1
}
V create v {
- set .z 2
+ set :z 2
}
V method bar {z} { return $z }
V object method bar {z} { return $z }
-proc foo args { return [.bar ${.z}]-[set .z]-[my bar [set .z]] }
+proc foo args { return [:bar ${:z}]-[set :z]-[my bar [set :z]] }
::xotcl::alias V FOO1 ::foo
::xotcl::alias V -per-object FOO2 ::foo
Index: tests/destroytest.xotcl
===================================================================
diff -u -rf279bf06b31139084edd5136824a1e2622265e00 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/destroytest.xotcl (.../destroytest.xotcl) (revision f279bf06b31139084edd5136824a1e2622265e00)
+++ tests/destroytest.xotcl (.../destroytest.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -6,11 +6,11 @@
::xotcl::alias ::xotcl2::Object set -objscope ::set
Class create O -superclass Object {
- .method init {} {
+ :method init {} {
set ::ObjectDestroy 0
set ::firstDestroy 0
}
- .method destroy {} {
+ :method destroy {} {
incr ::ObjectDestroy
#[my info class] dealloc [self]
next
Index: tests/info-method.xotcl
===================================================================
diff -u -r73eb4eccd33d1a940e2d2ca6dccc2f74216f0576 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/info-method.xotcl (.../info-method.xotcl) (revision 73eb4eccd33d1a940e2d2ca6dccc2f74216f0576)
+++ tests/info-method.xotcl (.../info-method.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -4,23 +4,23 @@
::xotcl::use xotcl2
Object create o {
- .alias set ::set
+ :alias set ::set
}
Class create C {
- .method m {x} {return proc-[self proc]}
- .object method mpo {} {return instproc-[self proc]}
- .method m-with-assertions {} {return proc-[self proc]} -precondition 1 -postcondition 2
+ :method m {x} {return proc-[self proc]}
+ :object method mpo {} {return instproc-[self proc]}
+ :method m-with-assertions {} {return proc-[self proc]} -precondition 1 -postcondition 2
- .forward addOne expr 1 +
- .object forward add1 expr 1 +
- .object forward fpo ::o
+ :forward addOne expr 1 +
+ :object forward add1 expr 1 +
+ :object forward fpo ::o
- .setter s
- .object setter spo
+ :setter s
+ :object setter spo
- .alias a ::set
- .object alias apo ::puts
+ :alias a ::set
+ :object alias apo ::puts
}
C create c1
Index: tests/interceptor-slot.xotcl
===================================================================
diff -u -r73eb4eccd33d1a940e2d2ca6dccc2f74216f0576 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/interceptor-slot.xotcl (.../interceptor-slot.xotcl) (revision 73eb4eccd33d1a940e2d2ca6dccc2f74216f0576)
+++ tests/interceptor-slot.xotcl (.../interceptor-slot.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -3,7 +3,7 @@
::xotcl::use xotcl2
Class create M {
- .method mfoo {} {puts [self proc]}
+ :method mfoo {} {puts [self proc]}
}
Class create M2
Class create C
Index: tests/method-modifiers.xotcl
===================================================================
diff -u -r99b9e9e9c78df12e482d16bca08ffeb5998b3b02 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/method-modifiers.xotcl (.../method-modifiers.xotcl) (revision 99b9e9e9c78df12e482d16bca08ffeb5998b3b02)
+++ tests/method-modifiers.xotcl (.../method-modifiers.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -7,59 +7,59 @@
Class create C {
# methods
- .method plain_method {} {return [self proc]}
- .public method public_method {} {return [self proc]}
- .protected method protected_method {} {return [self proc]}
+ :method plain_method {} {return [self proc]}
+ :public method public_method {} {return [self proc]}
+ :protected method protected_method {} {return [self proc]}
# forwards
- .forward plain_forward %self plain_method
- .public forward public_forward %self public_method
- .protected forward protected_forward %self protected_method
+ :forward plain_forward %self plain_method
+ :public forward public_forward %self public_method
+ :protected forward protected_forward %self protected_method
# setter
- .setter plain_setter
- .public setter public_setter
- .protected setter protected_setter
+ :setter plain_setter
+ :public setter public_setter
+ :protected setter protected_setter
# alias
- .alias plain_alias [C info method name plain_method]
- .public alias public_alias [C info method name public_method]
- .protected alias protected_alias [C info method name protected_method]
+ :alias plain_alias [C info method name plain_method]
+ :public alias public_alias [C info method name public_method]
+ :protected alias protected_alias [C info method name protected_method]
# object
- .object method plain_object_method {} {return [self proc]}
- .public object method public_object_method {} {return [self proc]}
- .protected object method protected_object_method {} {return [self proc]}
- .object forward plain_object_forward %self plain_object_method
- .public object forward public_object_forward %self public_object_method
- .protected object forward protected_object_forward %self protected_object_method
- .object setter plain_object_setter
- .public object setter public_object_setter
- .protected object setter protected_object_setter
- .object alias plain_object_alias [.object info method name plain_object_method]
- .public object alias public_object_alias [.object info method name public_object_method]
- .protected object alias protected_object_alias [.object info method name protected_object_method]
+ :object method plain_object_method {} {return [self proc]}
+ :public object method public_object_method {} {return [self proc]}
+ :protected object method protected_object_method {} {return [self proc]}
+ :object forward plain_object_forward %self plain_object_method
+ :public object forward public_object_forward %self public_object_method
+ :protected object forward protected_object_forward %self protected_object_method
+ :object setter plain_object_setter
+ :public object setter public_object_setter
+ :protected object setter protected_object_setter
+ :object alias plain_object_alias [:object info method name plain_object_method]
+ :public object alias public_object_alias [:object info method name public_object_method]
+ :protected object alias protected_object_alias [:object info method name protected_object_method]
}
C create c1 {
# methods
- .method plain_object_method {} {return [self proc]}
- .public method public_object_method {} {return [self proc]}
- .protected method protected_object_method {} {return [self proc]}
+ :method plain_object_method {} {return [self proc]}
+ :public method public_object_method {} {return [self proc]}
+ :protected method protected_object_method {} {return [self proc]}
# forwards
- .forward plain_object_forward %self plain_object_method
- .public forward public_object_forward %self public_object_method
- .protected forward protected_object_forward %self protected_object_method
+ :forward plain_object_forward %self plain_object_method
+ :public forward public_object_forward %self public_object_method
+ :protected forward protected_object_forward %self protected_object_method
# setter
- .setter plain_object_setter
- .public setter public_object_setter
- .protected setter protected_object_setter
+ :setter plain_object_setter
+ :public setter public_object_setter
+ :protected setter protected_object_setter
# alias
- .alias plain_object_alias [.info method name plain_object_method]
- .public alias public_object_alias [.info method name public_object_method]
- .protected alias protected_object_alias [.info method name protected_object_method]
+ :alias plain_object_alias [:info method name plain_object_method]
+ :public alias public_object_alias [:info method name public_object_method]
+ :protected alias protected_object_alias [:info method name protected_object_method]
}
C public setter s0
C protected setter s1
@@ -191,8 +191,8 @@
# add an object and class mixin via object-parameter and via slots
Class create M1; Class create M2; Class create M3; Class create M4
Class create C -mixin M1 -object-mixin M2 {
- .mixin add M3
- .object mixin add M4
+ :mixin add M3
+ :object mixin add M4
}
? {lsort [C object info mixin]} "::M2 ::M4"
@@ -204,13 +204,13 @@
Test case next-from-nonpos-args
Object create o {
- .method bar {-y:required -x:required} {
+ :method bar {-y:required -x:required} {
#puts stderr "+++ o x=$x, y=$y [self args] ... next [self next]"
return [list x $x y $y [self args]]
}
}
Class create M {
- .method bar {-x:required -y:required} {
+ :method bar {-x:required -y:required} {
#puts stderr "+++ M x=$x, y=$y [self args] ... next [self next]"
return [list x $x y $y [self args] -- {*}[next]]
}
Index: tests/protected.xotcl
===================================================================
diff -u -r73eb4eccd33d1a940e2d2ca6dccc2f74216f0576 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/protected.xotcl (.../protected.xotcl) (revision 73eb4eccd33d1a940e2d2ca6dccc2f74216f0576)
+++ tests/protected.xotcl (.../protected.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -5,13 +5,13 @@
Test parameter count 1
Class create C {
- .alias SET ::set
- .method foo {} {return [self proc]}
- .method bar {} {return [self proc]}
- .method bar-foo {} {
+ :alias SET ::set
+ :method foo {} {return [self proc]}
+ :method bar {} {return [self proc]}
+ :method bar-foo {} {
c1 foo
}
- .method bar-SET {} {
+ :method bar-SET {} {
c1 SET x 1
}
}
Index: tests/speedtest.xotcl
===================================================================
diff -u -r73eb4eccd33d1a940e2d2ca6dccc2f74216f0576 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/speedtest.xotcl (.../speedtest.xotcl) (revision 73eb4eccd33d1a940e2d2ca6dccc2f74216f0576)
+++ tests/speedtest.xotcl (.../speedtest.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -61,10 +61,10 @@
my exists v
}
C instproc existsViaDotExistsMethod {} {
- .exists v
+ :exists v
}
C instproc existsViaResolver {} {
- info exists .v
+ info exists :v
}
C instproc notExistsViaInstvar {} {
my instvar xxx
Index: tests/varresolutiontest.xotcl
===================================================================
diff -u -rf6775105babd749f662856c7eff1a903636e80e0 -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de
--- tests/varresolutiontest.xotcl (.../varresolutiontest.xotcl) (revision f6775105babd749f662856c7eff1a903636e80e0)
+++ tests/varresolutiontest.xotcl (.../varresolutiontest.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de)
@@ -46,7 +46,7 @@
#global z
#::xotcl::importvar [self] y
set x 1
- set .y 2
+ set :y 2
set ::z 3
set [self]::X 4
}
@@ -164,8 +164,8 @@
###############################################
Object create o
-o method foo {x} {set .y 2; return ${.x},${.y}}
-o method bar {} {return ${.x},${.y}}
+o method foo {x} {set :y 2; return ${:x},${:y}}
+o method bar {} {return ${:x},${:y}}
o set x 1
? {o foo 1} "1,2" "create var y and fetch var x"
? {o bar} "1,2" "fetch two instance variables"
@@ -174,7 +174,7 @@
# we have to recreate bar, so no problem
Object create o
o set x 1
-o method bar {} {return ${.x},${.y}}
+o method bar {} {return ${:x},${:y}}
? {catch {o bar}} "1" "compiled var y should not exist"
o destroy
@@ -184,8 +184,8 @@
Class create C -parameter {{x 1}}
C create c1
-C method foo {x} {set .y 2; return ${.x},${.y}}
-C method bar {} {return ${.x},${.y}}
+C method foo {x} {set :y 2; return ${:x},${:y}}
+C method bar {} {return ${:x},${:y}}
? {c1 info vars} "x"
? {c1 foo 1} "1,2" "create var y and fetch var x"
? {c1 bar} "1,2" "fetch two instance variables"
@@ -208,9 +208,9 @@
Class create C -parameter {{x 1}}
C create c1
C method foo {x} {
- set .y 2;
- eval "set .z 3"
- return ${.x},${.y},${.z}
+ set :y 2;
+ eval "set :z 3"
+ return ${:x},${:y},${:z}
}
? {c1 info vars} "x"
? {c1 foo 1} "1,2,3"
@@ -219,13 +219,13 @@
? {c1 info vars} "x"
C method foo {x} {
set cmd set
- lappend cmd .y
+ lappend cmd :y
lappend cmd 100
eval $cmd
- return $x,${.y}
+ return $x,${:y}
}
-C method bar {} {puts ${.x};return [info exists .x],[info exists .y]}
-C method bar2 {} {if {[info exists .x]} {set .x 1000}; return [info exists .x],[info exists .y]}
+C method bar {} {puts ${:x};return [info exists :x],[info exists :y]}
+C method bar2 {} {if {[info exists :x]} {set :x 1000}; return [info exists :x],[info exists :y]}
? {c1 foo 1} "1,100"
? {c1 bar} "1,1"
? {c1 bar2} "1,1"
@@ -241,8 +241,8 @@
Class create C
C create c1
C method foo {} {
- array set .a {a 1 b 2 c 3}
- set .z 100
+ array set :a {a 1 b 2 c 3}
+ set :z 100
}
? {c1 info vars} ""
c1 foo
@@ -253,12 +253,12 @@
# tests for the var resolver
###############################################
Class create C
-C method bar0 {} {return ${.x}}
-C method bar1 {} {set a ${.x}; return [info exists .x],[info exists .y]}
-C method bar2 {} {return [info exists .x],[info exists .y]}
+C method bar0 {} {return ${:x}}
+C method bar1 {} {set a ${:x}; return [info exists :x],[info exists :y]}
+C method bar2 {} {return [info exists :x],[info exists :y]}
C method foo {} {
- array set .a {a 1 b 2 c 3}
- set .z 100
+ array set :a {a 1 b 2 c 3}
+ set :z 100
}
C create c1
c1 set x 100
@@ -282,13 +282,13 @@
C forward test %self bar
C method foo {} {
# this works
- lappend .r [.bar x 1]
- lappend .r [.test a b c]
+ lappend :r [:bar x 1]
+ lappend :r [:test a b c]
# these kind of works, but vars are nowhere....
- .set x 1
- .incr x 1
- .incr x 1
- return [lappend .r ${.x}]
+ :set x 1
+ :incr x 1
+ :incr x 1
+ return [lappend :r ${:x}]
}
C create c3
? {c3 foo} "{x 1} {a b c} 3"
@@ -339,31 +339,31 @@
Object create o {
set xxx 1
- set .x 1
+ set :x 1
}
? {o exists x} 1
? {o exists xxx} 0
# eval does an objcope, all vars are instance variables
o eval {
set aaa 1
- set .a 1
+ set :a 1
}
? {o exists a} 1
? {o exists aaa} 1
# softeval should behave like the creation initcmd (just set dot vars)
o softeval {
set bbb 1
- set .b 1
+ set :b 1
}
? {o exists b} 1
? {o exists bbb} 0
# softeval2 never sets variables
o softeval2 {
set zzz 1
- set .z 1
+ set :z 1
}
? {o exists z} 0
? {o exists zzz} 0
@@ -378,23 +378,23 @@
# eval does an objcope, all vars are instance variables
o eval {
set ccc 1
- set .c 1
+ set :c 1
}
? {o exists c} 1
? {o exists ccc} 1
# softeval2 should behave like the creation initcmd (just set dot vars)
o softeval {
set ddd 1
- set .d 1
+ set :d 1
}
? {o exists d} 1
? {o exists ddd} 1 ;# TODO: should be 0
# softeval2 never sets variables
o softeval2 {
set zzz 1
- set .z 1
+ set :z 1
}
? {o exists z} 0
? {o exists zzz} 0
@@ -406,35 +406,35 @@
# The global vars should not influence the behavior.
##################################################
Test case with-global-vars
-foreach var {.x x xxx .a a aaa .b b bbb .c c ccc .d d ddd .z z zzz} {set $var 1}
+foreach var {.x x xxx :a a aaa :b b bbb :c c ccc :d d ddd :z z zzz} {set $var 1}
Object create o {
set xxx 1
- set .x 1
+ set :x 1
}
? {o exists x} 1
? {o exists xxx} 0
# eval does an objcope, all vars are instance variables
o eval {
set aaa 1
- set .a 1
+ set :a 1
}
? {o exists a} 1
? {o exists aaa} 1
# softeval should behave like the creation initcmd (just set dot vars)
o softeval {
set bbb 1
- set .b 1
+ set :b 1
}
? {o exists b} 1
? {o exists bbb} 0
# softeval2 never sets variables
o softeval2 {
set zzz 1
- set .z 1
+ set :z 1
}
? {o exists z} 0
? {o exists zzz} 0
@@ -449,23 +449,23 @@
# eval does an objcope, all vars are instance variables
o eval {
set ccc 1
- set .c 1
+ set :c 1
}
? {o exists c} 1
? {o exists ccc} 1
# softeval2 should behave like the creation initcmd (just set dot vars)
o softeval {
set ddd 1
- set .d 1
+ set :d 1
}
? {o exists d} 1
? {o exists ddd} 0
# softeval2 never sets variables
o softeval2 {
set zzz 1
- set .z 1
+ set :z 1
}
? {o exists z} 0
? {o exists zzz} 0
@@ -478,35 +478,35 @@
##################################################
Test case dotcmd
set C 0
-proc .bar {} {incr ::C}
+proc bar {} {incr ::C}
Class create Foo {
- .method init {} {set .c 0}
- .method callDot1 {} {.bar}
- .method callDot2 {} {.bar}
- .method callDot3 {} {.bar; ..bar; .bar}
- .method bar {} {incr .c}
+ :method init {} {set :c 0}
+ :method callDot1 {} {:bar}
+ :method callDot2 {} {:bar}
+ :method callDot3 {} {:bar; ::bar; :bar}
+ :method bar {} {incr :c}
}
Foo create f1
f1 callDot1
? {set ::C} 0
-? {f1 eval {set .c}} 1
+? {f1 eval {set :c}} 1
# call via callback
after 1 {f1 callDot2}
after 10 {set ::X 1}
vwait X
? {set ::C} 0
-? {f1 eval {set .c}} 2
+? {f1 eval {set :c}} 2
-# call via callback, call .bar via .. from method
+# call via callback, call :bar via .. from method
after 1 {f1 callDot3}
after 10 {set ::X 2}
vwait X
? {set ::C} 1
-? {f1 eval {set .c}} 4
+? {f1 eval {set :c}} 4
##################################################