linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implement hlistprop $path tclnames

Browse Source 
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
This commit is contained in:
Douglas Clowes
2014-07-02 12:28:41 +10:00
parent 87bf34c7b1
commit 3224422d60
5 changed files with 66 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl
View File

@@ -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

14
site_ansto/instrument/config/nexus/nxscripts_common_1.tcl
View File

@@ -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)} {