compatibility problem with old tcl version on solaris
This commit is contained in:
@ -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 {} {
|
||||||
|
Reference in New Issue
Block a user