puts workaround

Richard Suchenwirth 2003-02-28 - In a wish on the iPAQ, a plain puts raises the error

 cannot find channel named "stdout"

But as puts is a frequent and useful command, we want to have it working. So here's a substitute that redirects the output to a specified text widget, if the (implicit or explicit) channel name is stdout or stderr, but else calls the original puts, which was renamed into the ::tcl namespace:

 proc redef_puts w {
    set ::putsw $w
    if ![llength [info command ::tcl::puts]] {
       rename puts ::tcl::puts
       proc puts args {
          set la [llength $args]
          if {$la<1 || $la>3} {
             error "usage: puts ?-nonewline? ?channel? string"
          }
          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]] ;# (2)
          }
          foreach {channel s} $args break
          #set s [join $s] ;# (1) prevent braces at leading/tailing spaces
          if {$channel=="stdout" || $channel=="stderr"} {
             $::putsw insert end $s$nl
          } else {
             set cmd ::tcl::puts
             if {$nl==""} {lappend cmd -nonewline}
             lappend cmd $channel $s
             eval $cmd
          }
       }
    }
 }

RS added fix (1), because without join the argument might still come brace-quoted. JMN (2) I think the join needs to be done here instead, else when the channel is explicitly stated, the join normalizes all whitespace chars to a single space.

RS 2013-11-11 A much simpler workaround deals with the case that when you pipe the stdout of a tclsh into tail or more, you get an ugly message like this in the end:

 error writing "stdout": broken pipe
    while executing
 "puts $line"
    (procedure "process_raw_file" line 16)
    invoked from within
 "process_raw_file $file Ref"
    (procedure "main" line 14)
    invoked from within
 "main $argv
 "

For quick tests, I usually ignore it; but when I use such scripts more often (and want to conserve screen space ;^), I rewrite calls to puts as puts! and add the one-liner

 proc puts! str {if [catch {puts $str}] exit}

Lars H: The (roughly) Tcl 7.4 interpreter embedded in the (recently retired) Alpha7 [L1 ] text editor suffered from a similar problem. In that case the bug was much nastier: a simple [puts stdout "whatever"] would crash the entire application, since there was a bug in its code for emulating a console window.

I wrote a package I called terminal ([L2 ], also distributed with the Alpha text editor as of v7.6) to work around this problem. Besides a redefinition of puts similar to the above, it also features a set of commands that make it convenient to print messages smaller than a line. The commands

  for {set n 1} {$n<=10} {incr n} {
      terminal::print_word space "\[$n" none
      if {$n % 7 == 0} then {
          terminal::print_word newline "And that's divisible by 7." none
      }
      terminal::print_word none "\]" space
      if {$n % 5 == 0} then {
          terminal::print_word newline "Interruption!" newline
      }
  }

would print the following to "the terminal":

  [1] [2] [3] [4] [5]
  Interruption!
  [6] [7
  And that's divisible by 7.] [8] [9] [10]
  Interruption!

The first and third arguments of [terminal::print_word] request that the string in the second argument is separated from surrounding text by a certain degree of whitespace. Note that there are no stray spaces at the beginning or end of lines.

Oh, yes. I should also point out that the package is written so that it works also on a standard tclsh (or whatever) shell. The main point is to provide the terminal::print_word etc. commands -- the puts workaround was a minor point.

JMN 2004-02-08 I'm using the above redefined 'puts' idea in a slightly different situation, where stdout exists but it needs to wrapped such that its output is modified or logged - basically a filter on streams I guess.

While redefining puts and delegating calls on channels that aren't of interest to the 'real' puts works; It seems to me a rather inelegant (and inefficient for some applications) mechanism, which I imagine could be solved nicely if Tcl offered a way to rename channels.

Combined with AK's Memchan extension, one could then rename stdout and provide ones own stdout using the [fifo] command and fileevent to either modify the stream to the original stdout or 'fork' the data off somewhere else.

Is there an existing mechanism aside from redefining puts to do this sort of manipulation on an existing channel?

update: https://wiki.tcl-lang.org/2701 talks of 'stacked channels' and 'transformations' which seem to be the concept I'm after. All that appears aimed at the c extension writer. For the Tcl scripter, it seems the Trf extension does the trick.

e.g

 package require Trf
 proc streamfork {op data} {
     puts stderr -->$data
     return $data
 }
 transform -attach stdout -command streamfork

GTR I am using the above to get round the error message error writing "stdout": I/O error in Tk applications when the xterm used to start the program is closed. The modified version is

 proc redef_puts {} {
    if ![llength [info command ::tcl::puts]] {
        rename puts ::tcl::puts
        proc puts args {
            set la [llength $args]
            if {$la<1 || $la>3} {
                error "usage: puts ?-nonewline? ?channel? string"
            }
            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]] ;
            }
            foreach {channel s} $args break
            if {$channel=="stdout" || $channel=="stderr"} {
                set cmd ::tcl::puts
                if {$nl==""} {lappend cmd -nonewline}
                lappend cmd $channel $s
                # We do not want to report errors writing to
                # stdout
                catch {eval $cmd}
                    
            } else {
                set cmd ::tcl::puts
                if {$nl==""} {lappend cmd -nonewline}
                lappend cmd $channel $s
                eval $cmd
            }
        }
    }
 }