From 1881907e009328a99b05c25f0c12f42e32c34afb Mon Sep 17 00:00:00 2001 From: Douglas Clowes Date: Fri, 16 May 2014 16:38:38 +1000 Subject: [PATCH] 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 --- site_ansto/instrument/gumxml.tcl | 58 ++++++++++++++++++++++++++++---- 1 file changed, 51 insertions(+), 7 deletions(-) diff --git a/site_ansto/instrument/gumxml.tcl b/site_ansto/instrument/gumxml.tcl index 47e04260..8b430abd 100644 --- a/site_ansto/instrument/gumxml.tcl +++ b/site_ansto/instrument/gumxml.tcl @@ -46,11 +46,11 @@ proc encode {str} { } 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" + 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 tcl]] { set value [encode $rvalue] if {[string compare -nocase $key "control"] == 0} { @@ -79,10 +79,10 @@ proc property_elements {path indent} { if {[string compare -nocase $key "control"] == 0} {continue} lappend proplist "$prefix\n" if {[string compare -nocase $key "help"] == 0} { - lappend proplist "$prefix$prefix$value\n" + lappend proplist "$prefix $value\n" } else { foreach v [split $value ,] { - lappend proplist "$prefix$prefix$v\n" + lappend proplist "$prefix $v\n" } } lappend proplist "$prefix\n" @@ -105,7 +105,51 @@ proc getgumtreexml {path} { append result "\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\n" + if {[string compare -nocase $type "none"] != 0} { + set value [encode [hval $path]] + append result "$prefix $value\n" + } + foreach x [hlist $path] { + set result [make_value_nodes [string map {// /} "$path/$x"] $result $newIndent] + } + append result "$prefix\n" + } + return $result +} + +proc getgumtreexmlvalues {path} { + append result "\n" + append result "\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 "\n" +} + if {[info exists guminit] == 0} { set guminit 1 Publish getgumtreexml Spy + Publish getgumtreexmlvalues Spy }