

proc APSReplicateItemHelp {} {
    return "Usage: APSReplicateItem -item <string> -number <integer>\n\
Returns list of <integer> items, each item being <string>."
}

proc APSReplicateItem {args} {
    set item ""
    set number 0
    APSStrictParseArguments {item number}
    if $number<1 {
        return {}
    }
    set itemList {}
    for {} {$number>=1} {incr number -1} {
        lappend itemList $item
    }
    return $itemList
}

proc APSUniqueNumberHelp {} {
    return "Usage: APSUniqueNumber\nReturns a unique number.\n"
}

proc APSUniqueNumber {} {
    global apsUniqueNumber
    incr apsUniqueNumber
    return $apsUniqueNumber
}

proc APSUniqueNameHelp {} {
    return "Usage: APSUniqueName prefix\nReturns a unique name which begins with\nthe given prefix.\n"
}

proc APSUniqueName {prefix} {
    global apsUniqueName

    if {[info exists apsUniqueName($prefix)]} {
        incr apsUniqueName($prefix)
    } else {
        set apsUniqueName($prefix) 1
    }
    return $prefix$apsUniqueName($prefix)
}

proc APSGeometryRightRelative {parentWidget} {
    return "+[expr [winfo rootx $parentWidget] + [winfo width $parentWidget]]+[winfo rooty $parentWidget]"
}

proc APSUnmapHelp {} {
    return "Usage: APSUnmap widget\nRemoves widget from packing order, but keeps the widget in memory. In other\nwords, the image of the widget is removed from the screen. Use APSRemap to\nredisplay it."
}
proc APSUnmap {widget} {
    global apsMap

    set apsMap($widget) [pack info $widget]
    pack forget $widget
}

proc APSRemapHelp {} {
    return "Usage: APSRemap widget\nRestores a widget to the display after an APSUnmap has been performed.\nRequest is ignored if widget was never unmapped."
}
proc APSRemap {widget} {
    global apsMap

    if {[info exists apsMap($widget)]} {
        eval pack $widget $apsMap($widget)
        unset apsMap($widget)
    }
}

proc APSRepackHelp {} {
    return "Usage: APSRepack widget packOptions\nRepacks widget using packOptions. Ex. APSRepack .button -side top -fill y\nAny specified pack option will override the previous pack option, but all\nprevious options are retained otherwise."
}
proc APSRepack {widget args} {
    eval pack $widget [pack info $widget] $args
}

proc APSSendEMailHelp {} {
    return "Usage: APSSendEMail\n\t-address <string>\n\t-message <string>\n\t\[-subject <string>\]\n\t\[-considerate 1\]\n\t\[-earlyHour <number>\]\n\t\[-lateHour <number>\]\n\t\[-mailProgram <string>\]\nSends an email message to the given address.  If considerate mode is requested, won't send to an email pager before earlyHour or after lateHour."
}

proc APSSendEMail {args} {
    set address ""
    set message ""
    set considerate 0
    set earlyHour 8
    set lateHour 23
    set mailProgram mailx
    set subject "No subject."
    APSStrictParseArguments {address message considerate earlyHour lateHour subject mailProgram}
    if {$considerate==1 && [scan $address %ld number]==1} {
        # apparently an email pager address, so be considerate
        # if so requested and don't page if earlier than earlyHour or
        # later than lateHour
        set hour [clock format [clock seconds] -format %H]
        if {$hour>$lateHour || $hour<$earlyHour} return
    }
    set len [string length $message]
    if {$len && [string length $address]} {
        if {$len > 1040000} {
            set message "[string range $message 0 100000]\n...\n...\n...\n...\n...\nStriped middle of email because it is too big\n...\n...\n...\n...\n...\n[string range $message [expr {$len - 100000}] end]"
        }
        foreach ad $address {
            foreach a [split $ad ","] {
                if {[string first "@" $a] == -1} {
                    if {($a == "flcoord") || ($a == "sigroup") || ($a == "mom-me") || ($a == "mom-vac")} {
                        catch {exec echo "$message" | $mailProgram -s "$subject" ${a}@aps.anl.gov }
                    } else {
                        catch {exec echo "$message" | $mailProgram -s "$subject" ${a}@anl.gov }
                    } 
                } else {
                    catch {exec echo "$message" | $mailProgram -s "$subject" $a} 
                }
            }
        }
    }
}


proc APSWaitWithUpdateHelp {} {
    return "Usage: APSWaitWithUpdate -waitSeconds <secs> -updateInterval <secs> \[-abortVariable <name>\] \[-updateCommand <string>\]"
}

proc APSWaitWithUpdate {args} {
    set waitSeconds 0
    set updateInterval 1
    set abortVariable ""
    set updateCommand update
    APSStrictParseArguments {waitSeconds updateInterval abortVariable updateCommand}
    if {$waitSeconds<=0} return
    if [string length $abortVariable] {
        global $abortVariable
    }
    set updates [expr int((1.0*$waitSeconds)/$updateInterval+0.5)]
    set afterTime [expr int($updateInterval*1000)]
    if {[info command tkwait] == "tkwait"} {
        set waitFlag "apsWaitWithUpdateFlag[clock clicks]"
        while {$updates} {
            after $afterTime "set $waitFlag 0"
            tkwait variable $waitFlag
            eval $updateCommand
            incr updates -1
            if {[string length $abortVariable] && [set $abortVariable]} {
                return
            }
        }
    } else {
        while {$updates} {
            after $afterTime
            eval $updateCommand
            incr updates -1
            if {[string length $abortVariable] && [set $abortVariable]} {
                return
            }
        }
    }
}

proc APSSetVarAndUpdateHelp {} {
    return "Usage: APSSetVarAndUpdate <variable> <value>"
}

proc APSSetVarAndUpdate {variable value} {
    global $variable
    set $variable $value
    update
}

proc APSConvertTimeToHoursHelp {} {
    return "Usage: APSConvertTimeToHours <timeValue>
Where time value may be of the H:M, H:M:S, or floating point hours."
}

proc APSConvertTimeToHours {timeValue} {
    set timeValue [string trim $timeValue " "]
    if [string length $timeValue]==0 {
        return -code error "APSConvertTimeToHours: Blank value passed."
    }
    if [string first : $timeValue]!=-1 {
        # interpret as H:M[:S]
        set valueList [split $timeValue :]
        scan [lindex $valueList 0] %ld hour
        scan [lindex $valueList 1] %ld min
        if [llength $valueList]>2 {
            scan [lindex $valueList 2] %ld secs
        } else {
            set secs 0
        }
        if {$hour>24 || $hour<0} {
            return -code error "APSConvertTimeToHours: Invalid hour $hour given."
        }
        if {$min>60 || $min<0} {
            return -code error "APSConvertTimeToHours: Invalid minutes $min given."
        }
        if {$secs>60 || $secs<0} {
            return -code error "APSConvertTimeToHours: Invalid seconds $secs given."
        }
        return [expr $hour+$min/60.0+$secs/3600.0]
    } 
    # floating-point hours---trim leading zeros.
    while {[string length $timeValue]>1} {
        set timeValue1 [string trimleft $timeValue 0]
        if [string compare $timeValue $timeValue1]==0 {
            break
        }
        set timeValue $timeValue1
    }
    if {$timeValue>24 || $timeValue<0} {
        return -code error "APSConvertTimeToHours: Invalid hours $timeValue given."
    }
    return $timeValue
}

proc APSPrintHelp {} {
    return "Usage: APSPrint \[-text <string>\]\t\n\[-textWidget <string>\]\t\n\[-cmd <printcommand>\]\t\nWhere <printcommand> is lpr or enscript\n"
}

proc APSPrint {args} {
    global apsContextHelp
    set text ""
    set textWidget ""
    set widgetType text
    set cmd "enscript"

    APSStrictParseArguments {text textWidget cmd widgetType}
    if ![string length [string trim $cmd]] {
        set cmd "enscript"
    }

    if [string compare $widgetType listbox]==0 {
        if [string length $textWidget] {
            set text "${text}[join [$textWidget get 0 end] \n]"
        }
    } else {
        if [string length $textWidget] {
            set text "${text}[$textWidget get 1.0 end]"
        }
    }        

    set command |$cmd
    if [catch {open $command w} res] {
        return $res
    } else {
        set fp $res
        puts -nonewline $fp $text
        if [catch {close $fp} res] {
            return $res
        } else {
            return 0
        }
    }
}

proc APSPrintTextHelp {} {
    return "Usage: APSPrintText \[-text <string>\]\t\n\[-cmd <printcommand>\]\t\nWhere <printcommand> is lpr or enscript\n"
}

proc APSPrintText {args} {
    set text ""
    set cmd "enscript"
    APSStrictParseArguments {text cmd}
    if {![string length [string trim $cmd]]} {
        set cmd "enscript"
    }
    set command |$cmd
    if [catch {open $command w} res] {
        return $res
    } else {
        set fp $res
        puts -nonewline $fp $text
        if [catch {close $fp} res] {
            return $res
        } else {
            return 0
        }
    }
}

proc APSAddToParallelListsHelp {} {
    return "Usage: APSAddToParallelLists -listNames <list> -listItems <list>\n\
Appends ith list item to ith list. Used to construct parallel lists."
}

proc APSAddToParallelLists {args} {
    set listNames ""
    set listItems ""
    APSStrictParseArguments {listNames listItems}
    if [llength $listNames]!=[llength $listItems] {
        return -code error "APSAddToParallelLists: lists not the same length"
    }
    set index -1
    foreach listName $listNames {
        incr index
        uplevel 1 lappend $listName \"[lindex $listItems $index]\"
    }
}


#
# New routines for managing temporary files using multiple lists.
# This allows applications to selectively delete sets of temp files
# while guaranteeing that the files get deleted.
#

proc APSAddToTmpFileListHelp {} {
    return "Usage: APSAddToTmpFileList -ID <string> -fileList <list>\n\
Adds to named list of temporary files, creating the list if the ID is new. 
Files are deleted automatically when the script exits, or when 
APSDeleteTmpFileList is called with the same ID. A more flexible variant of APSAddToTempFileList."
}

proc APSAddToTmpFileList {args} {
    set ID ""
    set fileList ""
    APSStrictParseArguments {ID fileList}
    if ![string length $ID] {
        return -code error "APSStartTmpFileList: no list ID"
    }
    global apsTmpFileListArray
    if [llength $fileList] {
        if [lsearch -exact [array names apsTmpFileListArray] $ID]==-1 {
            dp_atexit append "APSDeleteTmpFileList -ID $ID"
        }
        foreach file $fileList {
            if [string compare [file dirname $file] .]==0 {
                set file [pwd]/$file
            }
            lappend apsTmpFileListArray($ID) $file
        }
    }
}

proc APSDeleteTmpFileListHelp {} {
    return "Usage: APSDeleteTmpFileList -ID <string>\n\
Deletes the temporary files associated with the given ID.\n\
  A more flexible variant of APSDeleteTempFiles.\n"
}

proc APSDeleteTmpFileList {args} {
    APSStrictParseArguments {ID}
    if ![string length $ID] return
    global apsTmpFileListArray
    if {[lsearch -exact [array names apsTmpFileListArray] $ID]!=-1 && \
          [llength $apsTmpFileListArray($ID)]} {
        eval file delete -force -- $apsTmpFileListArray($ID)
        set apsTmpFileListArray($ID) ""
    }
}


proc APSAddToTempFileListHelp {} {
    return "Usage: APSAddToTempFileList <filename> \[<filename>...\]"
}

proc APSAddToTempFileList {args} {
    global apsTempFileList 
    if ![llength $apsTempFileList] {
        dp_atexit append APSDeleteTempFiles
    }
    foreach file $args {
        if [string compare [file dirname $file] "."]==0 {
            set file [pwd]/$file
        }
        lappend apsTempFileList $file
    }
}

proc APSDeleteTempFilesHelp {} {
    return "Usage: APSDeleteTempFiles"
}

proc APSDeleteTempFiles {} {
    global apsTempFileList
    if [llength $apsTempFileList] {
        eval file delete -- $apsTempFileList
    }
    set apsTempFileList ""
}

proc APSFreezeVarsHelp {} {
    return "Usage: APSFreezeVars varname1 ... varnamen\nGiven a series of global variables, make them read-only until\nAPSUnfreezeVars is invoked. This allows you to freeze a set of variables\nduring execution of a critical procedure, preventing a user from\ninadvertently modifying global vars via a widget."
}
proc APSFreezeVars {args} {
    global apsFreezeVars
    foreach arg $args {
        global $arg
        if {[info exists $arg]} {
            set apsFreezeVars($arg) [set $arg]
            trace variable $arg w APSFreezeVarsCallback
        }
    }
}

proc APSUnfreezeVarsHelp {} {
    return "Usage: APSUnfreezeVars varname1 ... varnamen\nRemove write-protection from the given global variables. Assumes you have\ndone a prior APSFreezeVars."
}
proc APSUnfreezeVars {args} {
    global apsFreezeVars
    foreach arg $args {
        global $arg
        if {[info exists apsFreezeVars($arg)]} {
            unset apsFreezeVars($arg)
            trace vdelete $arg w APSFreezeVarsCallback
        }
    }
}

proc APSFreezeVarsCallback {varName index op} {
    global $varName
    global apsFreezeVars
    switch $op {
        w {
            if [info exist apsFreezeVars($varName] {
                set $varName $apsFreezeVars($varName)
            }
            }
        }
    }

    proc APSUpdateSoftLink {args} {
        set link ""
        set file ""
        APSStrictParseArguments {link file}
        if {![string length $file] || ![string length $link]} {
            return -code error "UpdateSoftLink: Empty string for file or link"
        }
        # if there is an error, then oldFile will contain the 
        # diagnostic message which will then be written to the log file.
        catch {file readlink $link } oldFile
        catch {file delete -- $link}
        if [catch {exec ln -s $file $link } result] {
            return -code error "UpdateSoftLink: $result"
        }
        if [catch {exec logMessage  -sourceId=UpdateSoftLinkAudit \
                     -tag=Link $link -tag=OldFile $oldFile -tag=NewFile $file \
                 } result ] {
            APSAlertBox .alert -errorMessage "error with logMessage: $result"
            return
        }
    }

    proc APSNoOpHelp {} {
        return "Usage: APSNoOp <arguments>\nDoes nothing but return."
    }

    proc APSNoOp {args} {
        return
    }

    proc APSSplitGenerationedNameHelp {} {
        return "Usage: APSSplitGenerationedName -name <string> \[-separator <char>\]\n\
Expects a name of the form <part1><separator><part2>, where <part2> is a representation of an integer (e.g., 0001).  Returns the list <part1> <part2-as-number> <part2-format>.  E.g., for file.sdds-0001, would return file.sdds 1 %04ld."
}

proc APSSplitGenerationedName {args} {
    set name ""
    set separator -
    APSStrictParseArguments {name separator}
    set index [string last $separator $name]
    if {$index==-1} {
        return -code error "APSSplitGenerationedName: no generation: $name"
    }
    set name0 [string range $name 0 [expr $index-1]]
    set gen [string range $name [expr $index+1] end]
    if {[scan $gen %ld igen]!=1} {
        return -code error "APSSplitGenerationedName: Problem scanning generation number: $gen"
    }
    return [list $name0 $igen [format %%0%ldld [string length $gen]]]
}

proc APSNextGenerationedNameHelp {} {
    return "Usage: APSNextGenerationedName -name <string> \[-separator <char>\] \[-newFile 1\] \[-directory <name>\]\n\
Expects a name of the form <part1><separator><part2>, where <part2> is a representation of an integer (e.g., 0001).  Returns the next file in the series.  If -newFile 1 is given, returns the first name that isn't already used; this name may the original name you pass, if that file doesn't exist."
}

proc APSNextGenerationedName {args} {
    set name ""
    set separator -
    set newFile 0
    set directory ""
    APSStrictParseArguments {name separator newFile directory}
    if [catch {APSSplitGenerationedName -name $name -separator $separator} result] {
        return -code error $result
    }
    set name [lindex $result 0]
    set index [lindex $result 1]
    set formatString [lindex $result 2]
    if !$newFile {
        return $name$separator[format $formatString [expr $index+1]]
    } else {
        if [string length $directory] {
            set directory $directory/
        }
        while 1 {
            set filename $name$separator[format $formatString $index]
            if ![file exists $directory$filename] {
                return $filename
            }
            incr index
        }
    }
}


proc APSResolveLinkHelp {} {
    return "Usage: APSResolveLink <filename>"
}

proc APSResolveLink {filename} {
    if ![string length $filename] {
        return -code error ""
    }
    set partList [split $filename /]
    set origFilename $filename
    set filename ""
    foreach part $partList {
        if ![string length $part] continue
        if [string length $filename] {
            set filename0 $filename/$part
        } else {
            if [string compare [string range $origFilename 0 0] /]==0 {
                set filename0 /$part
            } else {
                set filename0 $part
            }
        }
        if ![file exists $filename0] {
            return -code error "APSResolveLink: Not found: $filename0"
        }
        while {[string compare [file type $filename0] link]==0} {
            set linkVal [file readlink $filename0] 
            if [string compare [string range $linkVal 0 0] /]==0 {
                # absolute path
                set filename0 $linkVal
            } else {
                # relative path. Added recursion in case a link
                # has a / in it. We need to split the 
                # new path into parts, and resolve links therein.
                set filename0 [file join $filename $linkVal]
                set filename0 [APSResolveLink $filename0]
            }
        }
        set filename $filename0
    }
    return $filename
}

proc APSArchiveGenerationedCopyHelp {} {
    return {Usage: APSArchiveGenerationedCopy -name <string> [-separator <char>] [-extension .<string>] [-remove 1]}
}

proc APSArchiveGenerationedCopy {args} {
    set name ""
    set separator -
    set extension .old
    set remove 0
    APSStrictParseArguments {name separator extension remove}
    if ![file exists $name] {
        return -code error "ArchiveGenerationedCopy: Not found: $name"
    }
    set archiveName $name${extension}${separator}0001
    if [file exists $name${extension}] {
        set archiveName [APSNextGenerationedName \
                           -name [file readlink $name${extension}] \
                           -newFile 1 -separator $separator]
    }
    set cpCmd copy
    if {$remove} {
        set cpCmd rename
    }
    if {[file exists $name$extension] && \
          [catch {file delete -- $name$extension} result]} {
        return -code error "ArchiveGenerationedCopy: $result"
    }
    if [catch {file $cpCmd -force -- $name $archiveName
        exec ln -s $archiveName $name${extension}} result] {
        return -code error "ArchiveGenerationedCopy: $result"
    }
}

proc APSMakeLinkHelp {} {
    return "Usage: APSMakeLink -filename <string> -linkname <string> -local {0|1} -log {0|1} \[-confirm 1\] \[-confirmMessage <string>\]"
}

proc APSMakeLink {args} {
    set filename ""
    set linkname ""
    set local 0
    set permissions ""
    set confirm 0
    set log 0
    set confirmMessage "Are you sure?"
    APSStrictParseArguments {filename linkname local permissions \
                               confirm confirmMessage log} 
    set dirname [file dirname $linkname]
    if {$confirm && \
          ![APSMultipleChoice [APSUniqueName .] \
              -question "$confirmMessage" \
              -labelList {Yes No} -returnList {1 0}]} {
        return -code ok "APSMakeLink: User answered No to: $confirmMessage"
    }
    if {![string length $filename]} {
        return -code error "APSMakeLink: filename is blank"
    }
    if {![string length $linkname]} {
        return -code error "APSMakeLink: linkname is blank"
    }
    if [string compare $filename $linkname]==0 {
        return -code error "APSMakeLink: can't link $filename to itself---it's unnatural!."
    }
    if ![file exists $filename] {
        return -code error "APSMakeLink: file $filename does not exist."
    }
    if {[file exists $linkname]} {
        if {[string compare [file type $linkname] link]!=0} {
            return -code error "APSMakeLink: unable to remove existing $linkname: not a link"
        }
        if [catch {file readlink $linkname} oldFile] {
            return -code error "APSMakeLink: unable to read link target for $linkname: $oldFile"
        }
        if [catch {file delete -force -- $linkname} result] {
            return -code error "APSMakeLink: unable to remove existing $linkname: $result"
        }
    } else {
        # no error issued if the link doesn't exists.
        # set oldFile to None is no previous link existed.
        set oldFile None
    }
    
    if {$local && [string compare [file dirname $linkname] [file dirname $filename]]==0} {
        set oldDir [pwd]
        cd [file dirname $linkname]
        if [catch {exec ln -s [file tail $filename] [file tail $linkname]} result] {
            cd $oldDir
            return -code error "APSMakeLink: error linking $filename as $linkname: $result"
        }
        set filename [file tail $filename]
        cd $oldDir
    } else {
        if [catch {exec ln -s $filename $linkname} result] {
            return -code error "APSMakeLink: error linking $filename as $linkname: $result"
        }
    }
    if {[string length $permissions]} {
        catch {file attributes $linkname -permissions $permissions }
    }
    if {$log &&
        [catch {exec logMessage -sourceId=UpdateSoftLinkAudit \
                  -tag=Link $linkname \
                  -tag=OldFile $oldFile \
                  -tag=NewFile $filename} result]} {
        return -code error "APSMakeLink: error logging link creation: $result"
    }
    if {[string compare $dirname "."]==0} {
        set dirname [pwd]
    }
    switch -regexp $dirname {
        orbitControllaw/lattices -
        rtfeedback/lattices -
        rfOrbitControllaw/lattices {
            if [catch {APSUpdateConfigDescriptionDatabase -dataDir $dirname \
                         -linkConfig [file tail $linkname]} result] {
                return -code error "APSMakeLink: error updating description database: $result"
            }
        }
    }
}

proc APSGoToDailyDirectoryHelp {args} {
    return "Usage: APSGoToDailyDirectory \[-account <user>\] \[-subdirectory <user>\]\ncreates a daily directory in the format <rootDir>/<yy><mm>/<dd>/<shift>/<subdirectory>. The user's home directory is the default root directory. The account argument can be used to specify somebody else's root directory. If no subdirectory is given then only <rootDir>/<yy><mm>/<dd>/<shift> is created. The procedure returns the name of the directory and sets the global variable apsOutputDir to the name of the directory. Note this procedure doesn't have any cd commands."
}

proc APSGoToDailyDirectory {args} {
    global env
    set account $env(USER)
    set subdirectory ""
    set fourDigitYear 1
    APSStrictParseArguments {account subdirectory fourDigitYear}
    set timeList [clock format [clock seconds] -format "%Y %m %d %H %M %S"]
    
    if {([string toupper $account] == "SR") || ([string toupper $account] == "LINAC") || ([string toupper $account] == "PAR") || ([string toupper $account] == "BOOSTER")} {
        set fourDigitYear 1
    }
    if {$fourDigitYear} {
        set year [lindex $timeList 0]
        set month [lindex $timeList 1]
    } else {
        # use only last two digits of year
        regexp {..$} [lindex $timeList 0] year
        regexp {^0?(.*)} $year {} year
        set month [string trimleft [lindex $timeList 1] 0]
    }
    set day [lindex $timeList 2]
    regexp {^0?(.*)} [lindex $timeList 3] {} hour
    if $hour<8 {
        set shift 1
    } elseif $hour<16 {
        set shift 2
    } else {
        set shift 3
    }
    global apsOutputDir OAGGlobal
    set top $env(HOME)
    if {[info exists OAGGlobal(AtAPS)] && !$OAGGlobal(AtAPS)} {
        set top [file dirname $env(HOME)]/$account
    }
    if {$fourDigitYear} {
        set apsOutputDir $top/daily/${year}/${month}/${day}/$shift
    } else {
        set apsOutputDir $top/daily/[format %02ld%02ld $year $month]/${day}/$shift
    }
    if [string length $subdirectory] {
        append apsOutputDir /$subdirectory
    }
    if ![file exists $apsOutputDir] {
        if [catch {file mkdir $apsOutputDir} result] {
            return -code error $result
        }
    }
    return $apsOutputDir
}

proc APSCAAverageAndTransferHelp {} {
    return "Usage: APSCAAverageAndTransfer -readbackList <pvNameList> -setpointList <pvNameList> -average <number> -interval <seconds> -statusCallback <proc> \[-flagList <varList>\]"
}

proc APSCAAverageAndTransfer {args} {
    set readbackList ""
    set setpointList ""
    set average 1
    set interval 0
    set statusCallback APSNoOp
    set flagList ""
    set verbose 0
    set checkReadback 0
    APSStrictParseArguments {readbackList setpointList average interval statusCallback flagList verbose checkReadback}
    
    if {[llength $readbackList]!=[llength $setpointList] || \
          ![llength $readbackList]} {
        eval $statusCallback {"APSCAAverageAndTransfer: bad readback or setpoint list"}
        return -code error "APSCAAverageAndTransfer: bad readback or setpoint list"
    }
    if {[llength $flagList] && [llength $flagList]!=[llength $readbackList]} {
        eval $statusCallback {"APSCAAverageAndTransfer: flag list has wrong length."}
        return -code error "APSCAAverageAndTransfer: flag list has wrong length."
    }
    if [llength $flagList]==0 {
        set readbackList1 $readbackList
        set setpointList1 $setpointList
    } else {
        set readbackList1 ""
        set setpointList1 ""
        foreach flag $flagList readback $readbackList setpoint $setpointList {
            global $flag
            if [set $flag] {
                lappend readbackList1 $readback 
                lappend setpointList1 $setpoint
            }
        }
        if [llength $readbackList1]==0 {
            return
        }
    }
    eval $statusCallback {"Averaging $average readings for [llength $readbackList1] readbacks..."}
    if $verbose {
        foreach readback $readbackList1 {
            eval $statusCallback {"$readback"}
        }
    }
    if [catch {exec cavget -list=[join $readbackList1 ,] -pend=10 \
                 -repeat=number=$average,pause=$interval,average} dataList] {
        eval $statusCallback {"APSCAAverageAndTransfer: $dataList"}
        return -code error "APSCAAverageAndTransfer: $dataList"
    }
    set optionList  ""
    foreach setpoint $setpointList1 data $dataList readback $readbackList1 {
        if [string compare $data ?]==0 {
            eval $statusCallback {"APSCAAverageAndTransfer: no readback for $readback"}
            return -code error "APSCAAverageAndTransfer: no readback for $readback"
        }
        if $checkReadback {
            if {[expr abs($data)]<1e-6} {
                eval $statusCallback {"APSCAAverageAndTransfer: warning, the readback for readback is not valid (close to zero). Transfer for $setpoint is ignored."}
                continue
            }
        }
        if $verbose {
            eval $statusCallback {"$data -> $setpoint ($readback)"}
        }
        lappend optionList $setpoint=$data
    }
    if ![llength $optionList] {
        eval $statusCallback {"No valid readbacks, transfer is not performed!"}
        return -code error "APSCAAverageAndTransfer: No valid readbacks, transfer is not performed!"
    }
    eval $statusCallback {"Setting values..."}
    if [catch {exec cavput -list=[join $optionList ,] -pend=10} result] {
        eval $statusCallback {"APSCAAverageAndTransfer: $result"}
        return -code error "APSCAAverageAndTransfer: $result"
    }
    eval $statusCallback {"Setpoint(s) updated."}
}

proc APSEditStringHelp {} {
    return "Usage: APSEditString -editcommand <command sequence> \[<string> ...\]\n\n-editcommand sequences:\n<n>d    delete <n> characters\n<n>f    forward <n> characters\n<n>b    backward <n> characters\n<n>D    delete <n> words\n<n>F    forward <n> words\n<n>B    backward <n> words\n<n>i{delim}text{delim} insert text <n> times\ns{delim}text{delim}    search for text, leave active position at end\nS{delim}text{delim}    search for text, leave active position at start\n<n>k    kill <n> characters\n<n>K    kill <n> words\nz<c>    kill up to <c>\n<n>Z<c> kill up to and including <c>, <n> times\n<n>y    yank kill buffer, <n> times\n<n>%{delim}text1{delim}text2{delim} replace text1 with text2 <n> times"
}

proc APSEditString {args} {
    set editcommand ""
    APSParseArguments {editcommand}
    if [catch {eval os editstring $editcommand $args} results] {
        return -code error $results
    }
    return -code ok [join $results \n]
}

proc APSSRFindLattices {} {
    global OAGGlobal
    # All files and directories in /home/helios/oagData/sr/lattices
    set itemList [glob $OAGGlobal(SRLatticesDirectory)/*]
    set excludeDirs {default templates scripts LGDDetails}
    set latticeList ""
    foreach item $itemList {
        if [file isdirectory $item] {
            set lattice [file tail $item]
            if {[lsearch -exact $excludeDirs $lattice] != -1 } continue
            # check to see if this is a real lattice directory
            # with a aps.lte file
            if [file exists $OAGGlobal(SRLatticesDirectory)/$lattice/aps.lte] {
                lappend latticeList $lattice
            }
        }
    }
    return $latticeList
}

proc APSSetSimpleACL {args} {
    set readOnlyList ""
    set readWriteList ""
    set executeList ""
    set rwxList ""
    set fileList ""
    set user rwx
    set group r--
    set other r--
    # arguments user group other are required entries of the setfacl command
    if [catch {APSStrictParseArguments {readOnlyList \
                                          readWriteList executeList rwxList \
                                          user group other fileList} \
             } result] {
        return -code error $result
    }
    foreach uid $readOnlyList {
        lappend uidList $uid
        set read($uid) 1
    }
    foreach uid $readWriteList {
        lappend uidList $uid
        set read($uid) 1
        set write($uid) 1
    }
    foreach uid $executeList {
        lappend uidList $uid
        set execute($uid) 1
    }
    foreach uid $rwxList {
        lappend uidList $uid
        set rwx($uid) 1
    }
    set acls ""
    foreach uid $uidList {
        if [info exists done($uid)] continue
        if [info exists read($uid)] {
            set flag r
        } else {
            set flag -
        }
        if [info exists write($uid)] {
            append flag w
        } else {
            append flag -
        }
        if [info exists execute($uid)] {
            append flag x
        } else {
            append flag -
        }
        if [info exists rwx($uid)] {
            set flag rwx
        }
        lappend acls user:$uid:$flag
        set done($uid) 1
    }
    lappend acls user::$user
    lappend acls group::$group
    lappend acls other:$other
    if [catch {eval exec setfacl -s [join $acls ,],mask:rwx $fileList} result] {
        return -code error "$result"
    }
    return
}

proc APSSetVarsFromList {args} {
    set valueList ""
    set variableList ""
    if {[APSStrictParseArguments {valueList variableList}] || \
          ![llength $valueList] || [llength $valueList]!=[llength $variableList]} {
        return -code error "APSSetVarsFromList: invalid arguments/values"
    }
    foreach value $valueList variable $variableList {
        uplevel 1 "set $variable \"$value\""
    }
}

proc APSSetVarsFromListHelp {} {
    return "Usage: APSSetVarsFromList -valueList <list> -variableList <list>\nSets successive variables in variable list to successive values in value list."
}

proc APSFileCopy {args} {
    set from ""
    set to ""
    if {([APSStrictParseArguments {from to}]) || \
          (![llength $from]) || \
          (![llength $to])} {
        return -code error "APSFileCopy: invalid arguments/values"
    }
    set names ""
    while {[string equal [file type $from] "link"]} {
        if {[lsearch -exact $names $from] != -1} {
            return -code error "APSFileCopy: circular loop with symbolic links"
        } else {
            lappend names $from
        }
        set tmp [file readlink $from]
        if {[string equal [file pathtype $tmp] "relative"]} {
            set tmp [file join [file dirname $from] $tmp]
        }
        if {[string equal [file pathtype $tmp] "absolute"]} {
            set tmp2 ""
            foreach part [file split $tmp] {
                if {[string equal $part ".."]} {
                    set tmp2 [lrange $tmp2 0 end-1]
                } else {
                    lappend tmp2 $part
                }
            }
            set tmp2 [eval file join $tmp2]
        } else {
            set tmp2 $tmp
        }
        if {[string equal $tmp2 $from]} break
        set from $tmp2
    }
    if {[catch {file copy -force -- $from $to} results]} {
        return -code error "APSFileCopy: $results"
    }
}

proc APSFileCopyHelp {} {
    return "Usage: APSFileCopy -from <filename> -to <filename>\nCopies real file even if a symbolic link is used."
}


proc APSStackTraceHelp {} {
    return "Usage: APSStackTrace \[-level <integer>\]\nReturns a list of procedure names in which execution is taking place."
}

proc APSStackTrace {args} {
    set level [info level]
    APSStrictParseArguments {level}
    set trace ""
    for {set i 1} {$i < $level} {incr i} {
        lappend trace [lindex [info level $i] 0]
    }
    return $trace
}

proc APSLogScriptActionHelp {} {
    return "Usage: APSLogScriptAction \n\[-procedure <string>\]\n\[-action <string>\]\n\[-parameters <string>\]\n\[-status <string>\]\n\nLogs script info using logDaemon."
}

proc APSLogScriptAction {args} {
    set procedure ?
    set action ?
    set parameters ?
    set state ?
    set stackPrefix ""
    if {[APSStrictParseArguments {action state parameters procedure stackPrefix}]==-1} {
        return -code error "APSLogScriptAction: invalid arguments"
    }
    global apsScriptCommand apsScriptUser apsScriptHost env apsPemStackPrefix
    set script ?
    if {![info exists apsPemStackPrefix]} {
        set apsPemStackPrefix ""
    }
    if {![info exists apsScriptCommand]} {
        if {![string length [set apsScriptCommand [info script]]]} {
            set apsScriptCommand ?
        }
    }
    set script $apsScriptCommand
    if {![info exists apsScriptUser]} {	
        if {[catch {set apsScriptUser $env(USER)}]} {
            set apsScriptUser ?
        }
    }
    set user $apsScriptUser
    if {![info exists apsScriptHost]} {
        if {[catch {set apsScriptHost [exec hostname]}]} {
            set apsScriptHost ?
        } 
    }
    set host $apsScriptHost
    set level [info level]
    set stack [join [APSStackTrace -level $level] "->"]
    if {![llength $stack]} {
        set stack None
    }
    if {[llength $apsPemStackPrefix]} {
        set stack ${apsPemStackPrefix}${stack}->>
    }
    set stack ${stackPrefix}${stack}

    incr level -1
    if {$level > 0} {
        if {$procedure == "?"} {
            set procedure [lindex [info level $level] 0]
        }
    }
    foreach var "user host procedure action parameters state script stack" {
        set $var [join [split [set $var] "\""] ']
        if {![llength [set $var]]} {
            set $var ?
        }
        if {[string range [set $var] 0 0] == "-"} {
            set $var " [set $var]"
        }
    }
    if {[catch {exec logMessage -sourceId=scriptAction \
                  -tag=User "$user" \
                  -tag=Host "$host" \
                  -tag=Procedure "$procedure" \
                  -tag=Action "$action" \
                  -tag=Parameters "$parameters" \
                  -tag=Status "$state" \
                  -tag=Script "$script" \
                  -tag=Stack "$stack"} result]} {
        return -code error $result
    }
}

proc APSEntryInfoBalloon_for {win textvar} {
    global apsInfoBalloon
    set apsInfoBalloon($win) $textvar
    bind $win <Enter> {APSEntryInfoBalloon_pending %W}
    bind $win <Leave> {APSEntryInfoBalloon_cancel}
}
proc APSEntryInfoBalloon_pending {win} {
    global apsInfoBalloon
    APSEntryInfoBalloon_cancel
    set apsInfoBalloon(pending) [after 1500 [list APSEntryInfoBalloon_show $win]]
}
proc APSEntryInfoBalloon_cancel {} {
    global apsInfoBalloon
    if {[info exists apsInfoBalloon(pending)]} {
        after cancel $apsInfoBalloon(pending)
        unset apsInfoBalloon(pending)
    }
    catch {wm withdraw .infoBalloon}
}
proc APSEntryInfoBalloon_show {win} {
    global apsInfoBalloon
    if {$apsInfoBalloon(active)} {
        set i [string first "(" $apsInfoBalloon($win)]
        if {$i == -1} {
            global $apsInfoBalloon($win)
        } else {
            global [string range $apsInfoBalloon($win) 0 [expr ($i - 1)]]
        }
        if {[string length [set $apsInfoBalloon($win)]] > [$win cget -width]} {
            .infoBalloon.info configure -text [set $apsInfoBalloon($win)]
            set x [expr [winfo rootx $win]+10]
            set y [expr [winfo rooty $win]+[winfo height $win]]
            wm geometry .infoBalloon +$x+$y
            wm deiconify .infoBalloon
            raise .infoBalloon
        }
    }
    unset apsInfoBalloon(pending)
}
proc APSEntryInfoBalloon_control {state} {
    global apsInfoBalloon
    if {$state} {
        set apsInfoBalloon(active) 1
    } else {
        APSEntryInfoBalloon_cancel
        set apsInfoBalloon(active) 0
    }
}

proc APSDisableWidgetHelp {} {
    return "Usage: APSDisableWidget <widgetName>\n\
Disables the named widget and all of its child widgets."
}
proc APSDisableWidget {widget} {
    foreach child [winfo children $widget] {
        if {[regexp .entry $child] || [regexp .button $child]} {
            catch {$child configure -state disabled}
        } else {
            if [regexp .tn $child] {
                ttk::style configure $child -state disabled
            } else {
                catch {$child configure -state disabled}
            }
        }
        APSDisableWidget $child
    }
    if [regexp .tn $widget] {
        ttk::style configure $widget -state disabled
    } else {
        catch {$widget configure -state disabled}
    }
}

proc APSEnableWidgetHelp {} {
    return "Usage: APSEnableWidget <widgetName>\n\
Enables the named widget and all of its child widgets."
}
proc APSEnableWidget {widget} {
    foreach child [winfo children $widget] {
        if {[regexp .entry $child] || [regexp .button $child]} {
            catch {$child configure -state normal}
        } else {
            if [regexp .tn $child] {
                ttk::style configure $child -state normal
            } else {
                catch {$child configure -state normal}
            }
        }
        APSEnableWidget $child
    }
    if [regexp .tn $widget] {
        ttk::style configure $widget -state normal
    } else {
        catch {$widget configure -state normal}
    }
}


proc APSEnableDisableWidgetHelp {} {
    return "Usage: APSEnableDisableWidget <widgetName> {-enable {0|1} | -toggle {0|1} | -variable <name>}\n\
Enables or disables the named widget and all of its child widgets."
}
proc APSEnableDisableWidget {widget args} {
    set enable 0
    set toggle 0
    set button 0
    set variable ""
    APSStrictParseArguments {enable toggle button variable}
    if {$variable != ""} {
        global $variable
        if [set $variable] {
            APSEnableWidget $widget
        } else {
            APSDisableWidget $widget
        }
        return
    }
    if $toggle {
        if [catch {$widget cget -state} state] {
            foreach child [winfo children $widget] {
                if ![catch {$child cget -state} state] {
                    break
                }
                set state ?
            }
        }
        if [string compare $state ?]==0  {
            return
        }
        set enable 0
        if [string compare $state disabled]==0 {
            set enable 1
        }
    }
    if $enable {
        if $button {
            APSEnableButton $widget
        } else {
            APSEnableWidget $widget
        }
    } else {
        if $button {
            APSDisableButton $widget
        } else {
            APSDisableWidget $widget
        }
    }
}

proc APSClearRCRecord {args} {
    set statusCallback ""
    set controlPV ""
    if {[APSStrictParseArguments {controlPV statusCallback}] || ![string length $controlPV]} {
        return -code error "APSClearRCRecord: bad arguments"
    }
    if [catch {exec cavget -list=$controlPV.RUN -pend=10 } status] {
        return -code error "APSClearRCRecord: $status"
    }
    if $status {
        exec cavput -list=$controlPV.ABRT=1 -pend=30
        if [string length $statusCallback] {
            eval $statusCallback {"Waiting for $controlPV to clear..."}
        }
        exec cawait -waitfor=$controlPV.RUN,equal=0
    }
    exec cavput -list=$controlPV.CLR=1 -pend=30
    if [string length $statusCallback] {
        eval $statusCallback {"$controlPV record is cleared."}
    }
}

proc APSFileLineCountHelp {} {
    return "Usage: APSFileLineCount <fileName>\nReturns number of lines in a file.\n"
}

proc APSFileLineCount {fileName} {
    if {![file exists $fileName] || \
          [catch {exec wc $fileName} result]} {
        return -1
    }
    return [lindex [split [string trim $result]] 0]
}

#Similar to string trimright except the all the characters must be found in order
proc APSStringTrimRight {s {chars " "}} {
    set l [string length $chars]
    while 1 {
        set n [expr {[string length $s] - $l}]
        if {[string compare $chars [string range $s $n end]] == 0} {
            set s [string range $s 0 [expr {$n - 1}]]
        } else {
            break
        }
    }
    return $s
}

#Similar to string trimleft except the all the characters must be found in order
proc APSStringTrimLeft {s {chars " "}} {
    set l [string length $chars]
    while 1 {
        set n [expr {$l - 1}]
        if {[string compare $chars [string range $s 0 $n]] == 0} {
            set s [string range $s $l end]
        } else {
            break
        }
    }
    return $s
}
