Version 11 of extending puts

Updated 2007-07-04 09:19:35 by hoffi

(Interesting effect - the wiki does something wrong with the first line of the following source code..)

 # 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


Category Package