Version 1 of getputs

Updated 2007-02-15 11:41:28 by suchenwi

Richard Suchenwirth 2007-02-15 - A colleague wanted a way to capture stdout of a Tcl process temporarily redirected into a variable. Here's my solution, another puts workaround done by overloading puts:

 proc getputs body {
     variable putsbuffer ""
     if {[info commands puts_] eq ""} {
         rename puts puts_
     }
     proc puts args {
         set str   [lindex $args end]
         set arg1  [lindex $args 0]
         set nonew [string equal $arg1 -nonewline]
         switch -glob [llength $args],$nonew  {
             1,* {set chan stdout; append str \n}
             2,0 {set chan $arg1;  append str \n}
             2,1 {set chan stdout}
             3,1 {set chan [lindex $args 1]}
             default {
                 error {wrong \# args: should be "puts ?-nonewline? ?channelId? string"}
             }
         }
         if {$chan ne "stdout"} {
             puts_ -nonewline $chan $str
         } else {append ::putsbuffer $str}
         return
     }
     set code [catch {uplevel 1 $body} res]
     if {$code} {append putsbuffer $code:$res}
     rename puts  {}
     rename puts_ puts
     return -code $code $putsbuffer
 }

#--- Testing:

 puts before
 set var [getputs {
    puts -nonewline hello,
    puts world
    puts stdout inside!
    puts stderr stderr...
    #expr 1/0
 }]
 puts after:[string toupper $var]

which shows on stdout:

 before
 stderr...
 after:HELLO,WORLD
 INSIDE!

Category Example | Arts and crafts of Tcl-Tk programming