


proc APSRemoveGzipExtension {filename} {
    if {[string compare .gz [file extension $filename]]==0} {
        return [file rootname $filename]
    }
    return $filename
}

# set preferredFont -Adobe-Helvetica-Bold-R-Normal--*-120-*
# option add *font $preferredFont

proc APSStatusLine {widget args} {
    set variable ""
    set parent ""
    set width 60
    APSStrictParseArguments {variable parent width}
    if {$variable==""} { return 0 }
    global $variable
    APSLabeledOutput $widget -parent $parent -label "Status: " -width $width -textVariable $variable \
      -contextHelp "Status display line."
}

proc APSSetAllArrayEntries {arrayName value} {
    upvar $arrayName dataArray
    foreach elem [array names dataArray] {
        set dataArray($elem) $value
    }
}

set apsTmpStringCount 0
proc APSTmpString { } {
    global env apsTmpStringCount
    set tString [clock format [clock seconds] -format %y%m%d-%H%M%S]-[pid]
    if {[info exists env(USER)]} {
        set tString ${tString}$env(USER)$apsTmpStringCount
    } else {
        set tString ${tString}$apsTmpStringCount
    }
    incr apsTmpStringCount
    regsub -all " " $tString "" tString1
    return $tString1
}

proc APSYesNoPopUp {ques} {
    global apsYesNoPopUpAnswer
    set w .yesno
    toplevel $w
    wm title $w ""
    frame $w.message -relief raised -bd 2
    pack $w.message -side top
    label $w.message.label  -relief ridge -text "YesNo Question" -bg red -fg white
    pack $w.message.label -side top -fill x
    message $w.message.text -text "$ques\n" -width 400
    pack $w.message.text
    frame $w.buttons -bd 2
    button $w.buttons.yes -text YES -command "set apsYesNoPopUpAnswer 1" -relief raised 
    button $w.buttons.no -text NO -command "set apsYesNoPopUpAnswer 0" -relief raised 
    pack $w.buttons -side top
    pack $w.buttons.yes $w.buttons.no -side left 
    
    tkwait variable apsYesNoPopUpAnswer 
    destroy $w
    update
    return $apsYesNoPopUpAnswer
}

proc APSErrorPopUp {message} {
    global apsErrorPopUpAnswer
    set w .error
    toplevel $w
    wm title $w ""
    frame $w.message -relief raised -bd 2
    pack $w.message -side top
    message $w.message.text -text "Error: $message" -width 50m
    pack $w.message.text
    frame $w.buttons -bd 2
    button $w.buttons.ok -text OK -command "set apsErrorPopUpAnswer 1" -relief raised 
    pack $w.buttons -side top
    pack $w.buttons.ok -side left 
    
    tkwait variable apsErrorPopUpAnswer 
    destroy $w
    update
}

proc APSMakeExitButton {widget} {
    frame $widget -bd 2
    pack $widget -side top 
    button $widget.exit -text EXIT -command exit -relief raised 
    pack $widget.exit -side left 
}

proc APSMakeLabeledEntries {widget labelText args} {
    set ewidth 15
    set lanchor w
    set eanchor e
    set eside left
    set estate normal
    set erelief sunken
    set fside top
    set lwidth [string length $labelText]
    APSParseArguments {lwidth ewidth lanchor eside estate erelief fside}
    switch $lanchor {
        e       {set eanchor w ; set lside right}
        w       {set eanchor e ; set lside left}
        n       {set eanchor s ; set lside top}
        s       {set eanchor n ; set lside bottom}
    }                
    frame $widget  
    pack $widget -side $fside -fill x 

    label $widget.label -text "$labelText"   -width $lwidth
    pack $widget.label -anchor $lanchor -side $lside  -fill x

    frame $widget.entries
    pack $widget.entries -anchor $eanchor -side $lside -fill x
    set i 0
    foreach arg $args {
        entry $widget.entries.entry$i -textvariable $arg -width $ewidth \
          -relief $erelief -bg white -state $estate
        pack $widget.entries.entry$i -side $eside  -padx 2
        incr i
    }
}

proc APSMakeLabeledOutputs {widget labelText args} {
    eval APSMakeLabeledEntries $widget \"$labelText\" -estate readonly -erelief ridge $args 
}


proc APSUpdateUseLog {filename mode} {
    global env
    set tmpfile /tmp/[APSTmpString].$env(USER)
    set tmpexten [APSTmpString]
    set fout [open $tmpfile w]
    puts $fout {SDDS1}
    puts $fout {&column name=YearUsed type=long &end} 
    puts $fout {&column name=MonthUsed type=long &end} 
    puts $fout {&column name=DayUsed type=long &end} 
    puts $fout {&column name=HourUsed type=float &end} 
    puts $fout {&column name=JulianDayUsed type=long &end} 
    puts $fout {&column name=TimeStamp type=string format_string=%28s &end} 
    puts $fout {&column name=Mode type=string format_string=%12s &end}  
    puts $fout {&column name=User type=string format_string=%10s &end} 
    puts $fout {&data mode=ascii no_row_counts=1 &end} 
    set timeString [clock format [clock seconds] -format %y:%m:%d:%H:%M:%S:%j]
    set TimeStamp [clock format [clock seconds]]
    scan $timeString "%d:%d:%d:%d:%d:%d:%d" YearUsed MonthUsed DayUsed Hour Min Sec JDayUsed
    if {$YearUsed<1995} {
        if {$YearUsed>94} {
            set YearUsed [expr {$YearUsed+1900}]
        } else {
            set YearUsed [expr {$YearUsed+2000}]
        }
    }
    set HourUsed [expr {$Hour+($Min+$Sec/60.0)/60.0}]
    puts $fout "$YearUsed $MonthUsed $DayUsed $HourUsed $JDayUsed \"$TimeStamp\" $mode $env(USER)" 
    close $fout
    if {[file exists $filename]} {
        exec sddscombine $tmpfile $filename -merge -overwrite $filename.$tmpexten
        set junk $filename.[APSTmpString]
	file rename -force -- $filename $junk
	file rename -force -- $filename.$tmpexten $filename
	file delete -force -- $junk
        catch {exec chmod a+r $filename}
    } else {
	file rename -force -- $tmpfile $filename
        catch {exec chmod a+r $filename}
    }
}

#
# make a string save to use in an commandline qualifier
#

proc APSMakeSafeQualifierString {comment} {
    regsub -all "," $comment "\\\," comment1
    return $comment1
}

proc APSMakeSafeQualifierStringForEval {comment} {
    set comment1 [join [split $comment ,] \\\\,]
    return $comment1
}
proc APSMakeSafeQualifierStringForEvalSddsplot {comment} {
    set comment1 [join [split $comment ,] \\\\,]
    set comment2 [join [split $comment1 =] \\\\=]
    return $comment2
}

set APSErrorText "No error."
proc APSErrorReturn {code text} {
    global APSErrorText
    set APSErrorText $text
    return $code
}

proc APSGetErrorText {} {
    global APSErrorText
    return $APSErrorText
}

proc APSTrimLeadingChars {args} {
    set character ""
    set text ""
    APSStrictParseArguments {character text}
    if {[string length $character]==0} { return $text }
    if {[string length $text]==0} { return $text }
    regsub -all "^(\\$character)+" $text "" newtext
    return $newtext
}


proc APSUnpackFile {args} {
    set fileName ""
    set unpackMode ""
    set unpackedFile ""
    APSStrictParseArguments {fileName unpackMode unpackedFile}
    if {[string length $fileName]==0 || ![file exists $fileName]} {
        return 0
    }
    
    set unpackCommand(freeze) "freeze -dc "
    set unpackCommand(compress) "uncompress -c "
    set unpackCommand(gzip) "gzip -dcn "
    set packSuffix(freeze) ".F"
    set packSuffix(compress) ".Z"
    set packSuffix(gzip) ".gz"

    switch $unpackMode {
        none   {
            return -1 
        }
        auto   { 
            set suffix [file extension $fileName]
            if {[string length $suffix]==0} {
                return 0
            }
            set pairs [array get packSuffix]
            set index [lsearch -exact $pairs $suffix]
            if {$index==-1} {
                # assume no unpacking is needed
                return -1
            }
            incr index -1
            set command $unpackCommand([lindex $pairs $index])
        }
        freeze -
        compress -
        gzip {
            set command $unpackCommand($unpackMode)
        }
        default {
            return 0
        }
    }
    catch {eval exec $command $fileName > $unpackedFile} message
    if {[string length $message]} { 
        APSAlertBox .[APSTmpString] -errorMessage "Unable to unpack $fileName:\n$message"
        return 0
    }
    return 1
}

proc APSSetFACL {args} {
    set userList ""
    set filenameList ""
    APSStrictParseArguments {userList filenameList}
    
    if {![llength $userList] || [string compare -nocase $userList oag]==0} {
        set oagOnly 1
    } else {
        set oagOnly 0
    }
    if {!$oagOnly} {
        foreach user $userList {
            lappend acls user:$user:rwx
            lappend dacls default:user:$user:rwx
        }
    }
    lappend acls user::rwx
    lappend acls other:r-x
    lappend acls group::r-x 
    lappend acls group:oagmgr:r-x
    lappend dacls default:user::rwx
    lappend dacls default:other:r-x
    lappend dacls default:group::r-x 
    lappend dacls default:group:oagmgr:r-x
    
    set origDir [pwd]    
    foreach item $filenameList {
        if [string match *.aclOrig $item] continue
        while {[string compare [file type $item] link]==0} {
            set item [APSResolveLink $item]
        }
        if [file isdirectory $item] {
            set facls [join $acls ,],[join $dacls ,],mask:rwx,default:mask:rwx
        } else {
            set facls [join $acls ,],mask:rwx
        }
        if [catch {APSSetACL $item $facls} result] {
            return -code error "APSSetFACLOagPlus: $result"
        }
    }
}


proc APSSetACL {filename acls} {
    global env
    switch $env(HOST_ARCH) {
        Linux {
            set setOption "--set"
        }
        default {
            set setOption "-s"
        }
    }
    if ![file exists $filename.aclOrig] {
        exec getfacl $filename > $filename.aclOrig
    } 
    if [file exists $filename.aclOrig] {
        if [catch {exec setfacl $setOption $acls $filename} result] {
            return -code error "APSSetACL: $result\ncommand: setfacl $setOption $acls $filename"
        }
    }
    puts stdout "setfacl for $filename"
}

proc APSTmpDir {} {
    global apsTmpDirSet apsTmpDir
    if {[info exists apsTmpDirSet]} {
        return $apsTmpDir
    }

    global tcl_platform env 
    set attempdirs [list]
    set problems   {}

    foreach tmp {TMPDIR TEMP TMP} {
        if { [info exists env($tmp)] } {
            lappend attempdirs $env($tmp)
        } else {
            lappend problems "No environment variable $tmp"
        }
    }

    switch $tcl_platform(platform) {
        windows {
            lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"
        }
        macintosh {
            lappend attempdirs $env(TRASH_FOLDER)
        }
        default {
            lappend attempdirs \
              [file join / tmp] \
              [file join / var tmp] \
              [file join / usr tmp]
        }
    }
    lappend attempdirs [pwd]

    foreach tmp $attempdirs {
	if { [file isdirectory $tmp] && [file writable $tmp] } {
            set apsTmpDirSet 1
            set apsTmpDir [file normalize $tmp]
	    return $apsTmpDir
	} elseif { ![file isdirectory $tmp] } {
	    lappend problems "Not a directory: $tmp"
	} else {
	    lappend problems "Not writable: $tmp"
	}
    }

    # Fail if nothing worked.
    return -code error "Unable to determine a proper directory for temporary files\n[join $problems \n]"
}
