linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Escape illegal xml characters returned by the getgumtreexml command.

Browse Source
This commit is contained in:
Ferdi Franceschini
2014-03-21 10:45:41 +11:00
committed by Ferdi Franceschini
parent 8964750835
commit e2f2f1bc0c
1 changed files with 15 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
site_ansto/instrument/gumxml.tcl
View File

@ -2,13 +2,25 @@ proc getdataType {path} {
return [lindex [split [hinfo $path] ,] 0]
}
proc encode {str} {
set result [string map -nocase {
{"} {"}
{'} {'}
{<} {&lt;}
{>} {&gt;}
{&} {&amp;}
} $str]
return $result
}
proc make_nodes {path result indent} {
set nodename [file tail $path];
set type [getdataType $path]
set prefix [string repeat " " $indent]
set newIndent [expr $indent + 2]
set control "true"
foreach {key value} [string map {= " "} [hlistprop $path tcl]] {
foreach {key rvalue} [string map {= " "} [hlistprop $path tcl]] {
set value [encode $rvalue]
if {[string compare -nocase $key "control"] == 0} {
if {[string compare -nocase $value "false"] == 0} {
set control "false"
@ -30,7 +42,8 @@ set control "true"
proc property_elements {path indent} {
set prefix [string repeat " " $indent]
foreach {key value} [string map {= " "} [hlistprop $path tcl]] {
foreach {key rvalue} [string map {= " "} [hlistprop $path tcl]] {
set value [encode $rvalue]
if {[string compare -nocase $key "control"] == 0} {continue}
lappend proplist "$prefix<property id=\"$key\">\n"
if {[string compare -nocase $key "help"] == 0} {