Merged 2.4 branch

r2828 | ffr | 2009-11-25 09:56:49 +1100 (Wed, 25 Nov 2009) | 2 lines

site_ansto/instrument/util/check/query_sics.tcl

@@ -58,7 +58,7 @@ proc _query_nameval {query nameval_list} {
         }
       }
       "int" {
-        if {[string is internal $proparr($prop)] == $test} {
+        if {[string is integer $proparr($prop)] == $test} {
           continue
         } else {
           return 0

site_ansto/instrument/util/extra_utility.tcl

@@ -74,7 +74,7 @@ proc callStack {enable} {
   trace $trace_opt execution catch leave leavecatch
 }
 publish callStack mugger
-callStack true
+callStack false
  
  
 # LIST FUNCTIONS

site_ansto/instrument/util/script_context_util.tcl

@@ -5,6 +5,37 @@ proc ::scobj::set_required_props {hpath} {
     ::scobj::set_required_props $hpath/$child
   }
 }
+
+proc ::scobj::hinit_nodeprops {node hpath} {
+  hsetprop $hpath nxalias $node
+  foreach {prop propval} [subst {
+    control true
+    data true
+    nxsave true
+    mutable true
+    klass parameter
+    sdsinfo ::nexus::scobj::sdsinfo
+    long_name $node
+  }] {
+    if {[hpropexists $hpath $prop] == false} {
+      hsetprop $hpath $prop $propval
+    }
+  }
+}
+proc ::scobj::hinit_scobjprops {scobj hpath} {
+  foreach {prop propval} [subst {
+    klass parameter
+    long_name $scobj
+  }] {
+    if {[hpropexists $hpath $prop] == false} {
+      sicslist setatt $scobj $prop $propval
+    } else {
+      sicslist setatt $scobj $prop [hgetpropval $hpath $prop]
+    }
+  }
+  hsetprop $hpath sicsdev $scobj
+  ::scobj::hinit_nodeprops $scobj $hpath
+}
 ##
 # @brief Initialise the hdb properties required for generating the GumTree interface and
 # saving data for script context objects
@@ -13,16 +44,9 @@ proc ::scobj::set_required_props {hpath} {
 proc ::scobj::hinitprops {scobj {par "@none"}} {
   if {$par == "@none"} {
     set hpath /sics/$scobj
-    hsetprop $hpath nxalias $scobj
+    ::scobj::hinit_scobjprops $scobj $hpath
   } else {
     set hpath /sics/$scobj/$par
-    hsetprop $hpath nxalias ${scobj}_$par
+    ::scobj::hinit_nodeprops ${scobj}_$par $hpath
   }
-  hsetprop $hpath control true
-  hsetprop $hpath data true
-  hsetprop $hpath nxsave true
-  hsetprop $hpath mutable true
-  hsetprop $hpath klass parameter
-# hsetprop $hpath sicsdev $scobj
-  hsetprop $hpath sdsinfo ::nexus::scobj::sdsinfo
 }

site_ansto/instrument/util/utility.tcl

@@ -1,7 +1,7 @@
 # Some useful functions for SICS configuration.
 
-# $Revision: 1.21 $
-# $Date: 2009-03-30 23:16:54 $
+# $Revision: 1.22 $
+# $Date: 2009-11-24 22:56:49 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by $Author: ffr $
 
@@ -206,14 +206,14 @@ namespace eval utility {
   set currvalbase $valbase_port
   foreach inst $instrument_names {
     array set sics_port [list\
-      telnet-$inst $currbase\
-      interrupt-$inst [expr {$currbase+1}]\
-      server-$inst [expr {$currbase+2}]\
-      quieck-$inst [expr {$currbase+3}]\
-      telnet-val-$inst $currvalbase\
-      interrupt-val-$inst [expr {$currvalbase+1}]\
-      server-val-$inst [expr {$currvalbase+2}]\
-      quieck-val-$inst [expr {$currvalbase+3}]\
+      sics-telnet-$inst $currbase\
+      sics-interrupt-$inst [expr {$currbase+1}]\
+      sics-server-$inst [expr {$currbase+2}]\
+      sics-quieck-$inst [expr {$currbase+3}]\
+      sics-telnet-val-$inst $currvalbase\
+      sics-interrupt-val-$inst [expr {$currvalbase+1}]\
+      sics-server-val-$inst [expr {$currvalbase+2}]\
+      sics-quieck-val-$inst [expr {$currvalbase+3}]\
     ]
     set currbase [expr {$currbase+100}]
     set currvalbase [expr {$currvalbase+100}]
@@ -286,7 +286,7 @@ proc getatt {sicsobj att} {
   if [catch {
     lindex [split [tolower_sicslist $sicsobj $att] =] 1
     } reply ] {
-      return -code error $reply
+      return -code error "([info level 0]) $reply"
     } else {
       return $reply
     }
@@ -361,8 +361,9 @@ proc params {args} {
 
 # Parse motor readings for virtual motor scripts.
 proc SplitReply { text } {
-     set l [split $text =]
-     return [string trim [lindex $l 1]]
+     set val_index [string first "=" $text]
+     incr val_index
+     return [string trim [string range $text $val_index end]]
 }
 
 # Sets motor position reading to pos by adjusting the softzero
@@ -526,19 +527,19 @@ proc ::utility::set_envcontrol_attributes {} {
 # Retuns plain value of hdb node property
 proc ::utility::hgetplainprop {hpath prop} {
   if [ catch {
-    return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ]
+    set propStr [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ]
   } message ] {
-    if {$::errorCode=="NONE"} {return $message}
-    return -code error $message
+    return -code error "([info level 0]) $message"
   }
+  return $propStr
 }
 proc ::utility::hlistplainprop {hpath} {
   if [ catch {
-    return [string trim [join [split [string map {" " _} [regsub {[^
+    set propStr [string trim [join [split [string map {" " _} [regsub {[^
 ]*= *
-} [hlistprop $hpath] {} ]] =] ]]
-  } message ] {
+} [hlistprop $hpath] {} ]] =] ]]
   } message ] {
+    return -code error "([info level 0]) $message"
   }
   return $propStr
 }
@@ -635,7 +636,7 @@ proc ::utility::check_valid_options {arglist valid_options} {
         error "ERROR: $opt is an invalid option. It should be one of $valid_options"
       }
     }
-  } message ] {
+  } message ] {
     if {$::errorCode=="NONE"} {return $message}
     return -code error "([info level 0]) $message"
   }
@@ -661,7 +662,7 @@ proc ::utility::check_required_options {arglist required_options} {
         error "ERROR: Required option $req_opt is missing"
       }
     }
-  } message ] {
+  } message ] {
     if {$::errorCode=="NONE"} {return $message}
     return -code error "([info level 0]) $message"
   }