#----------------------------------------------------------------------------- # 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 { } }