compatibility problem with old tcl version on solaris

This commit is contained in:
zimoch
2011-05-06 12:14:23 +00:00
parent 70073e1b69
commit 129cc61759

View File

@ -158,19 +158,22 @@ proc assure {args} {
} }
proc escape {string} { proc escape {string} {
while {![string is print -failindex index $string]} { set result ""
set char [string index $string $index] set length [string length $string]
scan $char "%c" code for {set i 0} {$i < $length} {incr i} {
switch $char { set c [string index $string $i]
"\r" { set escaped "\\r" } scan $c %c n
"\n" { set escaped "\\n" } if {$n == 13} {
"\a" { set escaped "\\a" } append result "\\r"
"\t" { set escaped "\\t" } } elseif {$n == 10} {
default { set escaped [format "<%02x>" $code] } append result "\\n"
} elseif {($n & 127) < 32} {
append result [format "<%02x>" $n]
} else {
append result $c
} }
set string [string replace $string $index $index $escaped]
} }
return $string return $result
} }
proc finish {} { proc finish {} {