- Added code to read SANS TOF frames from a) files and b) from HM
- Fixed an bug causing core dumps on bad Tcl scripts - Started on a syntax checker for SICS
This commit is contained in:
cvs
168
utils/check/sicssyntaxlib.tcl
Normal file
168
utils/check/sicssyntaxlib.tcl
Normal file
@@ -0,0 +1,168 @@
|
||||
#-----------------------------------------------------------------------------
|
||||
# This is the library file for the Tcl syntax checker for SICS commands.
|
||||
# The basic idea is this:
|
||||
# - SICS commands are replaced by Tcl procedures with the same name which
|
||||
# implement the actual syntax check for this command.
|
||||
# - As many SICS commands are object commands a facility is needed to map
|
||||
# syntax checking procedures to names.
|
||||
#
|
||||
# copyright: see file COPYRIGHT
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#---------------------------------------------------------------------------
|
||||
# sicsSyntaxMap maps the procedure syntaxProc to the name name. The name
|
||||
# is prepended to the argument list in order to make the name available
|
||||
# in the syntax checking procedure as the first argument
|
||||
# This means syntax check procedures have two arguments:
|
||||
# - the name
|
||||
# - the list of remaining parameters as a string. Use syntaxListify
|
||||
# to convert the list to a proper list for further processing
|
||||
#---------------------------------------------------------------------------
|
||||
proc sicsSyntaxMap {name syntaxProc} {
|
||||
append newProc "proc " $name " args " \{ $syntaxProc " "
|
||||
append newProc $name " " "\$args" \}
|
||||
eval $newProc
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# a helper procedure which tests a value if it is numeric
|
||||
#--------------------------------------------------------------------------
|
||||
proc syntaxNumeric {val} {
|
||||
set ret [catch {expr $val *1.} msg]
|
||||
if { $ret == 0} {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# a helper procedure which converts a stringified list back into a proper
|
||||
# list
|
||||
#--------------------------------------------------------------------------
|
||||
proc syntaxListify {uff} {
|
||||
set l [string trim $uff "{}"]
|
||||
return [split $l]
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# a helper procedure which gets a parameter from the global parameter
|
||||
# array or replaces it by the default 77 if it does not exist
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxGet {name} {
|
||||
global sicsPar
|
||||
if { [info exists sicsPar($name)] == 1} {
|
||||
return [format "%s = %s" $name \
|
||||
$sicsPar($name)]
|
||||
} else {
|
||||
return [format " %s = 77" $name]
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# syntaxCounterMode tests if par is a valid counter mode
|
||||
#-----------------------------------------------------------------------
|
||||
proc syntaxCounterMode {par} {
|
||||
set p [string trim [string tolower $par]]
|
||||
switch $p{
|
||||
monitor { return 1}
|
||||
timer {return 1}
|
||||
default { return 0}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxDummy is a syntax checking procedure which does nothing. This is a
|
||||
# quick fix for SICS commands for which no syntax checking procedure has yet
|
||||
# been defined.
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxDummy {name args} {
|
||||
set args [syntaxListify $args]
|
||||
return
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
# syntaxTextPar is a syntax handling procedure for simple text variables
|
||||
#----------------------------------------------------------------------
|
||||
proc syntaxTextPar {name args} {
|
||||
global sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] > 0} {
|
||||
set sicsPar($name) [join $args]
|
||||
} else {
|
||||
if { [info exists sicsPar($name)] == 1} {
|
||||
return [format "%s = %s" $name \
|
||||
$sicsPar($name)]
|
||||
} else {
|
||||
return [format " %s = UNKNOWN" $name]
|
||||
}
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# syntaxNumPar is a syntax handling procedure for a numeric variable
|
||||
#-----------------------------------------------------------------------
|
||||
proc syntaxNumPar {name args} {
|
||||
global sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] > 0} {
|
||||
if { [syntaxNumeric [lindex $args 0]] == 1} {
|
||||
set sicsPar($name) [lindex $args 0]
|
||||
} else {
|
||||
error [format \
|
||||
"ERROR: expected numeric argument for %s, received: %s" \
|
||||
$name [lindex $args 0]]
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name]
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# syntaxMotor handles the syntax for a SICS motor
|
||||
#-------------------------------------------------------------------------
|
||||
lappend motSubKey list reset interest uninterest position hardposition
|
||||
lappend motSub hardlowerlim hardupperlim softlowerlim
|
||||
lappend motSub softupperlim softzero fixed interruptmode precision
|
||||
lappend motSub accessmode sign failafter
|
||||
|
||||
proc syntaxMotor {name args} {
|
||||
global sicsPar motSub motSubKey
|
||||
|
||||
set args [syntaxListify $args]
|
||||
#----- value request
|
||||
if { [llength $args] == 0} {
|
||||
return [syntaxGet $name]
|
||||
}
|
||||
#---------- keywords
|
||||
set subcommand [string tolower [lindex $args 0]]
|
||||
if { [lsearch $motSubKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
#---------- parameters
|
||||
if { [lsearch $motSub $subcommand] < 0} {
|
||||
error [format "ERROR: motor %s does not know subcommand %s" \
|
||||
$name $subcommand]
|
||||
} else {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxCounter deals with the syntax for a single counter
|
||||
#---------------------------------------------------------------------------
|
||||
proc syntaxCounter {name args} {
|
||||
global sicsPar motSub motSubKey
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args == 0} {
|
||||
error [format "ERROR: subcommand expected to %s" $name]
|
||||
}
|
||||
#--------- get command
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
switch $subcommand {
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user