From 1881907e009328a99b05c25f0c12f42e32c34afb Mon Sep 17 00:00:00 2001
From: Douglas Clowes <dcl@ansto.gov.au>
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<property id=\"$key\">\n"
     if {[string compare -nocase $key "help"] == 0} {
-      lappend proplist "$prefix$prefix<value>$value</value>\n"
+      lappend proplist "$prefix  <value>$value</value>\n"
     } else {
       foreach v [split $value ,] {
-        lappend proplist "$prefix$prefix<value>$v</value>\n"
+        lappend proplist "$prefix  <value>$v</value>\n"
       }
     }
     lappend proplist "$prefix</property>\n"
@@ -105,7 +105,51 @@ proc getgumtreexml {path} {
   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} {
   set guminit 1
   Publish getgumtreexml Spy
+  Publish getgumtreexmlvalues Spy
 }