Removed 'event' and 'ilist' kind for SICS objects.
r2162 | ffr | 2007-09-26 16:17:51 +1000 (Wed, 26 Sep 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
78c42a2427
commit
9e170b66d3
@@ -13,19 +13,19 @@ source $cfPath(hipadaba)/common_instrument_dictionary.tcl
|
||||
|
||||
InstallHdb
|
||||
|
||||
# TODO only use add_node to add hpaths and nodes,
|
||||
# eg add_node / path beam_monitor_scan prop_list {data true ...}
|
||||
|
||||
# eventid=source/type, type={parameter feedback graphics} eg hdb_bmonscan/feedback
|
||||
proc update_node {name eventid access} {
|
||||
global nodeindex
|
||||
upvar $name signal
|
||||
hset $nodeindex($eventid) $signal($eventid)
|
||||
namespace eval ::hdb {
|
||||
namespace export buildHDB attlist
|
||||
}
|
||||
|
||||
proc add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
|
||||
|
||||
|
||||
##
|
||||
# @brief Add an hdb path to the hdb tree at the given basePath
|
||||
#
|
||||
# @param basePath This is the parent for the new hdb path
|
||||
# @param path Add this path to the basePath
|
||||
# @param priv This is the access privilege for the new hdb path
|
||||
# @param dtype The new hdb node will have this type
|
||||
# @param dlen Array length if the hdb node represents array data
|
||||
proc ::hdb::add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
|
||||
set parent $basePath
|
||||
array set prop_arr [::utility::hlistplainprop $basePath]
|
||||
foreach child [split $path /] {
|
||||
@@ -38,7 +38,7 @@ proc add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
|
||||
hsetprop $parent/$child klass @none
|
||||
hsetprop $parent/$child type $prop_arr(type)
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$parent == "/"} {
|
||||
set parent /$child
|
||||
} else {
|
||||
@@ -48,26 +48,29 @@ proc add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
|
||||
return $parent
|
||||
}
|
||||
|
||||
proc add_cmd_par {hpath sobj name} {
|
||||
##
|
||||
# @brief Attach a command parameter node to the given hdb "command path"
|
||||
#
|
||||
# @param hpath hdb "command path", this will be the parent for the parameter node
|
||||
# @param sobj name of SICS variable which corresponds to a command parameter
|
||||
# @param name The hdb node name that the variable will be added under
|
||||
# @see command
|
||||
proc ::hdb::add_cmd_par {hpath sobj name} {
|
||||
hattach $hpath $sobj $name
|
||||
#array set property [attlist $sobj]
|
||||
# hsetprop $hpath/$name argtype $property(argtype)
|
||||
foreach {prop pval} [attlist $sobj] {
|
||||
hsetprop $hpath/$name $prop $pval
|
||||
}
|
||||
hsetprop $hpath/$name data false
|
||||
# if {[info exists property(values)]} {
|
||||
# hsetprop $hpath/$name values $property(values)
|
||||
# }
|
||||
# if {[info exists property(min)]} {
|
||||
# hsetprop $hpath/$name min $property(min)
|
||||
# }
|
||||
# if {[info exists property(max)]} {
|
||||
# hsetprop $hpath/$name max $property(max)
|
||||
# }
|
||||
}
|
||||
|
||||
proc add_feedback {hpath sobj name} {
|
||||
##
|
||||
# @brief Attach a feedback node to the given hdb "command path"
|
||||
#
|
||||
# @param hpath hdb "command path", this will be the parent for the feedback node
|
||||
# @param sobj name of the SICS variable which corresponds to a command feedback value
|
||||
# @param name The hdb node name that the variable will be added under
|
||||
# @see command
|
||||
proc ::hdb::add_feedback {hpath sobj name} {
|
||||
hattach $hpath $sobj $name
|
||||
foreach {prop pval} [attlist $sobj] {
|
||||
hsetprop $hpath/$name $prop $pval
|
||||
@@ -75,9 +78,13 @@ proc add_feedback {hpath sobj name} {
|
||||
hsetprop $hpath/$name privilege READ_ONLY
|
||||
}
|
||||
|
||||
# args is an optional set of properties as name/value pairs.
|
||||
# need node kind
|
||||
proc add_node {basePath args} {
|
||||
##
|
||||
# @brief Adds a hdb path to the given base path with the given properties
|
||||
#
|
||||
# @param args a list of name value pairs which provide the node properties\n
|
||||
#\targs can just be "path a/b/c prop_list {kind xxx long_name junk ..}"\n
|
||||
#\tor "node nnn kind kkk long_name junk prop_list {propA aaa propB bbb ...}"
|
||||
proc ::hdb::add_node {basePath args} {
|
||||
global nodeindex
|
||||
array unset arg_array
|
||||
array set arg_array $args;
|
||||
@@ -120,7 +127,7 @@ proc add_node {basePath args} {
|
||||
if {[string length [info procs ${command}_parameters]] > 0} {
|
||||
${command}_parameters add_node $cmd_path
|
||||
} else {
|
||||
$command -map param add_cmd_par $cmd_path
|
||||
$command -map param ::hdb::add_cmd_par $cmd_path
|
||||
}
|
||||
if {[string length [info procs ${command}_feedback]] > 0} {
|
||||
add_hpath $cmd_path feedback
|
||||
@@ -129,15 +136,9 @@ proc add_node {basePath args} {
|
||||
} else {
|
||||
add_hpath $cmd_path feedback
|
||||
hsetprop $cmd_path/feedback type part
|
||||
$command -map feedback add_feedback $cmd_path/feedback
|
||||
$command -map feedback ::hdb::add_feedback $cmd_path/feedback
|
||||
}
|
||||
}
|
||||
event {
|
||||
# An event is a data array, node= a node path
|
||||
add_hpath $basePath $node_name $arg_array(priv) $arg_array(dtype) $arg_array(dlen)
|
||||
set node_path $basePath/$node_name
|
||||
set nodeindex($arg_array(eventid),$arg_array(node)) $node_path
|
||||
}
|
||||
hobj {
|
||||
hattach $basePath $node_name $arg_array(long_name)
|
||||
set node_path $basePath/$arg_array(long_name)
|
||||
@@ -152,11 +153,6 @@ proc add_node {basePath args} {
|
||||
hsetprop $node_path/$child klass [getatt $node_name klass]
|
||||
}
|
||||
}
|
||||
ilist {
|
||||
set node_path $basePath
|
||||
set ilist_proc $node_name
|
||||
$ilist_proc add_node $node_path
|
||||
}
|
||||
script {
|
||||
# A r/w pair of scripts, node = a node path
|
||||
set node_path $basePath/[getatt $node_name long_name]
|
||||
@@ -186,12 +182,16 @@ proc add_node {basePath args} {
|
||||
hsetprop $node_path $prop $pval
|
||||
}
|
||||
}
|
||||
sicslist setatt $node_name hdb_path $node_path
|
||||
return $node_path
|
||||
}
|
||||
}
|
||||
|
||||
# Add command
|
||||
proc add_command {basePath command} {
|
||||
##
|
||||
# @brief Add a "command" node to basePath for the gumtree control interface.
|
||||
# @param basePath parent for new command node
|
||||
# @param command name of the command procedure
|
||||
proc ::hdb::add_command {basePath command} {
|
||||
array unset cmd_atts
|
||||
array set cmd_atts [attlist $command]
|
||||
if 0 {
|
||||
@@ -202,10 +202,6 @@ proc add_command {basePath command} {
|
||||
}
|
||||
}
|
||||
hcommand $basePath/$cmd_atts(long_name) $command
|
||||
set cmd_ns [namespace qualifiers $command]
|
||||
if {[llength [trace info variable ::${cmd_ns}::event]] == 0} {
|
||||
trace add variable ::${cmd_ns}::event write update_node
|
||||
}
|
||||
set cmd_path $basePath/$cmd_atts(long_name)
|
||||
hsetprop $cmd_path privilege $cmd_atts(privilege)
|
||||
hsetprop $cmd_path type $cmd_atts(kind)
|
||||
@@ -216,17 +212,26 @@ proc add_command {basePath command} {
|
||||
return $cmd_path
|
||||
}
|
||||
|
||||
# attlist <sicsobj>
|
||||
# return a list of name value pairs for the sicsobj attributes
|
||||
proc attlist {sicsobj} {
|
||||
##
|
||||
# @brief Retrieve the list of attributes for the given sics object
|
||||
#
|
||||
# @param sicsobj SICS object name
|
||||
# @return a list of name value pairs for the sicsobj attributes
|
||||
proc ::hdb::attlist {sicsobj} {
|
||||
foreach att [tolower_sicslist $sicsobj] {
|
||||
lappend atts [split [string range $att 0 end-1] =]
|
||||
}
|
||||
return [join $atts]
|
||||
}
|
||||
|
||||
# List sics objects with the given sics type, klass and group
|
||||
proc sobjlist {atype aklass} {
|
||||
|
||||
##
|
||||
# @brief List sics objects with the given sics type, klass and group
|
||||
#
|
||||
# @param atype one of the types given in instdict_specification.tcl
|
||||
# @param aklass one of the klasses given in instdict_specification.tcl
|
||||
# @return A Tcl list of SICS objects.
|
||||
proc ::hdb::sobjlist {atype aklass} {
|
||||
global sobj_sicstype_list
|
||||
|
||||
switch $atype {
|
||||
@@ -248,15 +253,25 @@ proc sobjlist {atype aklass} {
|
||||
}
|
||||
}
|
||||
|
||||
proc getsobjatt {sicsobj attribute} {
|
||||
##
|
||||
# @brief Get the named attribute from the given SICS object
|
||||
#
|
||||
# @param sicsobj a SICS object name
|
||||
# @param attribute name of the attribute to be fetched
|
||||
# @return the plain attribute value
|
||||
proc ::hdb::getsobjatt {sicsobj attribute} {
|
||||
string trim [lindex [join [split [tolower_sicslist $sicsobj $attribute] =]] 1]
|
||||
}
|
||||
|
||||
|
||||
# Add the given sics object (sobj) of sobjtype to the
|
||||
# given hipadaba path hpath.
|
||||
# hpath must exist.
|
||||
proc sobjadd {hpath sobj args} {
|
||||
##
|
||||
# @brief Add the given sics object of sobjtype to the given hipadaba path (hpath must exist)
|
||||
#
|
||||
# @param hpath parent for new hdb node
|
||||
# @param sobj SICS object name
|
||||
# @param args Hmmm this doesn't get used, do we need it?
|
||||
proc ::hdb::sobjadd {hpath sobj args} {
|
||||
# TODO Check if args parameter needs to be here, it might be there in case the function is called
|
||||
# with more than two arguments.
|
||||
array unset sobjatt
|
||||
array set sobjatt [attlist $sobj]
|
||||
sicslist setatt $sobj id $sobj
|
||||
@@ -350,6 +365,9 @@ proc sobjadd {hpath sobj args} {
|
||||
if {[catch { hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
|
||||
if {[catch { hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
|
||||
if {[catch { hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
|
||||
hmakescript $node_path/target "$sobj target" hdbReadOnly float
|
||||
hsetprop $node_path/target data false
|
||||
hsetprop $node_path/target control true
|
||||
} else {
|
||||
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
|
||||
}
|
||||
@@ -357,10 +375,16 @@ proc sobjadd {hpath sobj args} {
|
||||
}
|
||||
}
|
||||
|
||||
# sobjtypeadd <hpath> <sobjtype>
|
||||
# Traverses list of sics objects of given type and attaches the matching sics objects to the given hpath
|
||||
# Hipadaba node properties are constructed from the sobj attribute list.
|
||||
proc sobjtypeadd {hpath sobjtype given_klass} {
|
||||
##
|
||||
# @brief Attaches the SICS objects of the given type and klass to the given hdb path
|
||||
#
|
||||
# The hipadaba node properties are constructed from the SICS object attribute list.
|
||||
#
|
||||
# @param hpath parent for the new SICS object nodes
|
||||
# @param sobjtype One of the types in instdict_specification.tcl
|
||||
# @param given_klass A klass in instdict_specification.tcl
|
||||
# @see sobjadd
|
||||
proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} {
|
||||
foreach {sobj} [sobjlist $sobjtype $given_klass] {
|
||||
sobjadd $hpath $sobj
|
||||
}
|
||||
@@ -374,7 +398,7 @@ proc sobjtypeadd {hpath sobjtype given_klass} {
|
||||
#
|
||||
# Nodes which have no child nodes and no associated sics objects for the
|
||||
# current instrument are removed.
|
||||
proc prune {instdict} {
|
||||
proc ::hdb::prune {instdict} {
|
||||
upvar $instdict dict
|
||||
array set dictarr $dict
|
||||
set candidates [array names dictarr]
|
||||
@@ -410,16 +434,17 @@ proc prune {instdict} {
|
||||
set dict [array get dictarr]
|
||||
return
|
||||
}
|
||||
#
|
||||
#TODO add data control nxsave nxtyp properties
|
||||
|
||||
##
|
||||
# @brief Traverse the instrument dictionary and construct the hipadaba database.
|
||||
#
|
||||
# This command prunes the dictionary before building it.
|
||||
#
|
||||
# @param instDict name of the instrument dictionary structure
|
||||
#
|
||||
# This command prunes the dictionary before building it.
|
||||
# @see prune
|
||||
proc buildHDB {instDict} {
|
||||
proc ::hdb::buildHDB {instDict} {
|
||||
#TODO add data control nxsave nxtyp properties
|
||||
upvar #0 $instDict dictionary
|
||||
prune dictionary
|
||||
foreach {n v} $dictionary {
|
||||
@@ -436,33 +461,40 @@ prune dictionary
|
||||
}
|
||||
}
|
||||
|
||||
namespace eval ::hdb {
|
||||
proc set_save {hpath mode {top true}} {
|
||||
if {$hpath != "/"} {
|
||||
set hnode $hpath
|
||||
} else {
|
||||
foreach hp [hlist /] {
|
||||
::hdb::set_save /$hp $mode
|
||||
}
|
||||
return
|
||||
}
|
||||
if {[::utility::hgetplainprop $hnode data] == "false"} {
|
||||
return
|
||||
}
|
||||
foreach hp [hlist $hnode] {
|
||||
set_save $hnode/$hp $mode false
|
||||
}
|
||||
if {$top == "true"} {
|
||||
hsetprop $hnode nxsave $mode
|
||||
if {$mode == "true"} {
|
||||
set hp ""
|
||||
foreach ps [lrange [split [string trim $hnode /] /] 0 end-1] {
|
||||
set hp $hp/$ps
|
||||
hsetprop $hp nxsave true
|
||||
}
|
||||
}
|
||||
} else {
|
||||
hsetprop $hnode nxsave $mode
|
||||
##
|
||||
# @brief Set the save state for the given subtree
|
||||
#
|
||||
# @param hpath The save state of the nodes below this path will be set
|
||||
# @param mode true or false
|
||||
# @param top This is just here to make the recursion work from the top level, You don't need
|
||||
# to set this
|
||||
proc ::hdb::set_save {hpath mode {top true}} {
|
||||
if {$hpath != "/"} {
|
||||
set hnode $hpath
|
||||
} else {
|
||||
foreach hp [hlist /] {
|
||||
::hdb::set_save /$hp $mode
|
||||
}
|
||||
return
|
||||
}
|
||||
if {[::utility::hgetplainprop $hnode data] == "false"} {
|
||||
return
|
||||
}
|
||||
foreach hp [hlist $hnode] {
|
||||
set_save $hnode/$hp $mode false
|
||||
}
|
||||
if {$top == "true"} {
|
||||
hsetprop $hnode nxsave $mode
|
||||
if {$mode == "true"} {
|
||||
set hp ""
|
||||
foreach ps [lrange [split [string trim $hnode /] /] 0 end-1] {
|
||||
set hp $hp/$ps
|
||||
hsetprop $hp nxsave true
|
||||
}
|
||||
}
|
||||
} else {
|
||||
hsetprop $hnode nxsave $mode
|
||||
}
|
||||
}
|
||||
|
||||
namespace import ::hdb::*
|
||||
|
||||
@@ -16,12 +16,9 @@ set sobj_sicstype_list {environment_controller sicsvariable macro motor configur
|
||||
# Different kinds of things are added to the hdb in different ways.
|
||||
# command: This is something a client can run with hset /a/b/c start, it may have parameters and feedback.
|
||||
# Parameters and feedback should be made available in 'ilists' named after the command.
|
||||
# ilist: An intelligent list, it's like a list comprehension that takes a closure as the mapping function.
|
||||
# event: This is an associative array which can be watched for modifications. You can use the array index
|
||||
# to choose an action.
|
||||
# script: Supplies an rscript and a wscript to attach to a node for hgets and hsets.
|
||||
# hobj: Something that can be hattached to a node. {motor sicsvariable histmem}.
|
||||
set sobj_kind_list {command event hobj ilist script}
|
||||
set sobj_kind_list {command hobj script}
|
||||
set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }]
|
||||
|
||||
set privilege_list {spy user manager read_only internal}
|
||||
|
||||
Reference in New Issue
Block a user