tcl

Extend standard puts command for special objects as an argument in Tcl


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!


Solution

  • The standard puts itself can't be extended this way; it prints strings to channels, and that is all it does.

    But...

    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.