sics/utils/check/sicssyntaxlib.tcl

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