Version 16 of extending puts

Updated 2013-01-18 21:22:27 by pooryorick
# extended_puts.tcl v1.0
# M.Hoffmann, 20.10.2005
# based on http://wiki.tcl.tk/8502

package provide extend_puts 1.0

proc extend_puts {{stdoutadd {}} {stderradd {}}} {
    if {![llength [info command ::tcl::puts]]} {
        rename puts ::tcl::puts
    }
    proc puts args [format {
        set explicit_stdout 1
        set la [llength $args]
        if {$la<1 || $la>3} {
            catch {::tcl::puts} rc; # read original helptxt
            error [string map {::tcl:: ""} $rc]; # trigger error/SyntaxHelp
        }
        set nl \n
        if {[lindex $args 0]=="-nonewline"} {
            set nl ""
            set args [lrange $args 1 end]
        }
        if {[llength $args]==1} {
            set args [list stdout [join $args]]
            set explicit_stdout 0
        }
        foreach {channel s} $args break
        set stdoutadd "%s"
        set stderradd "%s"
        if {$explicit_stdout == 1 && [llength $stdoutadd] && $channel=="stdout"} {
            catch {uplevel [list $stdoutadd $s]}
        } elseif {[llength $stderradd] && $channel=="stderr"} {
            catch {uplevel [list $stderradd $s]}
        }
        set cmd ::tcl::puts
        if {$nl==""} {lappend cmd -nonewline}
        lappend cmd $channel $s
        uplevel $cmd
    } $stdoutadd $stderradd]
}

One intended use of this is to automatically write stderr-output to the windows-eventlogs.


See also puts - puts workaround