#-----------------------------------------------------------------------------
# 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}
    }
}
#-------------------------------------------------------------------------
# syntaxLoadSICS loads a SICS status file. The trick is to ignore all
# errors because the syntax checker may not have all commands implemented
#-------------------------------------------------------------------------
proc syntaxLoadSICS {fname} {
    set f [open $fname r]
    while { [gets $f line] > 0} {
	set ret [catch {eval $line} msg]
#	if { $ret != 0} {
#	    puts stdout "ERROR in: $line"
#	}
    }
    close $f
}
#-------------------------------------------------------------------------
# syntaxLimit checks if a parameter violates a limit
#------------------------------------------------------------------------
proc syntaxLimit {var val} {
    global sicsPar
    
#-------- fixed?
    if { [info exists sicsPar($var.fixed)] } {
	set lim $sicsPar($var.fixed)
	if { $lim > 0 } {
	    error "ERROR: $var is fixed"
	}
    }

#--------- lower limit?
    set lim shit
    if { [info exists sicsPar($var.softlowerlim)] } {
	set lim $sicsPar($var.softlowerlim)
    }
    if { [info exists sicsPar($var.lowerlimit)] } {
	set lim $sicsPar($var.lowerlimit)
    }
    if { [syntaxNumeric $lim] == 1} {
	if { $val < $lim} {
	    error "ERROR: lower limit $lim violated by $val for $var"
	}
    }
#------------ upper limit?
    set lim shit
    if { [info exists sicsPar($var.softupperlim)] } {
	set lim $sicsPar($var.softupperlim)
    }
    if { [info exists sicsPar($var.upperlimit)] } {
	set lim $sicsPar($var.upperlimit)
    }
    if { [syntaxNumeric $lim] == 1} {
	if { $val > $lim} {
	    error "ERROR: upper limit $lim violated by $val for $var"
	}
    }
}
#---------------------------------------------------------------------------
# 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} {
}
#---------------------------------------------------------------------------
# syntaxWarn is a syntax checking procedure which does nothing. This is a
# quick fix for SICS commands for which no syntax checking procedure has not
# yet been defined or makes no sense. This version warns about it.
#-------------------------------------------------------------------------
proc syntaxWarn {name args} {
    puts stdout "INFO: Syntax for $name not checked"
    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} {
	 if { [string first setaccess [string tolower [lindex $args 0]]] < 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} {
	    if { [string first setaccess \
		      [string tolower [lindex $args 0]]] < 0} {
		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]
    }
}
#--------------------------------------------------------------------------
# syntaxMtor 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 accesscode

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
#---------------------------------------------------------------------------
lappend cterKey interest uninterest stop send

proc syntaxCounter {name args} {
    global cterKey sicsPar

    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]]]
#------ test keyWords
    if { [lsearch $cterKey $subcommand] >= 0} {
	return
    }
#------- the rest
    switch $subcommand {
    count -
    countnb { 
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to count/coutnb"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to count/countb"
	}
	return
    }
    getpreset {
	return [syntaxGet $name.preset]
    }
    getexponent {
	return [syntaxGet $name.exponent]
    }
    gettime {
	return [format "%s.time = 77" $name]
    }
    getcounts {
	return [format "%s.counts = {77 77 77 77 77}" $name]
    }
    getthreshold {
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to getthreshold"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to getthreshold"
	}
	return [syntaxGet $name.threshold]
    }
    getmonitor {
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to getmonitor"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to getmonitor"
	}
	return "$name.monitor 1 = 77"
    }
    status {
	return "counter.status = 77 77 77"
    }
    setmode {
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to getthreshold"
	}
	if { [syntaxCounterMode [lindex $args 1]] == 0} {
	    error [format "ERROR: invalid counter mode: %s" \
		    [lindex $args 1]]
	}
	return
    }
    setpreset {
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to setpreset"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to setpreset"
	}
	return
    }
    setexponent {
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to setexponent"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to setexponent"
	}
	return
    }
    mode {
	if { [llength $args] <2} {
	    return [syntaxGet $name.mode]
	} else {
	    if { [syntaxCounterMode [lindex $args 1]] == 0} {
		error [format "ERROR: invalid counter mode: %s" \
			[lindex $args 1]]
	    }
	    set sicsPar($name.mode) [lindex $args 1]
	    return
	}
    }
    preset {
	if { [llength $args] <2} {
	    return [syntaxGet $name.preset]
	} else {
	    if { [syntaxNumeric [lindex $args 1]] == 0} {
		error [format "ERROR: iexpected numeric preset, got : %s" \
			[lindex $args 1]]
	    }
	    set sicsPar($name.preset) [lindex $args 1]
	    return
	}
    }
    getthreshold {
	if { [llength $args] < 2} {
	    error "ERROR: missing argument to getthreshold"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to getthreshold"
	}
	return "$name.threshold = 77"
    }
    setthreshold {
	if { [llength $args] < 3} {
	    error "ERROR: missing argument to setthreshold"
	}
	if {[syntaxNumeric [lindex $args 1]] == 0 } {
	    error "ERROR: expected numeric argument to setthreshold"
	}
	if {[syntaxNumeric [lindex $args 2]] == 0 } {
	    error "ERROR: expected numeric argument to setthreshold"
	}
	return
    }
    default {
	error "ERROR: subcommand $subcommand to counter not known"
    }
    }
}
#---------------------------------------------------------------------------
# The syntax handler for SICS histogram memories
#--------------------------------------------------------------------------
lappend hmKey count countf interest uninterest init countblock clearbin
lappend hmConf dim0 dim1 binwidth rank overflowmode histmode xfac yfac
lappend hmConf xfrac yfrac hmcomputer hmport counter init 

proc syntaxHM {name args} {
    global hmKey hmConf sicsPar

    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]]]
#------ test keyWords
    if { [lsearch $hmKey $subcommand] >= 0} {
	return
    }
    switch $subcommand {
	preset {
	    if { [llength $args] <2} {
		return [syntaxGet $name.preset]
	    } else {
		if { [syntaxNumeric [lindex $args 1]] == 0} {
		    error [format "ERROR: iexpected numeric preset, got : %s" \
			    [lindex $args 1]]
		}
		set sicsPar($name.preset) [lindex $args 1]
		return
	    }
	}
	exponent {
	    if { [llength $args] <2} {
		return [syntaxGet $name.exponent]
	    } else {
		if { [syntaxNumeric [lindex $args 1]] == 0} {
		    error [format "ERROR: expected numeric exponent, got : %s"\
			    [lindex $args 1]]
		}
		set sicsPar($name.exponent) [lindex $args 1]
		return
	    }
	}
	countmode -
	mode {
	    if { [llength $args] <2} {
		return [syntaxGet $name.mode]
	    } else {
		if { [syntaxCounterMode [lindex $args 1]] == 0} {
		    error [format "ERROR: invalid counter mode: %s" \
			    [lindex $args 1]]
		}
		set sicsPar($name.mode) [lindex $args 1]
		return
	    }
	}
	get -
	uuget -
	zipget {
	    for { set i 1} { $i < [llength $args]} {incr i} {
		if { [syntaxNumeric [lindex $args $i]] == 0} {
		    error \
	             [format "ERROR: expected numeric hm argument, got %s"\
		     [lindex $args $i]]
 
		}
	    }
	    return
	}
	genbin {
	    if { [llength $args] < 4 } {
		error "ERROR: insufficient number of argument to hm genbin"
	    } 
	    for { set i 1} { $i < 4} { incr i} {
		if { [syntaxNumeric [lindex $args $i]] == 0} {
		    error \
	             [format "ERROR: expected numeric hm argument, got %s"\
		     [lindex $args $i]]
 
		}
	    }
	}
	notimebin {
	    return "$name.notimebin = 77"
	}
	timebin {
	    return "histogram.timebins = 77 77 77 77 77 77"
	}
	setbin {
	    if { [llength $args] < 3 } {
		error "ERROR: insufficient number of argument to hm setbin"
	    } 
	    for { set i 1} { $i < 3} { incr i} {
		if { [syntaxNumeric [lindex $args $i]] == 0} {
		    error \
	             [format "ERROR: expected numeric hm argument, got %s"\
		     [lindex $args $i]]
 
		}
	    }
	}
	sum {
	    return
	}
	configure {
	    if { [llength $args] < 2} {
		error "ERROR: insufficient number of arguments to hm configure"
	    }
	    set opt [string trim [string tolower [lindex $args 1]]]
	    if { [lsearch $hmConf $opt] < 0} {
		error "ERROR: configuration option $opt not known"
	    }
	    return
	}
	default {
	    error "ERROR: subcommand $subcommand to hm not known"
	}
    }
}
#-----------------------------------------------------------------------------
# a syntax handler for environment controllers
#-----------------------------------------------------------------------------
lappend evKey send interest uninterest list
lappend evPar tolerance access errorHandler interrupt upperlimit lowerlimit
lappend evPar safevalue maxwait settle ramp

proc evSyntax {name args} {
    global sicsPar evKey evPar

    set args [syntaxListify $args]
#------ no subcommand: get value
    if { [llength $args] == 0} {
	return [syntaxGet $name]
    } 
    set subcommand [string trim [string tolower [lindex $args 0]]]
#-------- numeric subcommand: drive!
    if { [syntaxNumeric $subcommand] == 1} {
	set sicsPar($name) $subcommand
	return
    }
#--------- keywords
    if { [lsearch $evKey $subcommand] >= 0} {
	return
    }
#---------- parameters
    if { [lsearch $evPar $subcommand] < 0} {
	error [format "ERROR: evcontroller %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]
	}
    }
}
#----------------------------------------------------------------------------
# the syntax drive command
#---------------------------------------------------------------------------
proc syntaxDrive {name args} {
    global sicsPar

    set args [syntaxListify $args]
    if { [llength $args] < 2 } {
	error "insufficient number or arguments for $name"
    }
    for {set i 0} {$i < [llength $args]} {set i [expr $i + 2]} {
	set ret [catch {info body [lindex $args $i]} msg]
	if { $ret != 0 } {
	    error [format "ERROR: no %s to %s found" $name [lindex $args $i]]
	}
	if { [syntaxNumeric [lindex $args [expr $i + 1]]] != 1 } {
	    error [format "ERROR: expected numeric %s target, got %s" \
		    $name [lindex $args [expr $i +1]]]
	}
	syntaxLimit [lindex $args $i] [lindex $args [expr $i + 1]]
	set sicsPar([lindex $args $i]) [lindex $args [expr $i + 1]]
    }
}
#--------------------------------------------------------------------------
# The syntax count command
#--------------------------------------------------------------------------
set countSum 0
set countSavedPreset 1
#------------------------------------------------------------------------
proc count { {mode  NULL } { preset NULL } } {
    global countSum countSavedPreset
    set m [string trim [string tolower $mode]]
    if { [string compare $m null] == 0} {
	return
    } else {
	set c [string index $mode 0]
	if { [regexp \[mt\] $c] != 1 } {
	    error "ERROR: invalid counter mode $m specified for count"
	}
    }
    set p [string trim [string tolower $preset]]
    if { [string compare $p null] == 0} {
	set countSum [expr $countSum + $countSavedPreset]
	return
    } else {
	if {[syntaxNumeric $p] != 1 } {
	    error "ERROR: count expected numeric preset, got $p"
	}
	set countSum [expr $countSum + $p]
	set countSavedPreset $p
    }
}
#---------------------------------------------------------------------------
# The co command, same syntax as count though functionally different
#---------------------------------------------------------------------------
proc co { {mode NULL} {prest NULL} } {
    count $mode $prest
}
#---------------------------------------------------------------------------
# the syntax repeat command
#---------------------------------------------------------------------------
proc repeat { num {mode  NULL} {preset NULL} }  {
    global countSum countSavedPreset
    if { [syntaxNumeric $num] != 1 } {
	error "ERROR: expected numeric repeat count, got $num"
    }
    set m [string trim [string tolower $mode]]
    if { [string compare $m null] == 0} {
	return
    } else {
	set c [string index $mode 0]
	if { [regexp \[mc\] $c] != 1 } {
	    error "ERROR: invalid counter mode $m specified for count"
	}
    }
    set p [string trim [string tolower $preset]]
    if { [string compare $p null] == 0} {
	set countSum [expr $countSum + $num*$countSavedPreset]
	return
    } else {
	if {[syntaxNumeric $p] != 1 } {
	    error "ERROR: count expected numeric preset, got $p"

	}
	set countSum [expr $countSum + $num*$p]
	set countSavedPreset $p
    }
}
#----------------------------------------------------------------------------
# The scan commands for the syntax checker
#----------------------------------------------------------------------------
proc cscan { var center delta np preset } {

	set ret [catch {info body $var} msg]
	if { $ret != 0 } {
	    error [format "ERROR: no %s to scan found" $var]
	}
	if { [syntaxNumeric $center] != 1} {
	    error "ERROR: $center is no number, expected scan center"
	}
	if { [syntaxNumeric $delta] != 1} {
	    error "ERROR: $delta is no number, expected scan step"
	}
	if { [syntaxNumeric $np] != 1} {
	    error "ERROR: $np is no number, expected scan noPoints"
	}
	if { [syntaxNumeric $preset] != 1} {
	    error "ERROR: $preset is no number, expected scan preset"
	}
	set val [expr $center - ($np/2) *$delta]
	syntaxLimit $var $val
	set val [expr $center + ($np/2)*$delta]
	syntaxLimit $var $val
}
#---------------------------------------------------------------------------
proc sscan args {
    set lang [llength $args]
    if { $lang < 5} {
	error "ERROR: not enough arguments to sscan"
    }
#-------- last two: np, preset
    set val [lindex $args [expr $lang - 1]]
    if { [syntaxNumeric $val] != 1} {
	error "ERROR: expected numeric preset, got $val"
    }
    set val [lindex $args [expr $lang - 2]]
    if { [syntaxNumeric $val] != 1} {
	error "ERROR: expected numeric NP, got $val"
    }
    set np $val
#-------- from start: var start step sequences
    for {set i 0} { $i < [expr $lang - 2]} { set i [expr $i + 3]} {
	set var [string trim [string tolower [lindex $args $i]]]
	set ret [catch {info body $var} msg]
	if { $ret != 0 } {
	    error [format "ERROR: no %s to scan found" $var]
	}
	set start [lindex $args [expr $i + 1]]
	if { [syntaxNumeric $start] != 1} {
	    error "ERROR: $start is no number, expected scan start"
	}
	set step [lindex $args [expr $i + 2]]
	if { [syntaxNumeric $step] != 1} {
	    error "ERROR: $step is no number, expected scan step"
	}
	syntaxLimit $var $start
	set val [expr $start + $np * $step]
	syntaxLimit $var $val
    }
}
#------------------------------------------------------------------------
# The main scan object
#------------------------------------------------------------------------
proc scan args {
    global sicsPar

    if { [llength $args] < 1} {
	error "ERROR: need subcommand for scan"
    }
    set subcommand [string trim [string tolower [lindex $args 0]]]
    switch $subcommand {
	info -
	getvars -
	xaxis -
	cinterest -
	uuinterest -
	pinterest -
	file -
	list -
	clear -
	getcounts -
	run -
	recover -
	forceclear {
	    return
	}
	np -
	preset -
	setchannel {
	    if { [llength $args] > 1} {
		set val [lindex $args 1]
		if { [syntaxNumeric $val] != 1} {
		    error ERROR: expected numeric arg to $subcommand, got $val
		}
		set sicsPar(scan.$subcommand) $val
	    } else {
		return [syntaxGet scan.$subcommand]
	    }
	}
	var {
	    if { [llength $args] < 4} {
		error "ERROR: not enough arguments for scan var"
	    }
	    set var [lindex $args 1]
	    set ret [catch {info body $var} msg]
	    if { $ret != 0 } {
		error [format "ERROR: no %s to scan found" $var]
	    }
	    set val [lindex $args 2]
	    if { [syntaxNumeric $val] != 1} {
		error "ERROR: expected number for start, got $val"
	    }
	    set val [lindex $args 3]
	    if { [syntaxNumeric $val] != 1} {
		error "ERROR: expected number for step, got $val"
	    }
	}
	mode {
	    if { [llength $args] > 1} {
		set val [lindex $args 1]
		if { [syntaxCounterMode $val] != 1} {
		    error ERROR: expected counter mode, got $val
		}
		set sicsPar(scan.mode) $val
	    } else {
		return [syntaxGet scan.mode]
	    }
	}
	default {
	    error "ERROR: subcommand $subcommand to scan not known"
	}
    }
}
#------------------------------------------------------------------------
# optimiseSyntax: The syntax for the optimize command
#-----------------------------------------------------------------------
lappend optiPar maxcycles threshold channel preset

proc optiSyntax {name args} {
    global optiPar
 
    set args [syntaxListify $args]
    if { [llength $args] < 1} {
	error "ERROR: need subcommand for optimise"
    }
    set subcommand [string trim [string tolower [lindex $args 0]]]
    if { [lsearch $optiPar $subcommand] >= 0} {
	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
		return
	    }
	} else {
	    return [syntaxGet $name.$subcommand]
	}
    }
    switch $subcommand {
	addvar {
	    if { [llength $args] < 5} {
		error "ERROR: not enough arguments to addvar"
	    }
	    set var [string trim [string tolower [lindex $args 1]]]
	    set ret [catch {info body $var} msg]
	    if { $ret != 0 } {
		error [format "ERROR: no %s to optimise found" $var]
	    }
	    for { set i 2} {$i < [llength $args]} {incr i} {
		set val [lindex $args $i]
		if { [syntaxNumeric $val] != 1} {
		    error "ERROR: expected numeric par to opti, got $val"
		}
	    }
	}
	clear -
	run { return}
	countmode {
	    if { [llength $args] > 1} {
		set val [lindex $args 1]
		if { [syntaxCounterMode $val] != 1} {
		    error ERROR: expected counter mode, got $val
		}
		set sicsPar(opti.mode) $val
	    } else {
		return [syntaxGet opti.mode]
	    }
	}
	default {
	    error "ERROR: optimiser does not know about subcommand $subcommand"
	}
    }
}
#-------------------------------------------------------------------------
# mumoSyntax: the syntax for SANS style multi motors
# The aliases must be set in sicsPar(multimotorname.alias) during setup
# in order for this to find them
# Also sicsPar(multimotorname.nampos) has to be initialised to [list back] 
#------------------------------------------------------------------------
proc mumoSyntax {name args} {
    global sicsPar

    set args [syntaxListify $args]
    if { [llength $args] == 0} {
	return
    }
    set subcommand [string trim [string tolower [lindex $args 0]]]
#---------check named position
    if {[lsearch $sicsPar($name.nampos) $subcommand] >= 0} {
	return
    }
    switch $subcommand {
	list {
	    return
	}
	pos -
	recovernampos {
	    if { [llength $args] < 2} {
		error "ERROR: not enough args to $subcommand"
	    }
	    set nam [string trim [string tolower [lindex $args 1]]]
	    if { [lsearch $sicsPar($name.nampos) $nam] < 0} {
		lappend sicsPar($name.nampos) $nam 
	    }
	    return
	}
	drop {
	    if { [llength $args] < 2} {
		error "ERROR: not enough args to $subcommand"
	    }
	    set nam [string trim [string tolower [lindex $args 1]]]
	    if { [string compare $name all] == 0} {
		set sicsPar($name.nampos) [list back]
	    } else {
		set ind [lsearch $sicsPar($name.nampos) $nam]
		if { $ind >= 0} {
		    set sicsPar($name.nampos) \
			    [lreplace $sicsPar($name.nampos) $ind $ind]
		} else {
		    puts stdout "INFO: failed to drop $nam"
		}
	    }
	    return
	}
    }
#------------------ now it can only be the alias syntax
# but we have to wash away all =,+,- first before we can analyze it
    set aliastxt [string trim [string tolower [join $args]]]
    set word 1
    set length [string length $aliastxt]
    for {set i 0} { $i < $length} {incr i} {
	set c [string index $aliastxt $i]
	if { [regexp \[=+-\] $c] == 1} {
#	    puts stdout "Discovered +=- $c" 
	    if { $word == 1} {
		append washedTxt " "
		set word 0
	    } 
	    continue
	}
	if { [string match {\ } $c] == 1} {
#	    puts stdout "Discovered white space $c"
	    if { $word == 1} {
		append washedTxt $c
		set word 0
	    } 
	    continue
	}
#	puts stdout "Discovered $c"
	append washedTxt $c
	set word 1
    }
#    puts stdout $washedTxt
#------- now we should have aliases followed by numbers only
    set args [split $washedTxt]
    for { set i 0} { $i < [llength $args]} { set i [expr $i +2]} {
	set var [lindex $args $i]
	if { [lsearch $sicsPar($name.alias) $var] < 0} {
	    error "ERROR: alias $var does not exist in $name"
	}
	set val [lindex $args [expr $i + 1]]
	if { [syntaxNumeric $val] != 1 } {
	    error "ERROR expected numeric target, got $val"
	}
    }
}
#--------------------------------------------------------------------------
# The wait operation
#--------------------------------------------------------------------------
proc wait {time} {
    if { [syntaxNumeric $time] != 1} {
	error "ERROR: expected numeric wait time, got $time"
    }
}
#--------------------------------------------------------------------------
# fileeval. Fileeval checks for loops in command
# files. This is no error but a usage feature
#--------------------------------------------------------------------------
lappend fileList grrrmmmpffff

proc fileeval {name} {
    global fileList
    set f [file tail $name]
    if { [lsearch $fileList $f] >= 0} {
	puts stdout "INFO: Command file loop detected!"
	return
    } else {
	lappend fileList $f
	source $name
    }
}
#--------------------------------------------------------------------------
# batchrun
#--------------------------------------------------------------------------
proc batchrun {name} {
    global sicsPar
    fileeval $sicsPar(batchroot)/$name
}
#---------------------------------------------------------------------------
# The sp command for setting zero points
#--------------------------------------------------------------------------
proc sp {axis value} {
    set axis [string tolower [string trim $axis]]
    set ret [catch {info body $axis]} msg]
    if { $ret != 0 } {
	error [format "ERROR: no %s to zero found" $axis]
    }
    if { [syntaxNumeric $value] != 1 } {
	    error [format "ERROR: expected numeric zero target, got %s" \
		    $name $value]
    }
}
#--------------------------------------------------------------------------
# The psdconfigure command 4 TRICS and AMOR
#--------------------------------------------------------------------------
proc psdconfigure {hm xSize ySize} {
    set ret [catch {info body $hm} msg]
    if { $ret != 0 } {
	error [format "ERROR: $hm to configure not found!" $hm]
    }
    if { [syntaxNumeric $xSize] != 1 } {
	error "ERROR: expected numeric xSize, got $xSize"
    }
    if { [syntaxNumeric $ySize] != 1 } {
	error "ERROR: expected numeric ySize, got $ySize"
    }
} 
#------------------------------------------------------------------------
# The histogram memory control syntax
#-----------------------------------------------------------------------
proc hmcSyntax {name args} {
    set args [syntaxListify $args]
    if { [llength $args] < 2} {
	error "ERROR: missing argumnets to $name"
    }
    set p [lindex $args 0]
    if { [syntaxNumeric $p] != 1} {
	error "ERROR: expected numeric preset for $name, got $p" 
    } 
    set p [string trim [string tolower [lindex $args 1]]]
    if { [syntaxCountMode $p] != 1} {
	error "ERROR: invalid count mode $p for $name" 
    } 
}
#-------------------------------------------------------------------------
# The syntax for the fourcircle calculation module
#--------------------------------------------------------------------------
lappend hklKey list current
lappend hklPar lambda hm

proc syntaxHKL {name args} {
    global hklKey hklPar

    set args [syntaxListify $args]

    if { [llength $args] < 1} {
	error "ERROR: no subcommand to $name"
    }
    set subcommand [string trim [string tolower [lindex $args 0]]]
#-------- check keyword commands
    if { [lsearch $hklKey $subcommand]  >= 0} {
	return
    }
#-------- check parameter commands
    if { [lsearch $hklPar $subcommand] >= 0} {
	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]
	}
    }
#------------ check the rest
    switch $subcommand {
	calc -
	drive -
	run {
	    if { [llength $args] < 4} {
		error "ERROR: insufficient no args to $name calc,drive,run"
	    }
	    for { set i 1} { $i < [llength $args]} { incr i} {
		set val [lindex $args $i]
		if { [syntaxNumeric $val] != 1} {
		    error "ERROR: expected numeric argument, got $val"
		}
	    } 
	}
	nb -
	quadrant {
	    if { [llength $args] < 2} {
		error "ERROR: insufficient no args to $name nb, quadrant"
	    }
	    set val [lindex $args 1]
	    if { [syntaxNumeric $val] != 1} {
		error \
		"ERROR: expected numeric argument ot nb, quadrant, got $val"
	    }
	}
	setub {
	    if { [llength $args] < 10 } {
		error "ERROR: insufficient no args to $name setub"
	    }
	    for { set i 1} { $i < [llength $args]} { incr i} {
		set val [lindex $args $i]
		if { [syntaxNumeric $val] != 1} {
		    error "ERROR: expected numeric argument, got $val"
		}
	    } 
	}
	default {
	    error "ERROR: $name does not know subcomand $subcommand"
	}
    }
}
#---------------------------------------------------------------------------
# syntax for xytables as used at SANS
#---------------------------------------------------------------------------
proc syntaxXY {name args} {
    set args [syntaxListify $args]
    if { [llength $args] < 1} {
	error "ERROR: expected argument to $name"
    }
    set subcommand [string tolower [string trim [lindex $args 0]]]
    switch $subcommand {
	clear -
	list -
	uuget {return}
	write {
	    if { [llength $args] < 2} {
		error "ERROR: missing file name for $name write"
	    }
	    return
	}
	add {
	    if { [llength $args] < 3} {
		error "ERROR: missing values for $name add"
	    }
	    for { set i 1} { $i < 3} {incr i} {
		set val [string trim [lindex $args $i]]
		if { [syntaxNumeric $val] != 1} {
		    error "ERROR: expected numeric arg to $name add, got $val"
		}
	    }
	}
	default {
	     error "ERROR: subcommand $subcommand to $name not recognized"
	}
    }
}
#--------------------------------------------------------------------------
# Syntax check for the exe batch manager
#--------------------------------------------------------------------------
lappend exeFileList grrrrrrrmmmppppppppfffffff

proc checkExeBuffer {buffer} {
    global exeFileList
    if { [string compare [string index $buffer 0] "/"] == 0 } {
	set name [file tail $buffer]
    } else {
	set name buffer
    }
    if { [lsearch $exeFileList $buffer] >= 0} {
	puts stdout "INFO: Command file loop detected!"
	return
    }
}
#-------------------------------------------------------------------------
proc exe args {
    global sicsPar
    if { [llength $args] < 1} {
	error "ERROR: exe needs at least one argument"
    }
    set key [lindex $args 0]
    set key [string tolower $key]
    switch $key {
	syspath {
	    if { [llength $args] > 1} {
		set sicsPar(exe.syspath) [lindex $args 1]
	    } else {
		return [syntaxGet exe.syspath]
	    }
	}
	batchpath {
	    if { [llength $args] > 1} {
		set sicsPar(exe.batchpath) [lindex $args 1]
	    } else {
		return [syntaxGet exe.batchpath]
	    }
	}
	print -
	info -
	enqueue -
	clear -
	run -
	interest -
	queue {}
	default {
	    checkExeBuffer $key
	}
    }
}
#---------------------------------------------------------------------------
# Mappings for some common SICS commands and variables
#---------------------------------------------------------------------------
sicsSyntaxMap clientput syntaxDummy 
sicsSyntaxMap ClientPut syntaxDummy 
sicsSyntaxMap success   syntaxDummy
sicsSyntaxMap drive     syntaxDrive
sicsSyntaxMap run       syntaxDrive
sicsSyntaxMap peak      syntaxDummy
sicsSyntaxMap center    syntaxDummy
sicsSyntaxMap batchroot syntaxTextPar
sicsSyntaxMap sicstime  syntaxDummy