if {[package vcompare [package provide Tcl] 8] < 0} { array set Tcl7.6_fcopy [list "" ""] unset Tcl7.6_fcopy() ;proc Tcl7.6_fcopy {i o toCopy copied} { global Tcl7.6_fcopy fileevent $i readable {} # We need our [fcopy] replacement to be "binary-safe". # In Tcl 7.*, the only command which can perform a binary-safe output # to a channel is [unsupported0]. if {[catch {unsupported0 $i $o 1} written]} { set Tcl7.6_fcopy($i) [list $copied $written] } elseif {$written == 0} { # EOF on $i --> quit. set Tcl7.6_fcopy($i) $copied } else { incr toCopy -$written incr copied $written if {$toCopy == 0} { # Copy reqest completed. set Tcl7.6_fcopy($i) $copied } else { # Keep working fileevent $i readable [list Tcl7.6_fcopy $i $o $toCopy $copied] } } } ;proc Tcl7.6_fcopyTrace {cmd n1 n2 op} { set val [uplevel 1 [list set ${n1}($n2)]] uplevel 1 [list unset ${n1}($n2)] uplevel #0 $cmd $val } ;proc fcopy {in out args} { # Strange quirk: if [unsupported0] has negative request for number of # bytes to copy, it will copy until EOF set aa(-size) -1 array set aa $args if {[catch {incr aa(-size) 0} msg]} { return -code error "bad -size argument: $msg" } if {[info exists aa(-command)]} { global Tcl7.6_fcopy if {![string match "" [fileevent $in readable]]} { return -code error "can't fcopy from $in in background;\ fileevent in use:\n[fileevent $in readable]" } fileevent $in readable [list Tcl7.6_fcopy $in $out $aa(-size) 0] trace variable Tcl7.6_fcopy($in) w \ [list Tcl7.6_fcopyTrace $aa(-command)] return {} } else { return [uplevel [list unsupported0 $in $out $aa(-size)]] } } }
Please ignore my previous attempt [L1 ]. It was wrong, wrong wrong. DGP
AMG: Link broken.