From be40877668b662b08a59b5556dce344855aa861c Mon Sep 17 00:00:00 2001
From: Douglas Clowes <dcl@ansto.gov.au>
Date: Fri, 8 Jun 2007 14:03:27 +1000
Subject: [PATCH] Modified from sics/tcl/gumxml.tcl to select only nodes with
 attribute control=true

r2004 | dcl | 2007-06-08 14:03:27 +1000 (Fri, 08 Jun 2007) | 2 lines
---
 site_ansto/instrument/gumxml.tcl | 62 ++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 site_ansto/instrument/gumxml.tcl

diff --git a/site_ansto/instrument/gumxml.tcl b/site_ansto/instrument/gumxml.tcl
new file mode 100644
index 00000000..afc82bde
--- /dev/null
+++ b/site_ansto/instrument/gumxml.tcl
@@ -0,0 +1,62 @@
+proc getdataType {path} {
+  return [lindex [split [hinfo $path] ,] 0]
+}
+
+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 "false"
+  foreach {key value} [string map {= " "} [hlistprop $path]] {
+    if {[string compare -nocase $key "control"] == 0} {
+      if {[string compare -nocase $value "true"] == 0} {
+	set control "true"
+      }
+    }
+  }
+  if {"$control" == "true"} {
+    append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\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"
+  }
+  return $result
+}
+
+proc property_elements {path indent} {
+  set prefix [string repeat " " $indent]
+  foreach {key value} [string map {= " "} [hlistprop $path]] {
+    if {[string compare -nocase $key "control"] == 0} {continue}
+    lappend proplist "$prefix<property id=\"$key\">\n"
+    foreach v [split $value ,] {
+      lappend proplist "$prefix$prefix<value>$v</value>\n"
+    }
+    lappend proplist "$prefix</property>\n"
+  }
+  if [info exists proplist] {return $proplist}
+}
+
+proc getgumtreexml {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_nodes $n $result 2]
+    }
+  } else {
+    set result [make_nodes $path $result 2]
+  }
+
+  append result "</hipadaba:SICS>\n"
+}
+
+if {[info exists guminit] == 0} {
+  set guminit 1
+  Publish getgumtreexml Spy
+}