# Wrapper routines for et_wish
#   Include error handling


# The following is for testing:

# set name Xorbit:P1H1:CurrentAO
# set names {Xorbit:P1H1:CurrentAO Xorbit:P1H2:CurrentAO}
# set badname Xorbit:P1H1:CurrentAA
# set badnames {Xorbit:P1H1:CurrentAA Xorbit:P1H2:CurrentAO}
# set badnames1 {Xorbit:P1H1:CurrentAO Xorbit:P1H2:CurrentAA}
# set badnames2 {Xorbit:P1H1:CurrentAA Xorbit:P1H2:CurrentAA}

if {[string compare [info procs errmsg] ""] == 0} {
    # **************************** errmsg **********************************
    proc errmsg {string} {
	# Default error message
	puts stderr [format "et.tcl: %s" $string]
    }
}
# **************************** pvcmon **********************************
proc pvcmon {_var} {
# _var is a list of variables that have been linked
# Returns 0 (False) for failure and 1 (True) for success

    global errorCode

    global $_var
    set _err [pv cmon "$_var"]
    if {$_err != 0} {
	if {[llength $_var] < 4} {
	    set _errname $_var
	} else {
	    set _errname "[lrange $_var 0 2] ..."
	}
	errmsg "Clearing a monitor for $_errname failed:\n$errorCode"
    }
    return [expr ! $_err]
}
# **************************** pvget ***********************************
proc pvget {_var} {
# _var is a list of variables that have been linked
# Returns list of values

    global errorCode

    global $_var
    if {[pv getw "$_var"] != 0} {
	if {[llength $_var] < 4} {
	    set _errname $_var
	} else {
	    set _errname "[lrange $_var 0 2] ..."
	}
	errmsg "Getting a value for $_errname failed\n$errorCode"
	return Error
    }
# Make return value list and set each variable
    set len [llength $_var]
    set returnval ""
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem [lindex $_var $_ii]
	global $_varelem
	set returnval [linsert $returnval end [set $_varelem]]
	set $_varelem [set $_varelem]
    }
# Return the result
    return $returnval
}
# **************************** pvinfo **********************************
proc pvinfo {_var {pvinfolist "NotGiven"}} {
# _var is a list of variables that have been linked
# infolist is a list of the possible info names, like "state"
# Returns a list of lists, one list for each variable
#   The first element in each list is the variable name
#   The other elements are the values for each info name,
#      in the order specified

    global errorCode

#    if {![string compare $_var ""]} {
#	errmsg "Must do Search first!"
#	return
#    }
    global $_var
    if {[string compare "$pvinfolist" "NotGiven"] == 0} {
	set pvinfolist {state severity status time units name choices \
		       hopr lopr hihi hi lolo lo precision ioc access size}
    }
    set pvinfo [pv info "$_var" $pvinfolist]
    return $pvinfo
}
# **************************** pvlink **********************************
proc pvlink {_var name} {
# _var is a list of variables to be linked
# name is a list of PV names
# Returns 0 (False) for failure and 1 (True) for success

    global errorCode

    set len [llength $_var]
    set lenn [llength $name]
    if {$len != $lenn} {
	errmsg "Variable list and name list must be same length"
	return 0
    }
    global $_var
    set _err [pv linkw "$_var" "$name"]
    if {$_err != 0} {
	if {[llength $_var] < 4} {
	    set _errname $_var
	} else {
	    set _errname "[lrange $_var 0 2] ..."
	}
	errmsg "Making a link for $_errname failed\n$errorCode"
    }
    return [expr ! $_err]
}
# **************************** pvmon ***********************************
proc pvmon {_var} {
# _var is a list of variables that have been linked
# Returns 0 (False) for failure and 1 (True) for success

    global errorCode

    global $_var
    set _err [pvget $_var]
    if {[string compare $_err Error] == 0} {return 0}
    set _err [pv mon "$_var" {set _var "$_var"}]
    if {$_err != 0} {
	if {[llength $_var] < 4} {
	    set _errname $_var
	} else {
	    set _errname "[lrange $_var 0 2] ..."
	}
	errmsg "Setting a monitor for $_errname failed:\n$errorCode"
    }
    return [expr ! $_err]
}
# **************************** pvput ***********************************
proc pvput {_var _val} {
# _var is a list of variables that have been linked
# _val is a list of values to be set
# Returns list of the actual values after setting is finished

    global errorCode

    global $_var
# Set values into each variable
    set len [llength $_var]
    set lenv [llength $_val]
    if {$len != $lenv} {
	errmsg "Variable list and value list must be same length"
	return "Error"
    }
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem [lindex $_var $_ii]
	global $_varelem
	set $_varelem [lindex $_val $_ii]
    }
    if {[pv putw "$_var"] != 0} {
	errmsg "Setting a value for $_var failed\n$errorCode"
	return ""
    }
    return [pvget $_var]
}
# **************************** pvstat **********************************
proc pvstat {_var} {
# _var is a single variable that has been linked
# Returns a formatted string

    global errorCode

    global $_var pvstatresult
    set len [llength $_var]
    if {$len != 1} {
	errmsg "Stat must be for a single variable, not a list"
	return "Error"
    }
    if {[pv stat "$_var" pvstatresult] != 0} {
	if {[llength $_var] < 4} {
	    set _errname $_var
	} else {
	    set _errname "[lrange $_var 0 2] ..."
	}
	errmsg "Getting stat for $_errname failed:\n$errorCode"
	return
    }
    set string [format "STATE: %s\nSTATUS: %s\nSEVERITY: %s\nTIME: %s"  \
		  $pvstatresult(state) $pvstatresult(status) \
		  $pvstatresult(severity) $pvstatresult(time)]
    if {[info exists pvstatresult]} {unset pvstatresult}
    return $string
}
# **************************** caget ***********************************
proc caget {name} {
# name is a list of PV names
# Returns is a list of the current values

    global errorCode

# Make list of (global) variables
    set len [llength $name]
    set _pvtempvar ""
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem _pvtempvar$_ii
	global $_varelem
	if {[info exists $_varelem]} {unset $_varelem}
	set _pvtempvar [linsert $_pvtempvar end $_varelem]
    }
# Link
    if {[pv linkw $_pvtempvar $name] != 0} {
	errmsg "caget: Error in link:\n$errorCode"
    }
# Get
    if {[pv getw $_pvtempvar] != 0} {
	errmsg "caget: Error in get:\n$errorCode"
    }
# Make return value list
    set _returnval ""
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem _pvtempvar$_ii
	if {[info exists $_varelem]} {
	    set _returnval [linsert $_returnval end [set $_varelem]]
	    unset $_varelem
	} else {
	    set _returnval [linsert $_returnval end "Error"]
	}
    }
# Return the result
    return $_returnval
}
# **************************** caput ***********************************
proc caput {name _val} {
# name is a list of PV names
# _val is a list of PV names
# Returns is a list of the current values

    global errorCode

# Check input
    set len [llength $name]
    set lenv [llength $_val]
    if {$len != $lenv} {
	errmsg "Variable list and value list must be same length"
	return "Error"
    }
# Make list of (global) variables
    set _pvtempvar ""
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem _pvtempvar$_ii
	global $_varelem
	if {[info exists $_varelem]} {unset $_varelem}
	set _pvtempvar [linsert $_pvtempvar end $_varelem]
    }
# Link
    if {[pv linkw $_pvtempvar $name] != 0} {
	errmsg "caput: Error in link:\n$errorCode"
    }
# Set the values into the variables
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem [lindex $_pvtempvar $_ii]
	set $_varelem [lindex $_val $_ii]
    }
# Put
    if {[pv putw $_pvtempvar $_val] != 0} {
	errmsg "caput: Error in put:\n$errorCode"
    }
# Get actual values
    if {[pv getw $_pvtempvar] != 0} {
	errmsg "caput: Error in get:\n$errorCode"
    }
# Make return value list
    set _returnval ""
    for {set _ii 0} {$_ii < $len} {incr _ii} {
	set _varelem _pvtempvar$_ii
	if {[info exists $_varelem]} {
	    set _returnval [linsert $_returnval end [set $_varelem]]
	    unset $_varelem
	} else {
	    set _returnval [linsert $_returnval end "Error"]
	}
    }
# Return the result
    return $_returnval
}
