"parentObject . referredObject . anotherReferredObject . method arg1 args"syntax may make some TCLers skin crawl, and at first I was keen to keep it simpler as demonstrated by SLB on The ghosts of VB haunt this TCLer i.e
"Traverse parentObject referredObject anotherReferredObject {method arg1 args}"However when playing around on the commandline I found that a separator to delimit object references and methods was more pleasing to me and a little less prone to silly mistakes. If someone prefers the plain traversal syntax, perhaps the ow::install method could be hacked with an option to allow this.Usage Example:
%package require XOTcl
%namespace import XOTcl::*
%package require objectwalker
1.0
%ow::install
%Class thing
::thing
%thing instproc next args {
% if {[string length $args]} {
% eval "[self] set next $args"
% } else {
% [self] set next
% }
%}
%thing a
%thing b
%a set next b
%b set next a
#now we can follow our object references in a manner that may almost be pleasing to us VB-weaned wimps ;)
%a . next . next . next
b
%a . set test blah ;# The separator is of course unnecessary here
blah
%a . next . next . next . next . info vars
test nextI'm not sure if the use of the . operator will cause problems in some contexts, but if so, you can always do something like this:%ow::install -separator -> %a -> next -> next a
#JMN 2003-08-03
# with thanks to the contributors at http://wiki.tcl.tk/9507
# This code is hereby placed in the public domain.
#
package provide objectwalker 1.0
package require cmdline
namespace eval ow {
variable version 1.0
variable OOPackages [list XOTcl]
variable sep .
}
proc ow::=> {object args} {
foreach arg $args {
set object [eval {$object} $arg]
}
return $object
}
proc ow::traverse {object args} {
set items [list]
set argl [list]
foreach arg $args {
if {$::ow::sep eq $arg} {
lappend items $argl
set argl [list]
} else {
lappend argl $arg
}
}
lappend items $argl
#puts "items-> $items"
foreach itm $items {
set object [eval {$object} $itm]
}
return $object
}
proc ow::install args {
set options {
{separator.arg . "Object method separator string"}
{suppress.arg {} "List of OO packages with which we do NOT want to use objectwalker"}
{only.arg {} "Only install objectwalker for these OO packages"}
}
array set params [::cmdline::getoptions args $options]
if {[llength $params(only)]} {
set packageList $params(only)
} else {
set packageList [list]
foreach known $::ow::OOPackages {
if {[lsearch $params(suppress) $known] == -1} {
lappend packageList $known
}
}
}
set ::ow::sep $params(separator)
foreach pkg $packageList {
eval "::ow::install_$pkg"
}
}
proc ow::install_XOTcl args {
if {![catch {package require XOTcl} msg]} {
uplevel #0 [string map "@sep@ $::ow::sep" {
xotcl::Class objectwalker
objectwalker instproc @sep@ args {
eval "::ow::traverse [self] @sep@ $args"
}
xotcl::Object instmixin objectwalker
}]
}
}
proc ow::install_snit args {
#???
}Artur Trzewik Some comments to example above. next have special meaning in XOTcl for calling base (overwritten) method. I suggest to change the name of this variable. I suppose the thing class is something like chaining list with pointer to next object. Without using objectwalker the syntax of this call will be
[[[[a next] next] next] next] info varsFor better understand next is in this case getter and setter method in one depending of arguments count. It can be also defined as XOTcl parameter
Class thing -parameter nextI think it is quite interesting idea to have syntax more like another OO-Languages. It would also work for more parameters (If I understand it good)
a.getSomeInstance(2,3).childAt(3).doIt(); # C++
a . getSomeInstance 2 3 . childAt 3 . doIt # objectwalker
[[a getSomeInstance 2 3] childAt 3] doIt # Tcl without objectwalkterBy the way ow::traverse procedure can be also programmed with recursion in it (parse only till separator) The shortest XOTcl implementation of it (do not delegate to objectwalker package). You also can define -> directly as proc method in Object. Class Traversal
Traversal instproc -> args {
set index [lsearch $args ->]
if {$index==-1} {
eval [self] $args
} else {
set obj [eval [self] [lrange $args 0 [expr {$index-1}]]]
eval $obj [lrange $args $index end]
}
}
Object instmixin Traversalor in primary implementation proc ow::traverse {object args} {
set index [lsearch $args $::ow::sep]
if {$index==-1} {
eval $object $args
} else {
set obj [eval $object [lrange $args 0 [expr {$index-1}]]]
eval $obj [lrange $args $index end]
}
}
