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

Implement hlistprop $path tclnames

Browse Source 
Squashed commit of the following:

commit 736f0f3da501ee39fb89735a1142fe6ff2b2c4dd
Author: Douglas Clowes <dcl@ansto.gov.au>
Date:   Wed Jul 2 12:21:32 2014 +1000

    Use hlistprop $path tclnames in hipadaba_configuration_common.tcl

commit 428cac5ac8fe37f6998d3114c71ca01fc9446644
Author: Douglas Clowes <dcl@ansto.gov.au>
Date:   Wed Jul 2 12:11:47 2014 +1000

    Use hlistprop $path tclnames in nxscripts_common_1.tcl

commit 123cc63924e92a9453bfd1297a4ee6398b31bd1d
Author: Douglas Clowes <dcl@ansto.gov.au>
Date:   Wed Jul 2 10:56:34 2014 +1000

    Use hlistprop $path tclnames in gumxml.tcl

commit e23f8befd36a2066ceaa32ce3d37d53bc462f870
Author: Douglas Clowes <dcl@ansto.gov.au>
Date:   Wed Jul 2 10:55:48 2014 +1000

    Use hlistprop $path tclnames in testing

commit a3587be0a8cc9a9452a75cb0e19572558d35a08a
Author: Douglas Clowes <dcl@ansto.gov.au>
Date:   Wed Jul 2 10:55:01 2014 +1000

    Implement hlistprop $path tclnames
This commit is contained in:
Douglas Clowes
2014-07-02 12:28:41 +10:00
parent 87bf34c7b1
commit 3224422d60
5 changed files with 66 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
site_ansto/instrument/gumxml.tcl
View File

@@ -46,45 +46,43 @@ proc encode {str} {
}
proc make_nodes {path result indent} {
if {[hpropexists $path "control"]} {
set value [hgetpropval $path "control"]
if {[string compare -nocase $value "false"] == 0} {
return $result
}
}
set nodename [file tail $path];
set type [getdataType $path]
set prefix [string repeat " " $indent]
set newIndent [expr $indent + 2]
set control "true"
foreach {key rvalue} [string map {= " "} [hlistprop $path tclescape]] {
set value [encode $rvalue]
if {[string compare -nocase $key "control"] == 0} {
if {[string compare -nocase $value "false"] == 0} {
set control "false"
}
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
if {[string compare -nocase $type "none"] != 0} {
if [ catch {
set value [encode [hval $path]]
} message ] {
set value "HVAL_ERROR:${message}"
}
append result "$prefix <value>$value</value>\n"
}
if {"$control" == "true"} {
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
if {[string compare -nocase $type "none"] != 0} {
if [ catch {
set value [encode [hval $path]]
} message ] {
set value "HVAL_ERROR:${message}"
}
append result "$prefix <value>$value</value>\n"
}
foreach p [property_elements $path $newIndent] {
append result $p
}
foreach x [hlist $path] {
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
}
append result "$prefix</component>\n"
foreach p [property_elements $path $newIndent] {
append result $p
}
foreach x [lsort [hlist $path]] {
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
}
append result "$prefix</component>\n"
return $result
}
proc property_elements {path indent} {
set prefix [string repeat " " $indent]
foreach {key rvalue} [string map {= " "} [hlistprop $path tclescape]] {
set value [encode $rvalue]
foreach {key} [lsort [hlistprop $path tclnames]] {
if {[string compare -nocase $key "control"] == 0} {continue}
set value [encode [hgetpropval $path $key]]
lappend proplist "$prefix<property id=\"$key\">\n"
if {[string compare -nocase $key "help"] == 0} {
lappend proplist "$prefix <value>$value</value>\n"
@@ -103,7 +101,7 @@ proc getgumtreexml {path} {
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
if {[string compare $path "/" ] == 0} {
foreach n [hlist $path] {
foreach n [lsort [hlist $path]] {
set result [make_nodes $n $result 2]
}
} else {
@@ -114,34 +112,32 @@ proc getgumtreexml {path} {
}
proc make_value_nodes {path result indent} {
if {[hpropexists $path "control"]} {
set value [hgetpropval $path "control"]
if {[string compare -nocase $value "false"] == 0} {
return $result
}
}
set nodename [file tail $path];
set type [getdataType $path]
set prefix [string repeat " " $indent]
set newIndent [expr $indent + 2]
set control "true"
if {[hpropexists $path "control"]} {
set value [encode [hgetpropval $path "control"]]
if {[string compare -nocase $value "false"] == 0} {
set control "false"
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
if {[string compare -nocase $type "none"] != 0} {
if [ catch {
set value [encode [hval $path]]
} message ] {
set value "HVAL_ERROR:${message}"
}
append result "$prefix <value>$value</value>\n"
}
if {"$control" == "true"} {
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
if {[string compare -nocase $type "none"] != 0} {
if [ catch {
set value [encode [hval $path]]
} message ] {
set value "HVAL_ERROR:${message}"
}
append result "$prefix <value>$value</value>\n"
}
foreach x [hlist $path] {
set result [make_value_nodes [string map {// /} "$path/$x"] $result $newIndent]
}
append result "$prefix</component>\n"
foreach x [lsort [hlist $path]] {
set result [make_value_nodes [string map {// /} "$path/$x"] $result $newIndent]
}
append result "$prefix</component>\n"
return $result
}
@@ -150,7 +146,7 @@ proc getgumtreexmlvalues {path} {
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
if {[string compare $path "/" ] == 0} {
foreach n [hlist $path] {
foreach n [lsort [hlist $path]] {
set result [make_value_nodes $n $result 2]
}
} else {