Is it possible to override behavior of standard command when it accepts TclOO objects as an argument?
The idea is that: I create instance of particular class, and when I do puts $thisObject
it does not return the object reference but the special form as combination of internal data members (state) of this objects. So I don't need a special method to print this state string, this way it works with built-in structures like dict as I understand.
Is it possible? Thank you in advance!
The standard puts
itself can't be extended this way; it prints strings to channels, and that is all it does.
You can make your own command that does something special, and you can put it in place of the standard command.
You need to be careful. The standard command has a slightly tricky full argument pattern that isn't especially easy to replicate with a procedure, and you need to keep the ability to write strings out so that your replacement can use it.
rename puts "__ original __ puts __"; # Spaces in command names are legal
proc puts args {
set obj [lindex $args end]; # The string is always last
if {[info object isa object $obj]} {
try {
# Delegating rendering to the object makes sense to me
# You also might want to check if it is an instance of some suitable class
$obj renderToString $obj
} on ok str {
lset args end $str; # Do the replacement in the arg list
} on error msg {
# just for debugging your rendering method
set args [list stderr $msg]
}
}
# Transformation done; delegate to original puts implementation
tailcall "__ original __ puts __" {*}$args
}
You can get more elaborate than that. And you'll need to define the actual rendering method; here's a dumb version for a base class and a somewhat more interesting onr:
oo::define oo::object {
method renderToString {originalName} {
# It's a no-op transform!
return $originalName
}
}
oo::class create Named {
variable N
constructor name {
set N $name
}
method renderToString {originalName} {
return "Hi, this is $N!"
}
}
[EDIT]: I've just tested, and this works great with hidden commands, making this now my preferred method:
proc transform value {
string cat "<<" $value ">>"
}
interp hide {} puts
proc puts args {
if {[llength $args]} { # Only apply the transform if there is any argument at all
lset args end [transform [lindex $args end]]
}
try {
interp invokehidden {} puts {*}$args
} on error {msg opt} {
dict unset opt -errorinfo
dict incr opt -level
return -options $opt $msg
}
}
puts hi
puts -nonewline foo
puts stdout bar
The extra bits with the try
/on error
means that the error stack trace will be "correct" if the puts
fails.