Implement hlistprop $path tclnames

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

sicshipadaba.c

@@ -3597,6 +3597,8 @@ static int ListSICSHdbProperty(SConnection * pCon, SicsInterp * pSics,
       genTclList = 1;
     if (strncasecmp(argv[2], "tclesc", 6) == 0)
       genTclList |= 2;
+    if (strncasecmp(argv[2], "tclnam", 6) == 0)
+      genTclList |= 4;
   }
   targetNode = FindHdbNode(NULL, argv[1], pCon);
   if (targetNode == NULL) {
@@ -3614,6 +3616,8 @@ static int ListSICSHdbProperty(SConnection * pCon, SicsInterp * pSics,
     if (genTclList) {
       char *bp;
       DynStringConcatChar(data, ' ');
+      if (genTclList & 4)
+        continue;
       DynStringConcatChar(data, '{');
       for (bp = buffer; *bp; ++bp) {
         if (genTclList & 2 && (*bp == '{' || *bp == '}'))

site_ansto/instrument/TEST_SICS/unit_tests/test_suite.tcl

@@ -98,7 +98,7 @@ proc test_suite::make_nodes {path result indent} {
   foreach p [test_suite::property_elements $path $newIndent] {
     append result $p
   }
-  foreach x [hlist $path] {
+  foreach x [lsort [hlist $path]] {
     set result [test_suite::make_nodes [string map {// /} "$path/$x"] $result $newIndent]
   }
   append result  "$prefix</component>\n"
@@ -107,8 +107,8 @@ proc test_suite::make_nodes {path result indent} {
 
 proc test_suite::property_elements {path indent} {
   set prefix [string repeat " " $indent]
-  foreach {key rvalue} [string map {= " "} [hlistprop $path tcl]] {
+  foreach {key} [lsort [hlistprop $path tclnames]] {
-    set value [test_suite::encode $rvalue]
+    set value [test_suite::encode [hgetpropval $path $key]]
     lappend proplist "$prefix<property id=\"$key\">\n"
     lappend proplist "$prefix  <value>$value</value>\n"
     lappend proplist "$prefix</property>\n"
@@ -121,7 +121,7 @@ proc test_suite::getsicsxml {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 [test_suite::make_nodes $n $result 2]
     }
   } else {

site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl

@@ -403,7 +403,9 @@ proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @no
 proc ::hdb::add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
   set catch_status [ catch {
     set parent $basePath
-    array set prop_arr [hlistprop $basePath tcllist]
+    foreach {key} [hlistprop $basePath tclnames] {
+      array set prop_arr [list $key "[hgetpropval $basePath $key]"]
+    }
     foreach child [split $path /] {
       if {[lsearch [hlist $parent] $child] == -1} {
         hmake $parent/$child $priv $dtype $dlen

site_ansto/instrument/config/nexus/nxscripts_common_1.tcl

@@ -645,7 +645,9 @@ proc ::nexus::savetree {hpath pt filestatus} {
   foreach child [hlist /$hpath] {
     if [ catch {
       array unset p_arr
-      array set p_arr [hlistprop /$hpath/$child tcllist]
+      foreach {key} [hlistprop /$hpath/$child tclnames] {
+        array set p_arr [list $key "[hgetpropval /$hpath/$child $key]"]
+      }
       if {([info exists p_arr(type)] == 0) || ($p_arr(type) != "nxvgroup")} {
         set data_type [lindex [split [hinfo /$hpath/$child] , ] 0]
           if {[info exists p_arr(data)] && ($p_arr(data) == true) && ($p_arr(nxsave) == true) } {
@@ -711,7 +713,10 @@ proc ::nexus::_gen_nxdict {hpath dictPath name nxc} {
           }
         }
       }
-      array set p_arr [hlistprop /$hpath tcllist]
+      array unset p_arr
+      foreach {key} [hlistprop /$hpath tclnames] {
+        array set p_arr [list $key "[hgetpropval /$hpath $key]"]
+      }
       set data_type [lindex [split [hinfo /$hpath] , ] 0]
       if {$data_type != "none" || $p_arr(type) == "nxvgroup"} {
         #XXX Do we need to check data_type here. This would skip NXVGROUP nodes
@@ -895,7 +900,10 @@ proc ::nexus::histmem::save {hm nxalias hpath data_type filestatus args} {
 
   if [catch {
     set point [lindex $args 1]
-    array set pa [hlistprop $hpath tcllist]
+    array unset pa
+    foreach {key}  [hlistprop /$hpath tclnames] {
+      array set pa [list $key "[hgetpropval /$hpath $key]"]
+    }
     foreach sdsname $pa(hmmdatname) rank $pa(hmmrank) dimstr $pa(hmmdimstr) hmmslabstart $pa(hmmslabstart) hmmslabend $pa(hmmslabend) hmmperiodsize $pa(hmmperiodsize) axes $pa(@axes) signal $pa(@signal) {
       nxscript updatedictvar pa_hmmdatname $sdsname
       if {$pa(mutable)} {

site_ansto/instrument/gumxml.tcl

@@ -46,20 +46,18 @@ 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"
-      }
-    }
-  }
-  if {"$control" == "true"} {
   append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
   if {[string compare -nocase $type "none"] != 0} {
     if [ catch {
@@ -72,19 +70,19 @@ proc make_nodes {path result indent} {
   foreach p [property_elements $path $newIndent] {
     append result $p
   }
-    foreach x [hlist $path] {
+  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]] {
+  foreach {key} [lsort [hlistprop $path tclnames]] {
-    set value [encode $rvalue]
     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,20 +112,18 @@ 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"
-    }
-  }
-
-  if {"$control" == "true"} {
   append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
   if {[string compare -nocase $type "none"] != 0} {
     if [ catch {
@@ -137,11 +133,11 @@ proc make_value_nodes {path result indent} {
     }
     append result "$prefix  <value>$value</value>\n"
   }
-    foreach x [hlist $path] {
+  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 {