Add getgumtreexmlvalues function for values without properties
Allows gumtree to quickly get updated values for a node branch without the additional bloat of the node properties
This commit is contained in:
@ -46,11 +46,11 @@ proc encode {str} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc make_nodes {path result indent} {
|
proc make_nodes {path result indent} {
|
||||||
set nodename [file tail $path];
|
set nodename [file tail $path];
|
||||||
set type [getdataType $path]
|
set type [getdataType $path]
|
||||||
set prefix [string repeat " " $indent]
|
set prefix [string repeat " " $indent]
|
||||||
set newIndent [expr $indent + 2]
|
set newIndent [expr $indent + 2]
|
||||||
set control "true"
|
set control "true"
|
||||||
foreach {key rvalue} [string map {= " "} [hlistprop $path tcl]] {
|
foreach {key rvalue} [string map {= " "} [hlistprop $path tcl]] {
|
||||||
set value [encode $rvalue]
|
set value [encode $rvalue]
|
||||||
if {[string compare -nocase $key "control"] == 0} {
|
if {[string compare -nocase $key "control"] == 0} {
|
||||||
@ -79,10 +79,10 @@ proc property_elements {path indent} {
|
|||||||
if {[string compare -nocase $key "control"] == 0} {continue}
|
if {[string compare -nocase $key "control"] == 0} {continue}
|
||||||
lappend proplist "$prefix<property id=\"$key\">\n"
|
lappend proplist "$prefix<property id=\"$key\">\n"
|
||||||
if {[string compare -nocase $key "help"] == 0} {
|
if {[string compare -nocase $key "help"] == 0} {
|
||||||
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
lappend proplist "$prefix <value>$value</value>\n"
|
||||||
} else {
|
} else {
|
||||||
foreach v [split $value ,] {
|
foreach v [split $value ,] {
|
||||||
lappend proplist "$prefix$prefix<value>$v</value>\n"
|
lappend proplist "$prefix <value>$v</value>\n"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
lappend proplist "$prefix</property>\n"
|
lappend proplist "$prefix</property>\n"
|
||||||
@ -105,7 +105,51 @@ proc getgumtreexml {path} {
|
|||||||
append result "</hipadaba:SICS>\n"
|
append result "</hipadaba:SICS>\n"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
proc make_value_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"
|
||||||
|
if {[hpropexists $path "control"]} {
|
||||||
|
set value [encode [hgetpropval $path "control"]]
|
||||||
|
if {[string compare -nocase $value "false"] == 0} {
|
||||||
|
set control "false"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if {"$control" == "true"} {
|
||||||
|
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
|
||||||
|
if {[string compare -nocase $type "none"] != 0} {
|
||||||
|
set value [encode [hval $path]]
|
||||||
|
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"
|
||||||
|
}
|
||||||
|
return $result
|
||||||
|
}
|
||||||
|
|
||||||
|
proc getgumtreexmlvalues {path} {
|
||||||
|
append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
|
||||||
|
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
|
||||||
|
|
||||||
|
if {[string compare $path "/" ] == 0} {
|
||||||
|
foreach n [hlist $path] {
|
||||||
|
set result [make_value_nodes $n $result 2]
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
set result [make_value_nodes $path $result 2]
|
||||||
|
}
|
||||||
|
|
||||||
|
append result "</hipadaba:SICS>\n"
|
||||||
|
}
|
||||||
|
|
||||||
if {[info exists guminit] == 0} {
|
if {[info exists guminit] == 0} {
|
||||||
set guminit 1
|
set guminit 1
|
||||||
Publish getgumtreexml Spy
|
Publish getgumtreexml Spy
|
||||||
|
Publish getgumtreexmlvalues Spy
|
||||||
}
|
}
|
||||||
|
Reference in New Issue
Block a user