##********************************************************
## Name: stdout
##
## Description:
##
## Switch stdout handling by puts command from the usual
## behaviour to a state where stdout is redefined to be
## another file.
##
## Native puts command error handling is unimpaired and
## a dangling filehandle is never generated.
##
##
## Calling convention:
##
## stdout off - redirects stdout to nowhere
##
## stdout off /tmp/foo - redirects stdout to /tmp/foo
##
## stdout on - restores normal behaviour
##
##
## by: Phil Ehrens for the LIGO Lab at Caltech 09/02
## valuable contributions by: Bruce Hartweg
##********************************************************
proc stdout { switch { file "" } } {
if { ! [ llength [ info command __puts ] ] && \
[ string equal off $switch ] } {
rename puts __puts
if { [ string length $file ] } {
eval [ subst -nocommands {proc puts { args } {
set fid [ open $file a+ ]
if { [ llength \$args ] > 1 && \
[ lsearch \$args stdout ] == 0 } {
set args [ lreplace \$args 0 0 \$fid ]
} elseif { [ llength \$args ] == 1 } {
set args [ list \$fid \$args ]
}
if { [ catch {
eval __puts \$args
} err ] } {
close \$fid
return -code error \$err
}
close \$fid
}} ]
} else {
eval [ subst -nocommands {proc puts { args } {
if { [ llength \$args ] > 1 && \
[ lsearch \$args stdout ] == 0 || \
[ llength \$args ] == 1 } {
# no-op
} else {
eval __puts \$args
}
}} ]
}
} elseif { [ llength [ info command __puts ] ] && \
[ string equal on $switch ] } {
rename puts {}
rename __puts puts
}
}BBH To make it platform agnostic without a big switch, instead of redirecting to /dev/null, just make a puts to stdout be a complete no-op when it is turned off.
Well, the idea is that people will specify a file to redirect to, but you're right, it should just do nothing if no file is specified, so now it does ;^)