|
||||||
| SUMMARY: CHILDREN | PARAMETER | INSTPROC | INSTFILTER | INSTFORWARD | DETAIL: | INSTPROC | |||||
Object is the base class for all classes in XOTcl. Object can be used to make new objects. set instance [ Object new ] Object can be used as the ultimate superclass: Class SomeClass -superclass Object Note this is the same as: Class SomeClass This class holds the pre-defined methods available for all XOTcl objects. All these methods are also available on classes.
| Variables | |||
| Name | Default Value | Class | Comment |
| Methods | |
| Name | Comment |
# {args}
| Comment method |
. {paramName args}
| Dereference method |
? {{command ?}}
| Help method |
?code {command}
| Print the code for a method |
?methods {{prefix ""}}
| Help on all available methods |
?object {object}
| |
abstract {methtype methname arglist}
| Specify an abstract method for class/object with arguments |
copy {newName}
| Perform a deep copy of the object/class (with all information, like class, parameter, filter, etc) to "newName" |
coverageFilter {args}
| |
defaultmethod {}
| |
extractConfigureArg {al name {cutTheArg 0}}
| Check an argument list separated with '-' args, as for instance configure arguments, and extract the argument's values |
filterappend {f}
| |
get# {args}
| |
getClean# {args}
| |
hasclass {cl}
| Test whether the argument is either a mixin or instmixin of the object or if it is on the class hierarchy of the object |
init {args}
| |
methodTag {}
| |
mixinappend {m}
| |
move {newName}
| Perform a deep move of the object/class (with all information, like class, parameter, filter, etc) to "newName" |
profileFilter {args}
| |
self {}
| |
setParameterDefaults {}
| |
shell {}
| |
tclcmd {t}
| |
traceFilter {args}
| |
| Instproc Detail |
Comment method.
This method allows the association and retrieval of comments with
anything method or just the object itself. These
comments will be carried inside the object in memory.
This method is most useful in Class objects for
commenting instprocs, instfilters, instforward, etc.
It also allows for documentation programs to use
introspection to grab the comments associated with a
certain method. This frees the documentation programs
from having to reparse the code when XOTcl already
does a perfectly good job of that.
Example:
Class Car
Car # drive {Car will return "vroooom"}
Car instproc drive { } {
return "vroooom"
}
This comment can be accessed by issuing:
Car get# drive
This will return the full comment:
instproc drive Car will return "vroooom"
Interesting note: Since the comment is carried
along with the object in memory the comments can
be accessed at anytime using introspection. Possible
uses for these are very detailed debugging messages,
or online help when using xotclsh. It also
allows for comments to be sent "over the wire" if
combined with serialization.args ::xotcl::Object instproc # {args} {
set key [ lindex $args 0 ]
set comment [ lindex $args end ]
if { ! [ my exists "#($key)" ] } {
return [ my set "#($key)" $comment ]
}
return [ my append "#($key)" "\n$comment" ]
}
Dereference method.
Allows this notation to be used:
$object . variableName . subvariableName . subsub
This would get the value of subsub in the object subvariableName
in variableName in object. The above is equivalent to
[ [ [ $object variableName ] subvariableName ] subsub ]
This only works for variables that have parameter methods
accessing them. Otherwise this method will error.paramName args ::xotcl::Object instproc . {paramName args} {
if { [ llength $args ] == 0 } {
return [ my $paramName ]
}
if { "." == "[ lindex $args 0 ]" } {
return [ eval {[ my $paramName ]} $args ]
}
return [ eval my {$paramName} $args ]
}
Help method.
The help method, ?, allows the developer to access
the class documentation while writing the code. This
is useful if experimenting with code in a debugger
or tcl shell.
Usage:
$o ?
This will return this message.
$o ? set
This will return the help message for the "set" method.
Also see:
?methods
?code
?objectcommand - optional, default value: ? ::xotcl::Object instproc ? {{command ?}} {
if [ uplevel #0 ::xotcl::Object isclass $command ] {
return [ $command getClean# [ namespace tail $command ] ]
}
if [ uplevel #0 ::xotcl::Object isobject $command ] {
return [ my ?object $command ]
}
set class [ ::xox::ObjectGraph findFirstImplementationClass [ self ] $command ]
if { "" == "$class" } {
my debug "No method found named $command."
return
}
set help "
$class $command
[ ::xox::ObjectGraph findFirstComment [ self ] $command ]"
catch {
set args [ $class info instargs $command ]
append help "
Example:
"
append help "\$o $command"
foreach arg $args {
if { "$arg" == "args" } {
append help " ..."
continue
}
append help " \$$arg"
}
append help "\n"
}
my debug $help
}
Print the code for a method.
This command will find and print the code associated with a method on this
object.command ::xotcl::Object instproc ?code {command} {
set class [ ::xox::ObjectGraph findFirstImplementationClass [ self ] $command ]
if { "$class" == "" } {
my debug "No command $command found in [ self ] [ self info class ]"
return
}
my debug "$class instproc $command { [ $class info instargs $command ] } { [ $class info instbody $command ] }"
}
Help on all available methods.
This command will print a list of methods available on this
object. It will also print the first sentence of the documentation
associated with that method.prefix - optional, default value: "" ::xotcl::Object instproc ?methods {{prefix ""}} {
if { "" != "$prefix" } {
if [ uplevel #0 ::xotcl::Object isclass $prefix ] {
set class $prefix
set buffer "Methods available on $class\n\n"
foreach method [ lsort -dictionary [ $class info instprocs ] ] {
set comment [ $class getClean# $method ]
set shortComment [ string trim [ lindex [ split $comment "." ] 0 ] ]
append buffer "$method - $shortComment\n"
}
my debug $buffer
return
}
}
set buffer "Methods available on [ self ], a [ my info class ]\n\n"
foreach method [ lsort -dictionary [ my info methods ] ] {
if { "$prefix" != "" } {
if { [ string first $prefix $method ] != 0 } { continue }
}
set comment [ ::xox::ObjectGraph findFirstComment [ self ] $method ]
set shortComment [ string trim [ lindex [ split $comment "." ] 0 ] ]
append buffer "$method - $shortComment\n"
}
my debug $buffer
}
object ::xotcl::Object instproc ?object {object} {
if { ! [ Object isobject $object ] } {
my debug "$object is not an object"
return
}
set buffer "==============================================\n"
append buffer "$object is a [ $object info class ]\n"
foreach var [ lsort -dictionary [ my info vars ] ] {
if [ my array exists $var ] {
append buffer "$var: [ my array get $var ]\n"
} else {
append buffer "$var: [ my set $var ]\n"
}
}
append buffer "==============================================\n"
my debug $buffer
}
Specify an abstract method for class/object with arguments. An abstract method specifies an interface and returns an error, if it is invoked directly. Sub-classes or mixins have to override it.
methtype methname arglist ::xotcl::Object instproc abstract {methtype methname arglist} {
if {$methtype != "proc" && $methtype != "instproc"} {
error "invalid method type '$methtype', must be either 'proc' or 'instproc'."}
::xotcl::my $methtype $methname $arglist "
if {\[::xotcl::self callingproc\] != \[::xotcl::self proc\] &&
\[::xotcl::self callingobject\] != \[::xotcl::self\]} {
error \"Abstract method $methname $arglist called\"} else {::xotcl::next}
"
}
Perform a deep copy of the object/class (with all information, like class, parameter, filter, etc) to "newName".
newName ::xotcl::Object instproc copy {newName} {
if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::self] :]]} {
[[::xotcl::self class]::CopyHandler new -volatile] copy [::xotcl::self] $newName}
}
args ::xotcl::Object instproc coverageFilter {args} {
# don't trace the Coverage object
if { [ string equal [self] ::xounit::Coverage ] } {
return [ next ]
}
set class [ self calledclass ]
set method [ self calledproc ]
::xounit::Coverage recordCoverage $class $method
return [ next ]
}
::xotcl::Object instproc defaultmethod {} {
return [::xotcl::self]
}
Check an argument list separated with '-' args, as for instance configure arguments, and extract the argument's values. Optionally, cut the whole argument.
al name cutTheArg - optional, default value: 0 ::xotcl::Object instproc extractConfigureArg {al name {cutTheArg 0}} {
set value ""
upvar $al argList
set largs [llength $argList]
for {set i 0} {$i < $largs} {incr i} {
if {[lindex $argList $i] == $name && $i + 1 < $largs} {
set startIndex $i
set endIndex [expr {$i + 1}]
while {$endIndex < $largs &&
[string first - [lindex $argList $endIndex]] != 0} {
lappend value [lindex $argList $endIndex]
incr endIndex}}}
if {[info exists startIndex] && $cutTheArg != 0} {
set argList [lreplace $argList $startIndex [expr {$endIndex - 1}]]}
return $value
}
f ::xotcl::Object instproc filterappend {f} {
set cmd [list [::xotcl::self] filter add $f end]
puts stderr "the method [::xotcl::self proc] is deprecated; use instead '$cmd'"
eval $cmd
}
args ::xotcl::Object instproc get# {args} {
if { ! [ my exists "#($args)" ] } { return }
return [ my set "#($args)" ]
}
args ::xotcl::Object instproc getClean# {args} {
if { ! [ my exists "#($args)" ] } { return }
set doc [ my set "#($args)" ]
foreach line [ split $doc "\n" ] {
set checkLine [ string trim $line ]
if { [ string first "#" $checkLine ] == 0 } {
set line [ string range $checkLine 1 end ]
}
append newDoc $line
append newDoc "\n"
}
return $newDoc
}
Test whether the argument is either a mixin or instmixin of the object or if it is on the class hierarchy of the object. This method combines the functionalities of istype and ismixin.
cl ::xotcl::Object instproc hasclass {cl} {
if {[::xotcl::my ismixin $cl]} {return 1}
::xotcl::my istype $cl
}
args ::xotcl::Object instproc init {args} {
}
::xotcl::Object instproc methodTag {} {
return "[ self callingclass ] [ self callingproc ]"
}
m ::xotcl::Object instproc mixinappend {m} {
set cmd [list [::xotcl::self] mixin add $m end]
puts stderr "the method [::xotcl::self proc] is deprecated; use instead '$cmd'"
eval $cmd
}
Perform a deep move of the object/class (with all information, like class, parameter, filter, etc) to "newName".
newName ::xotcl::Object instproc move {newName} {
if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::self] :]]} {
if {$newName != ""} {
::xotcl::my copy $newName}
if {[::xotcl::my isclass [::xotcl::self]] && $newName != ""} {
foreach subclass [::xotcl::my 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}} }
::xotcl::my destroy}
}
args ::xotcl::Object instproc profileFilter {args} {
# don't profile the Profiler object
if { [ string equal [self] ::xox::Profiler ] } { return [ next ] }
set class [ self calledclass ]
if { [ string equal $class ::xotcl::Object ] } { return [ next ] }
set method [ self calledproc ]
::xox::Profiler recordProfile $class $method
set start [ clock clicks -milliseconds ]
set return [ next ]
set end [ clock clicks -milliseconds ]
set time [ expr { $end - $start } ]
::xox::Profiler recordProfileTime $class $method $time
return $return
}
::xotcl::Object instproc self {} {
return [::xotcl::self]
}
::xotcl::Object instproc setParameterDefaults {} {
set classes [ my info precedence ]
for { set loop [ llength $classes ] } { $loop >=0 } { incr loop -1 } {
set class [ lindex $classes $loop ]
if { "" == "$class" } { continue }
if { ! [ $class array exists __defaults ] } { continue }
foreach parameter [ $class array names __defaults ] {
my set $parameter [ $class set __defaults($parameter) ]
}
}
}
::xotcl::Object instproc shell {} {
set commands ""
catch { unset continuedCommand }
set index 0
while { 1 } {
if [ info exists continuedCommand ] {
puts -nonewline "[ self ] $index + "
flush stdout
set command [ gets stdin ]
append continuedCommand "\n"
append continuedCommand $command
if { ! [ info complete $continuedCommand ] } {
continue
}
set command $continuedCommand
unset continuedCommand
} else {
puts -nonewline "[ self ] $index % "
flush stdout
set command [ gets stdin ]
set continuedCommand $command
if { ! [ info complete $continuedCommand ] } {
continue
}
set command $continuedCommand
unset continuedCommand
}
incr index
if { "$command" == "exit" } {
puts "[ self ] eval \{"
puts [ join $commands "\n" ]
puts "\}"
break
}
lappend commands $command
if [ catch {
puts [ my eval $command ]
} result ] {
puts $result
}
}
}
t ::xotcl::Object instproc tclcmd {t} {
set cmd [list [::xotcl::self] forward $t -objscope]
puts stderr "the method [::xotcl::self proc] is deprecated; use instead '$cmd'"
eval $cmd
}
args ::xotcl::Object instproc traceFilter {args} {
# don't trace the Trace object
if {[string equal [self] ::xox::Trace ]} {return [next]}
if {[string equal [self] ::xox::Logger ]} {return [next]}
if {[string equal [self calledproc ] log ]} {return [next]}
set context "[ self callingclass ]->[ self callingproc ]"
set method [ self calledproc ]
switch -- $method {
proc -
instproc {::set dargs [list [lindex $args 0] [lindex $args 1] ...] }
default {::set dargs $args }
}
::xox::Trace::puts "CALL $context> [self]\([ self calledclass ]\)->$method $dargs"
set result [next]
::xox::Trace::puts "EXIT $context> [self]\([ self calledclass ]\)->$method ($result)"
return $result
}