#######################################################################
# RCS: @(#) $Id: util.tcl,v 5.25 2004/09/07 12:44:28 deluca Exp $
#
# util.tcl: RTI TCL Utilities
#
# Copyright (C) 2004 Electronic Data Systems Corporation.  All Rights Reserved.
#
#######################################################################


#######################################################################
# Setup/core Routines
#######################################################################

#######################################################################
# Load a TCL program file (.tpg), if one exists
# Returns 1 if the tpg is found and loaded, 0 otherwise

proc utlLoadTPG {} {
	global PROGRAM PVDIR

	set result 0
	set tpgfile $PVDIR/lib/$PROGRAM.tpg
	if {[file exists $tpgfile]} {
		if {[catch {uplevel #0 "source \"$tpgfile\""} msg]} {
			utlInfo "WARNING: Error loading $tpgfile"
			dbg {Error loading $tpgfile:\n$msg}
		} else {
			set result 1
		}
	} else {
		set tpgfile $PVDIR/lib/common.tpg
		if {[file exists $tpgfile]} {
			if {[catch {uplevel #0 "source \"$tpgfile\""} msg]} {
				utlInfo "WARNING: Error loading $tpgfile"
				dbg {Error loading $tpgfile:\n$msg}
			} else {
				set result 1
			}
		}
	}

	dbg {-utlLoadTPG: $result}
	return $result
}


#######################################################################
# Initialize generic globals
#
# Rather than setting values of globals when util.tcl is loaded, this
# allows the code to be more well-organized.
#
# NOTE:
# This is for the first initialization only; utlGenericParams will
# handle the standard setup of the configurable globals.

proc utlInitGenericGlobals {} {

	# General globals
	global HADERROR; set HADERROR 0

	# Application control
	# To-do: move QUIET, etc. and custom console vars into RTITCLVARS
	global RTITCLVARS
	set RTITCLVARS(IPCLOG) ""

	# Output control and debug globals
	global DEBUG DEBUGVARS
	set DEBUG ""
	set DEBUGVARS(FILE) ""
	set DEBUGVARS(INDENT) 0
	set DEBUGVARS(COUNT) 0
	set DEBUGVARS(TIME) 0
	set DEBUGVARS(LEVELMAX) 100
	set DEBUGVARS(TIER) 1
	global PROCESSVARS
	set PROCESSVARS(STATE) ""
	global INFOLOCATION; set INFOLOCATION "console"
	global LOGFILES; set LOGFILES "" 
	global QUIET; set QUIET 0
	global OVERWRITE; set OVERWRITE 0
	global UTLLASTERROR; set UTLLASTERROR ""

	# Resource file globals
	global RESOURCE_VALUES; set RESOURCE_VALUES ""
	global RESOURCES_CACHE; set RESOURCES_CACHE(undefined) ""

	# File handling globals
	global TMPFILES; set TMPFILES {}
	global OPENFILES; set OPENFILES {}

	# Check whether we are first or subsequent invocation (windows only)
	global MASTER
	if {![info exists MASTER]} {set MASTER 1}

	# Verify other required globals are at least defined
	global PROGRAM
	if {![info exists PROGRAM]} {set PROGRAM ""}
	global PVDIR
	if {![info exists PVDIR]} {set PVDIR .}
}


#######################################################################
# Process generic command line parameters:
# -quiet, -pvdir, -debug, -debugf, -logfile, -overwrite, -tmpdir,
# -lowprio, -perfmeasure, -ipclog
# Returns list with remaining arguments
#
# NOTE:
# Some commands (such as QUIET, PVDIR, and TMPDIR) are set up as follows:
# 1) If the command-line option is used, always set the global to that value.
# 2) If it is not used, use the value first set when the interpreter
# started (this allows multiple utlGenericParams calls).
# 3) If the interpreter just started (i.e., this is the first call to
# utlGenericParams), use the command-line value, if it exists, or else use
# the default value.

proc utlGenericParams {argv} {
	global env GENPARAMS GENPARAMSDEFAULTS GENPARAMSLASTVAL
	global RTITCLVARS
	global QUIET PVDIR DEBUG DEBUGVARS HADERROR LOGFILES OVERWRITE
	global TMPDIR RTMPDIR LOWPRIO INFOLOCATION RESOURCE_VALUES

	# Reset special controls
	utlProcessControl -reset
	
	# Do not process generic params if this has been switched off (this is
	# used when it has already been done by a wrapper such as mainStartup, etc.).
	if {[info exists GENPARAMS(process)]} {
		if {!$GENPARAMS(process)} {
			dbg {utlGenericParams: already done (switched off) - returning $argv}
			return $argv
		}
	}

	# Initializations
	set debugf_specified 0
	set tmpdir_specified 0

	# Prepend default command arguments
	set argv [concat [utlDefault cmdargs] $argv]
	set origargv $argv

	# Set up default-value handling
	if {![info exists GENPARAMS(done)]} {
		# This is the first run of utlGenericParams, which means use
		# basic defaults, when appropriate, rather than trying to use
		# the defaults set by the first run (since this IS the first run).
		set GENPARAMS(done) 0
	}

	# Standard reinitializations
	if {$GENPARAMS(done)} {

		# Set up PVDIR (defaults to current directory)
		set PVDIR $GENPARAMSDEFAULTS(PVDIR)

		# Set up QUIET (defaults to 0)
		set QUIET $GENPARAMSDEFAULTS(QUIET)
		
		# Set up OVERWRITE (defaults to 0)
		set OVERWRITE $GENPARAMSDEFAULTS(OVERWRITE)

		# Set up LOGFILES
		set LOGFILES $GENPARAMSDEFAULTS(LOGFILES)
		set INFOLOCATION $GENPARAMSDEFAULTS(INFOLOCATION)

		# Set up DEBUG (defaults to "" (off))
		if {$DEBUG == $GENPARAMSLASTVAL(DEBUG)} {
			set DEBUG $GENPARAMSDEFAULTS(DEBUG)
		} else {
			set GENPARAMSDEFAULTS(DEBUG) $DEBUG
		}

		# Set up DEBUGVARS(FILE) (defaults to "" (none))
		if {$DEBUGVARS(FILE) == $GENPARAMSLASTVAL(DEBUGFILE)} {
			set DEBUGVARS(FILE) $GENPARAMSDEFAULTS(DEBUGFILE)
		} else {
			set GENPARAMSDEFAULTS(DEBUGFILE) $DEBUGVARS(FILE)
		}

		# Set up other DEBUGVARS
		set DEBUGVARS(TIME) $GENPARAMSDEFAULTS(DEBUGTIME)
		set DEBUGVARS(LEVELMAX) $GENPARAMSDEFAULTS(DEBUGLEVELMAX)
		set DEBUGVARS(TIER) $GENPARAMSDEFAULTS(DEBUGTIER)

		# Set up lowprio
		set LOWPRIO $GENPARAMSDEFAULTS(LOWPRIO)

	# Standard initializations
	} else {

		# Set up LOWPRIO (defaults to 0)
		if {![info exists LOWPRIO]} {
			if { [utlSysname] == "MSWindows"} {
				set LOWPRIO [utlDefaultBool "LowPrio"]
			} else {
				set LOWPRIO 0
			}
		}
	}

	# Begin to set up TMPDIR using the following hierarchy:
	# 1) -tmpdir 
	# 2) "tempFilePath" resource setting
	# 3) %TEMP% (windows) or /tmp (unix)
	# 4) An error is generated and the app quits

	if {![info exists TMPDIR]} {
		set TMPDIR [utlDefault "tempFilePath" "File Paths" "Preview"]
		if {$TMPDIR != ""} {
			set tmpdir_specified 1
		}
	} elseif {$GENPARAMS(done)} {
		set TMPDIR $GENPARAMSDEFAULTS(TMPDIR)
	}

	# Other initializations
	set RESOURCE_VALUES ""

	# Parse arguments
	set argmax [llength $argv]
	set newargv ""
	for {set ind 0} {$ind < $argmax} {incr ind} {
		set arg [lindex $argv $ind]
		dbg {utlGenericParam: parse $arg}
		switch -glob -- $arg {

		-debug {
			set DEBUG *
		}

		-debugf* { # -debugfile
			set DEBUGVARS(FILE) [lindex $argv [incr ind]]
			set debugf_specified 1
		}

		-debugl* { # -debuglevel
			set DEBUGVARS(LEVELMAX) [lindex $argv [incr ind]]
		}

		-debugt* { # -debugtier
			set DEBUGVARS(TIER) [lindex $argv [incr ind]]
		}

		-ipclog {
			set RTITCLVARS(IPCLOG) [lindex $argv [incr ind]]
		}

		-logall {
			set INFOLOCATION "both"
		}

		-logf* { # -logfile
			lappend LOGFILES [lindex $argv [incr ind]]
		}

		-lowprio {
			set LOWPRIO 1
		}

		-overwrite {
			set OVERWRITE 1
		}

		-perfmeasure {
			set DEBUGVARS(TIME) 1
		}

		-quiet {
			set QUIET 1
		}

		-resource {
			# Set up command-line resource entries
			set section [utlStringToLower [lindex $argv [incr ind]]]
			set key [utlStringToLower [lindex $argv [incr ind]]]
			set value [lindex $argv [incr ind]]
			lappend RESOURCE_VALUES [list $section $key $value]
		}

		-pvdir {
			set PVDIR [lindex $argv [incr ind]]
		}

		-tmpdir {
			set TMPDIR [lindex $argv [incr ind]]
			set tmpdir_specified 1
		}

		default {
			lappend newargv $arg
		}

		}
	}
	set argv $newargv

	# Verify/modify the value of TMPDIR

	# Verify user-defined values
	if {$TMPDIR != ""} {
		set TMPDIR [utlFullPath $TMPDIR]
		if {[regexp {[.]$} $TMPDIR]} {set TMPDIR [file dirname $TMPDIR]}
		if {![file isdirectory $TMPDIR] || ![file writable $TMPDIR]} {
			utlError "Specified temp directory \"$TMPDIR\" does not exist or is not writable.  Please verify and correct."
			set TMPDIR [utlDefault tmpdir]
		} elseif {$tmpdir_specified} {
			utlInfo "Using user-specified temp directory: $TMPDIR \n"
		}
	}

	# Use the default value
	if {$TMPDIR == ""} {
		if {[utlSysname] == "MSWindows"} {
			if {[info exists env(TEMP)]} {
				set TMPDIR $env(TEMP)
			} else {
				utlInfo "Standard temp directory specifier env(TEMP) does not exist.  Defaulting to $PVDIR/temp."
				set TMPDIR $PVDIR/temp
			}
		} else {
			set TMPDIR /tmp
		}
		if {$TMPDIR == "" || ![file isdirectory $TMPDIR] || ![file writable $TMPDIR]} {
			utlError "Standard temp directory \"$TMPDIR\" does not exist or is not writable.  Please verify and correct."
		}
	}

	# Make sure that TMPDIR uses forward slashes
	set TMPDIR [utlUnixFileName $TMPDIR]

	# The TMPDIR will be modified to a temp subdirectory value, but RTMPDIR 
	# should be static after this point.  This "root tmpdir" can be used for 
	# files that cannot be placed in a temp subdirectory.
	set RTMPDIR $TMPDIR

	# Deal with details of DEBUG
	if {$DEBUGVARS(FILE) != "" && $DEBUG == ""} {
		set DEBUG *
	}
	if {$debugf_specified} {
		if {[file dirname $DEBUGVARS(FILE)] == "." && $PVDIR == [pwd]} {
			set DEBUGVARS(FILE) "$TMPDIR/$DEBUGVARS(FILE)"
		} else {
			set DEBUGVARS(FILE) [utlFullPath $DEBUGVARS(FILE)]
		}
	}

	# Save last debug results as part of a mechanism to allow manually setting 
	# these two variables.
	set GENPARAMSLASTVAL(DEBUG) $DEBUG
	set GENPARAMSLASTVAL(DEBUGFILE) $DEBUGVARS(FILE)

	# Set up interpreter session defaults
	if {!$GENPARAMS(done)} {
		set GENPARAMS(done) 1
		set GENPARAMSDEFAULTS(TMPDIR) $TMPDIR
		set GENPARAMSDEFAULTS(QUIET) $QUIET
		set GENPARAMSDEFAULTS(OVERWRITE) $OVERWRITE
		set GENPARAMSDEFAULTS(PVDIR) $PVDIR
		set GENPARAMSDEFAULTS(LOWPRIO) $LOWPRIO
		set GENPARAMSDEFAULTS(DEBUG) $DEBUG
		set GENPARAMSDEFAULTS(DEBUGFILE) $DEBUGVARS(FILE)
		set GENPARAMSDEFAULTS(LOGFILES) $LOGFILES
		set GENPARAMSDEFAULTS(INFOLOCATION) $INFOLOCATION
		set GENPARAMSDEFAULTS(DEBUGTIME) $DEBUGVARS(TIME)
		set GENPARAMSDEFAULTS(DEBUGLEVELMAX) $DEBUGVARS(LEVELMAX)
		set GENPARAMSDEFAULTS(DEBUGTIER) $DEBUGVARS(TIER)
	}
		
	# Debug info
	dbgHeader $origargv
	dbg {utlGenericParams: TMPDIR=$TMPDIR OVERWRITE=$OVERWRITE LOGFILES=$LOGFILES PVDIR=$PVDIR}
	dbg {utlGenericParams: returning $argv}
	 
	return $argv
}


# Change the value of a generic global correctly (just "set" doesn't work)
proc utlSetGenericGlobal {key value} {
	global GENPARAMSDEFAULTS
	global $key

	set $key $value
	set GENPARAMSDEFAULTS($key) $value
}


# Turn off utlGenericParam processing
proc utlProcessGenericParamsOff {} {
	global GENPARAMS

	set GENPARAMS(process) 0
}


# Turn on utlGenericParam processing (default is on)
proc utlProcessGenericParamsOn {} {
	global GENPARAMS

	set GENPARAMS(process) 1
}


# Set or determine if the application has started (initialized) yet or
# not.
proc utlAppStarted {{arg -query}} {
	global utlAppStartedVars

	if {![info exists utlAppStartedVars(started)]} {
		set utlAppStartedVars(started) 0
	}
	if {$arg == "-query"} {
		return $utlAppStartedVars(started)
	} elseif {$arg == "-setdone"} {
		set utlAppStartedVars(started) 1
	} else {
		utlError "utlAppStarted: unknown argument \"$arg\""
	}
}

		
#######################################################################
# Start the event loop and enter a command-processing mode
# NOTE: This is for unix; windows already has an event loop built-in.

proc utlEventLoop {} {
	global utlEventLoopVars

	set utlEventLoopVars(prompt) "[utlGetProgram]> "

	fileevent stdin readable utlEventLoopCallBack
	puts -nonewline $utlEventLoopVars(prompt)
	flush stdout
	vwait forever
}


proc utlEventLoopCallBack {} {
	global utlEventLoopVars

	# Error check
	if [eof stdin] {
		utlExit
	}

	# Accumulate the text of the line
	append utlEventLoopVars(line) [gets stdin]

	# If the line is complete, execute it
	if [info complete $utlEventLoopVars(line)] {

		# Put the command into a local variable so that the global
		# can be reset before executing the command.
		set command $utlEventLoopVars(line)
		set utlEventLoopVars(line) ""

		# Execute the command and get the result
		set result ""
		catch {uplevel #0 $command} result

		# Output the result
		if {$result != ""} {
			puts $result
		}

		puts -nonewline $utlEventLoopVars(prompt)
		flush stdout
	}
}


#############################################################################
# Handle actions that need to take place when an error occurs or the
# console is closed.

proc utlRegisterCloseAction {id command} {
	global utlCloseActionVars

	# Make sure that the list exists
	if {![info exists utlCloseActionVars(actionlist)]} {
		set utlCloseActionVars(actionlist) ""
	}

	# Can't register the same id twice (indicates a need to invoke
	# the close action)
	if {[utlHas utlCloseActionVars(actionlist) id]} {
		utlCloseActions $id
	}

	# Register the close action
	utlSet utlCloseActionVars(actionlist) $id $command
}


proc utlUnregisterCloseAction {id} {
	global utlCloseActionVars

	# Don't try if no actions have been registered
	if {![info exists utlCloseActionVars(actionlist)]} {
		return
	}

	if {$id == "-all"} {
		set utlCloseActionVars(actionlist) ""
	} else {
		utlSet utlCloseActionVars(actionlist) $id ""
	}
}


proc utlCloseActions {id} {
	global utlCloseActionVars

	# Don't try if no actions have been registered
	if {![info exists utlCloseActionVars(actionlist)]} {
		return
	}

	# Set up the list of close actions
	if {$id == "-all"} {
		set actionlist $utlCloseActionVars(actionlist)
		set utlCloseActionVars(actionlist) ""
	} elseif {[utlHas utlCloseActionVars(actionlist) $id]} {
		set actionlist [list $id [utlGet utlCloseActionVars(actionlist) $id]]
		utlSet utlCloseActionVars(actionlist) ""
	} else {
		set actionlist ""
	}

	# Execute each close action
	foreach element $actionlist {
		utlFields $element id command

		dbg "Executing close action \"$id\""
		if {[catch {eval $command} msg]} {
			utlError "Close command \"$id\" generated the following error: $msg"
		}
	}
}


proc utlListCloseActions {} {
	global utlCloseActionVars

	foreach element $utlCloseActionVars(actionlist) {
		puts $element
	}
}


proc utlRegisterQuitAction {id command {option ""}} {
	global utlQuitActionVars
	dbg {>utlRegisterQuitAction: $id $command $option}

	# Make sure that the lists exists
	if {![info exists utlQuitActionVars(actionlist)]} {
		set utlQuitActionVars(actionlist) ""
		set utlQuitActionVars(firstactionlist) ""
		set utlQuitActionVars(lastactionlist)  ""
	}

	# Register the command
	# NOTE: Multiple id registers don't cause duplicate entries
	if {$option == "-first"} {
		utlSet utlQuitActionVars(firstactionlist) $id $command
	} elseif {$option == "-last"} {
		utlSet utlQuitActionVars(lastactionlist) $id $command
	} else {
		utlSet utlQuitActionVars(actionlist) $id $command
	}

	dbg {<utlRegisterQuitAction}
}


proc utlUnregisterQuitAction {id} {
	global utlQuitActionVars

	# Don't try if no actions have been registered
	if {![info exists utlQuitActionVars(actionlist)]} {
		return
	}

	if {$id == "-all"} {
		set utlQuitActionVars(actionlist) ""
	} else {
		utlSet utlQuitActionVars(actionlist) $id ""
	}
}


proc utlQuitActions {} {
	global utlQuitActionVars QUITACTIONS
	dbg {>utlQuitActions}

	# Error check
	if {![info exists utlQuitActionVars(actionlist)]} {
		set utlQuitActionVars(actionlist) ""
		set utlQuitActionVars(firstactionlist) ""
		set utlQuitActionVars(lastactionlist)  ""
	}

	# Do close actions first
	utlCloseActions -all

	# Add QUITACTIONS global to the actions for backward-compatability
	if {[info exists QUITACTIONS]} {
		utlRegisterQuitAction QUITACTIONS $QUITACTIONS
		set QUITACTIONS ""
	}

	# Construct the action list in the order specified
	set actionlist $utlQuitActionVars(firstactionlist)
	append actionlist " $utlQuitActionVars(actionlist)"
	append actionlist " $utlQuitActionVars(lastactionlist)"

	# Execute each quit action
	foreach element $actionlist {
		utlFields $element id command

		dbg "Executing quit action \"$id\" (\"$command\")"
		if {[catch {eval $command} msg]} {
			utlError "Quit command \"$id\" generated the following error: $msg"
		}
	}

	dbg {<utlQuitActions}
}


#############################################################################
# Positional List/Record Procedures
#############################################################################

# Put each element of the first argument (delimited by spaces) into the 
# variable names listed as the rest of the arguments.
proc utlFields { list args } {
	set argno 0
	foreach arg $args {
		upvar 1 $arg v$argno
		set v$argno [lindex $list $argno]
		incr argno
	}
}


# Retrieve value from Key-Value text string (e.g. PreVIEW log file entries).
# Key comparison is not case sensitive.
proc utlGetValue { string key {default ""}} {
	set key [string tolower $key]
	for {set i 0} {$i < [llength $string]} {incr i} {
		if { [string compare $key [string tolower [lindex $string $i]]] == 0} {
			return [lindex $string [expr $i+1]]
		}
	}
	return $default
}


# Retrieve filename(s) from argument list.
# Ignore any filename appearing after the keywords in $ignore.
proc utlGetFileArg {arglist {ignore {-mklog -del -matrixlog}}} {
	set result {}
	set len [llength $arglist]
	for {set i 0} {$i < $len} {incr i} {
		set arg [lindex $arglist $i]
		if {[utlIn $arg $ignore]} {
			incr i
		} elseif {[string index $arg 0] != "-"} {
			lappend result $arg
		}
	}
	dbg {utlGetFileArg: $arglist -> $result}
	return $result
}


#######################################################################
# Keyed list procedures (lists of {Key Value} pairs}
# NOTE: First parameter is by reference (the name of the keyed list)
#######################################################################

# Set/reset the value of a given key
proc utlSet { uvar args } {
	upvar 1 $uvar var
	if { ![info exists var]} { set var {}}
	for { set i 0 } {$i < [llength $args]} {incr i 2} {
		set key [lindex $args $i]
		set value [lindex $args [expr {$i + 1}]]
		if {[string length $value] == 0} {
			if {[set ind [lsearch $var "$key *"]] >= 0} {
				set var [lreplace $var $ind $ind]
			}
		} elseif {[set ind [lsearch $var "$key *"]] >= 0} {
			set var [lreplace $var $ind $ind [list $key $value]]
		} else {
			lappend var [list $key $value]
		}
	}
	# debug "utlSet: $uvar = $var"
}


# Retrieve a given key's value
# NOTE: utlGet will not maintain backslashes in the result if the value 
# is in quotes in the keyed array.  Therefore, the values should always be in
# braces.  For example, {port "c:\psout.ps"} should be {port {c:\psout.ps}} or
# else the backslash will be lost (i.e., the return value c:psout.ps).
proc utlGet { uvar key } {
	upvar $uvar var
	if {[set index [lsearch $var "$key *"]] >= 0} {
		set result [lindex $var $index]
		set result [lindex $result 1]
	} else {
		set result ""
	}
	return $result
}


# Retrieve a given key's value as integer true (1) or false (0)
proc utlGetBool { uvar key } {
	upvar $uvar var
	if {[set ind [lsearch $var "$key *"]] >= 0} {
		set result [lindex [lindex $var $ind] 1]
		if {[utlBoolean [string tolower $result]]} {
			return 1
		} 
	}
	return 0
}


# check for entry for key
proc utlHas { uvar key } {
	upvar $uvar var
	expr {[lsearch $var "$key *"] >= 0}
}


# check list if it contains any of a number of elements
proc utlContains { uvar keys } {
	upvar $uvar var
	foreach key $keys {
		if {[lsearch $var "$key *"] >= 0} {
			return 1
		}
	}
	return 0
}


# check list if it contains all of certain elements
proc utlContainsAll { uvar keys } {
	upvar $uvar var
	foreach key $keys {
		if {[lsearch $var "$key *"] < 0} {
			return 0
		}
	}
	return 1
}


# Set the values in one keyed list into the other.  In case of
# overlap, the values of the first one take precedence.
proc utlMergeKeyedLists {uvar1 uvar2} {
	upvar $uvar1 var1
	upvar $uvar2 var2

	# Error check
	if {![info exists var1]} {
		utlError "utlMergeLists: list \"$uvar1\" does not exist"
		return ""
	} elseif {![info exists var2]} {
		utlError "utlMergeLists: list \"$uvar1\" does not exist"
		return ""
	}

	set resultcvp $var2
	foreach pair $var1 {
		utlSet resultcvp [lindex $pair 0] [lindex $pair 1]
	}

	return $resultcvp
}


#######################################################################
# Operations on List or Sets
#######################################################################

# Check whether string is in list or not
proc utlIn {elem list} {
	return [expr {[lsearch $list $elem] >= 0}]
}


# Subtract list1 from list2 (in other words, return a list which 
# contains elements from list2 that are not in list1)
proc utlSubList {list1 list2} {
	set result {}
	foreach elem $list2 {
		if {[lsearch $list1 $elem] < 0} {
			lappend result $elem
		}
	}
	return $result
}


# Add an element to the list as if the list were a stack
proc utlPush {stackp value} {
	upvar $stackp stack

	set stack [lappend stack $value]
}


# Remove and return the last element from the list as if the list 
# were a stack.
proc utlPop {stackp} {
	upvar $stackp stack

	# Determine length of stack
	set max [llength $stack]

	# Error check
	if {$max == 0} {
		utlError "Stack \"$stackp\" contains no elements"
		return ""
	}

	# The last element index is one less than the length
	incr max -1
	set value [lindex $stack $max]

	# Remove the last element from the stack
	set stack [lreplace $stack $max $max]

	return $value
}


# Returns the value of the last element in the list, as if the
# list were a stack.
proc utlTop {stackp} {
	upvar $stackp stack

	# Determine length of stack
	set max [llength $stack]

	# Error check
	if {$max == 0} {
		utlError "Stack \"$stackp\" contains no elements"
		return ""
	}

	# The last element index is one less than the length
	incr max -1
	set value [lindex $stack $max]

	return $value
}


#######################################################################
# Dealing with maps (arrays)
#######################################################################

# Get the value of an element based on the index, but produce no error
# if the index is invalid (just return "")
proc utlInd { uar ind } {
	upvar 1 $uar ar
	if {[info exists ar($ind)]} {
		return $ar($ind)
	} else {
		return ""
	}
}


# Return the list of all available indices (which may be none, in
# which case return an empty list)
proc utlDomain { uar } {
	upvar 1 $uar ar
	if {[catch {set r [array names ar]}]} {
		return {}
	} else {
		return $r
	}
}


# Print an array
# NOTE: Based on "proc parray" written by "The Regents of the University 
# of California".
proc utlPrintArray a {
	upvar 1 $a array

	if [catch {array size array}] {
		error "\"$a\" isn't an array"
	}

	set maxl 0
	foreach name [lsort [array names array]] {
		if {[string length $name] > $maxl} {
			set maxl [string length $name]
		}
	}

	set maxl [expr {$maxl + [string length $a] + 2}]
	foreach name [lsort [array names array]] {
		set nameString [format %s(%s) $a $name]
		utlInfo [format "%-*s = %s" $maxl $nameString $array($name)]
	}
}


proc utlCopyArray {parray1 parray2} {
	upvar $parray1 array1
	upvar $parray2 array2

	foreach index [array names array1] {
		set array2($index) $array1($index)
	}
}


#######################################################################
# Routines to handle output and error messages
#######################################################################

# Generates an error and prints the message to standard error and the
# logfile (if it is being used).
proc utlError { msg } {
	global LOGFILES PROGRAM HADERROR UTLLASTERROR
	dbg {utlError: $msg (from [utlParentProc])}

	# On windows, pop up the console window
	utlConsole -open

	# Output the message
	puts stderr "$PROGRAM - Error: $msg"
	foreach lf $LOGFILES {
		set handle [utlOpen $lf a]
		puts $handle "$PROGRAM - Error: $msg"
		utlClose $handle
	}

	# Track the last error
	set UTLLASTERROR $msg
	set HADERROR 1
}


# Generates a message preceded by the name of the program
proc utlMessage { msg } {
	global PROGRAM LOGFILES INFOLOCATION
	dbg {utlMessage: $msg}

	if {$INFOLOCATION == "console" || $INFOLOCATION == "both"} {
		puts "$PROGRAM: $msg"
	}
	if {$INFOLOCATION == "logfile" || $INFOLOCATION == "both"} {
		foreach lf $LOGFILES {
			set handle [utlOpen $lf a]
			puts $handle "$PROGRAM: $msg"
			utlClose $handle
		}
	}
}


# Generates a message
proc utlInfo { msg } {
	global QUIET PROGRAM LOGFILES INFOLOCATION
	dbg {utlInfo: $msg}

	if {[utlIn $INFOLOCATION {console both}] && !$QUIET} {
		puts $msg
	}
	if [utlIn $INFOLOCATION {logfile both}] {
		foreach lf $LOGFILES {
			set handle [utlOpen $lf a]
			puts $handle $msg
			utlClose $handle
		}
	}
}


# Get/set where messages go: the console, the logfile, or both
proc utlInfoLocation {arg {logfiles ""}} {
	global INFOLOCATION LOGFILES

	if {$arg == "-get"} {
		utlSet info location $INFOLOCATION logfiles $LOGFILES
		return $info
	} elseif {[utlIn $arg {console logfile both}]} {
		utlSetGenericGlobal INFOLOCATION $arg
		if {$logfiles != ""} {
			utlSetGenericGlobal LOGFILES $logfiles
		}
	} else {
		utlError "Invalid info location \"$location\""
	}
}


# Message boxes
proc utlMessageBox {body {header "VisProducts"}} {
	if {[utlSysname] == "MSWindows"} {
		winmsgbox $body $header
	} else {
		utlInfo "$header: $body"
	}
}


######################################################################
# Debugging & Performance Measurements
######################################################################
# Use procedures dbg and dbgperf as interface. They are more efficient
# if debug is turned off because they don't require putting the arg together
# Global variables owned by these procedures:
# DEBUG - indicator and pattern for enabling debug trace
# DEBUGVARS(FILE) - output stream or file
# DEBUGVARS(INDENT) - output indentation to reflect procedure call nesting
# DEBUGVARS(PAUSE) - tracks the original value of DEBUG until unpaused
# DEBUGVARS(COUNT) - keep track of message line numbers
# DEBUGVARS(TIER) - the filter level of debug messages; all messages
#  greater than the level or higher are shown.
#  1 - All messages
#  2 - Marked messages only, rated at level 2
#  3 - Marked messages only, rated at level 3 (default)
#  4 - Marked messages only, rated at level 4

# Activate debug mode
proc dbgActivate {{file ""}} {
	global DEBUG DEBUGVARS
	set DEBUG *
	set DEBUGVARS(FILE) $file
}


# Check whether debugging is turned on for certain string
proc debugOn {{string *}} {
	global DEBUG
	return [string match $DEBUG $string]
}


proc dbgGetInfo {info} {
	global DEBUGVARS

	if {$info == "-filename"} {
		return $DEBUGVARS(FILE)
	} else {
		utlError "Invalid info request \"$info\""
		return ""
	}
}


# Decide whether to delete temp files or not
proc dbgSaveTempFiles {} {
	global DEBUG

	set rcval [utlDefault dbgSaveTempFiles]
	if {$rcval == ""} {
		# Default case: if debug on, save files, otherwise delete
		if {$DEBUG == ""} {
			return 0
		} else {
			return 1
		}
	} else {
		return [utlBoolean $rcval]
	}
}


# Print out debug message if debug is turned on.
# Can go to stream or file that is closed every time.
# Special characters in front of msg tell us whether entering (">")
# or leaving ("<") procedure. Use dbg with braced string, debug with quoted string.
proc dbg {command {tier 3}} {
	global DEBUG

	# This is a good place to yield, since there are dbg statement scattered
	# regularly throughout the code.
	utlConsoleYield

	# Output debug info if debug mode active
	if {$DEBUG != ""} {
		if [catch {set result [uplevel 1 concat $command]} msg] {
			debug "Error in dbg command ($command) : $msg" $tier
		} else {
			debug $result $tier
		}
	}
}


proc debug { msg {tier 3}} {
	global DEBUG DEBUGVARS

	if { $DEBUG != "" && [string match $DEBUG $msg] && ($tier >= $DEBUGVARS(TIER))} {

		# Initializations
		set prefix "DBG"
		set bMarked 0

		# Begin-type message
		if {[string index $msg 0] == "<" && $DEBUGVARS(INDENT) > 0} {
			incr DEBUGVARS(INDENT) -1
			set bMarked 1
		}

		# Determine indention
		set spaces ""
		for {set i 1} {$i <= $DEBUGVARS(INDENT)} {incr i} {append spaces "  "}

		# End-type message
		if {[string index $msg 0] == ">"} {
			incr DEBUGVARS(INDENT)
			set bMarked 1
		}

		# Marked message
		if {[string index $msg 0] == "-"} {
			set bMarked 1
		}

		# Prefix information
		if {$DEBUGVARS(COUNT)} {
			append prefix "#$DEBUGVARS(COUNT)"
			incr DEBUGVARS(COUNT)
		}

		# Output message, if within the right level and tier 1 or marked
		if {$DEBUGVARS(INDENT) <= $DEBUGVARS(LEVELMAX)} {
			if {$DEBUGVARS(TIER) == 1 || $bMarked} {
				# Standard message
				dbgPuts "${prefix}:$spaces$msg"

				# Output trailer line, if necessary
				if {$DEBUGVARS(TIME) && $bMarked} {
					dbgPuts "${prefix}:${spaces}TIME:[rtiTime]"
				}
			}
		}

	}
}


proc dbgPause {} {
	global DEBUG DEBUGVARS

	set DEBUGVARS(PAUSE) $DEBUG
	set DEBUG ""
}


proc dbgUnpause {} {
	global DEBUG DEBUGVARS

	if {[info exists DEBUGVARS(PAUSE)] && $DEBUGVARS(PAUSE) != ""} {
		set DEBUG $DEBUGVARS(PAUSE)
		set DEBUGVARS(PAUSE) ""
	}
}


proc dbgSetIndent {indent} {
	global DEBUGVARS

	set DEBUGVARS(INDENT) $indent
}


# Print out time for performance measurements with debug info
# Special characters in front of msg tell us whether entering (">"),
# leaving ("<"), or reaching intermediate step ("-") in activity.

proc dbgperf {msg} {
	global DEBUG PERFMEASURE

	# Output debug info if debug mode active
	if {$DEBUG != ""} {
		if [catch {set result [uplevel 1 concat $msg]} cmsg] {
			debug "Error in dbg command ($command) : $cmsg"
		} else {
			debug $result
		}
	}

	if {[info exists PERFMEASURE(state)] && $PERFMEASURE(state)} {
		catch {set msg [uplevel 1 concat $msg]}
		PerfMeasure $msg
	}
}


proc PerfMeasure {tag} {
	global PERFMEASURE
	if {$PERFMEASURE(state)} {
		catch {set tag [uplevel 1 concat $tag]}
		set label [string range [lindex $tag 0] 1 end]
		set t [utlDateTime -timestring]
		
		if {[string index $tag 0] == ">"} {
			dbgPuts "Bgn $label at $t ([lrange $tag 1 end])"
			set PERFMEASURE($label) [utlTime2Secs $t]
		} elseif {[string index $tag 0] == "<"} {
			set t1 "??"
			catch {set t1 [expr {[utlTime2Secs $t] - $PERFMEASURE($label)}]}
			dbgPuts "End $label at $t, used $t1 s ([lrange $tag 1 end])"
		} elseif {[string index $tag 0] == "-"} {
			set t1 "??"
			catch {set t1 [expr {[utlTime2Secs $t] - $PERFMEASURE($label)}]}
			dbgPuts "In  $label at $t, used $t1 s ([lrange $tag 1 end])"
		} else {
			dbgPuts "In  $label at $t ([lrange $tag 1 end])"
		}
	}
}


# Write a line to debug output
proc dbgPuts {line} {
	global DEBUGVARS
	if {$DEBUGVARS(FILE) == ""} {
		puts $line
	} else {
		set f [open $DEBUGVARS(FILE) a]
		puts $f $line
		close $f
	}
}


# Stop without processing any further code
proc dbgForceStop {} {
	utlError "dbgForceStop: Forced stop in [utlParentProc]"

	utlUnregisterCloseAction -all
	utlUnregisterQuitAction -all

	error ""
}


# Pause/unpause execution of the code
proc dbgPauseExec {} {
	global DEBUGVARS

	utlInfo "Pausing execution in [utlParentProc]"
	set DEBUGVARS(PAUSEEXEC) 1
	while {$DEBUGVARS(PAUSEEXEC)} {
		utlSleep 1
	}
}


proc dbgUnpauseExec {} {
	global DEBUGVARS

	set DEBUGVARS(PAUSEEXEC) 0
}


# Outputs the names of all the procs currently on the stack
proc utlCallTrace {{file stdout}} {
	puts $file "#####################################"
	puts $file "TCL Call Trace"
	for {set x [expr [info level] -1]} {$x > 0} {incr x -1} {
		puts $file "$x: [info level $x]"
	}
	puts $file "#####################################"
}


# Returns the name of the proc that invoked the current proc
proc utlParentProc {} {
	return [lindex [info level [expr [info level] - 2] ] 0]
}


# Write a header of important information to debug output
proc dbgHeader {command} {
	global DEBUG DEBUGVARS
	global PROGRAM PVDIR TMPDIR MASTER rtitclAPPNAME VERSION

	if { $DEBUG != "" } {

		# Don't allow other debug statements for now
		set origdebug $DEBUG
		dbgPause

		# Write out the info
		dbgPuts "********** DEBUG SESSION **********"
		dbgPuts "DEBUG: $origdebug (to \"$DEBUGVARS(FILE)\")"
		dbgPuts "CURRENT DATE AND TIME: [utlGetDate] [utlGetTime]"
		dbgPuts "OS: [utlSysname -long]"
		dbgPuts "PROGRAM: $PROGRAM"
		dbgPuts "PVDIR: $PVDIR"
		dbgPuts "TMPDIR: $TMPDIR"
		dbgPuts "MASTER: $MASTER"
		dbgPuts "Main version: $VERSION"
		dbgPuts "TCL version: [info tclversion]"
		dbgPuts "COMMAND: $command"
		if {[utlSysname] == "MSWindows"} {
			dbgPuts "Exec version: [utlInterpVersion -exec]"
			dbgPuts "Dll version: [utlInterpVersion]"
			dbgPuts "APPNAME: $rtitclAPPNAME"
		}
		dbgPuts " "

		# Switch debugging back to the original state
		dbgUnpause
	}
}


#######################################################################
# Special debugging to track spooler problems on Windows.  This writes
# log messages to the file specified by SpoolerDebugFile.
#
proc utlSpoolerDbg {message} {

	# add date/time stamp to message
	set date [utlGetDate "04y02m02d"]
	set time [utlGetTime "x02h02m02s"]
	set msg ""
	if {[catch {set msg [uplevel 1 concat $message]} dmsg]} {
		set msg "Error in dbg command ($message) : $dmsg"
	}
	set timed_msg "$date:$time:[pid]>>> $msg"

	# check for spooler debug file
	set dbgfile [utlDefault SpoolerDebugFile]
	if {[string length $dbgfile] > 0} {
		# log message and return
		utlConcatFile $dbgfile $timed_msg 0
	}

	# add message to main debug file
	dbg {$timed_msg}
}


# Check the balance of parenthesis, brackets, braces, and quotes in a 
# given file.  Displays any problems and the totals.
#
# Parameters:
# filename: The file to check.
# startline: This may be 1 or another line number (default is 1).
# endline: This may be "end" or a line number (default is "end").
# maxerrors: The maximum number of errors that may be encoutered and
# displayed (the routine quits if it reaches this amount).  It may be
# set to a number or "all".  The default is 10.
#
# NOTE: This routine doesn't check for the more complex cases.  For
# example, it will count a single quote being used as an apostrophe in
# a comment as a single quote.  Therefore, the most useful way to use
# this routine is by using particular line ranges to avoid special cases.
  
proc utlCheckBalance {filename {startline {1}} {endline {end}} {maxerrors 10}} {
	set parens 0; set lparentotal 0; set rparentotal 0
	set brackets 0; set lbrackettotal 0; set rbrackettotal 0
	set braces 0; set lbracetotal 0; set rbracetotal 0
	set dquotetotal 0
	set squotetotal 0
	set stack ""
	set errors 0
	set stop 0

	set linenumber 1
	set handle [utlOpen $filename "r"]
	fileproc $handle line * {

		# Do not process lines outside the indicated range
		if {$linenumber < $startline} {
			incr linenumber
			continue
		} elseif {$endline == "end"} {
			# Do not try to check next "elseif"
		} elseif {$linenumber > $endline} {
			break
		}

		# Initializations
		set escape 0
		set linelength [string length $line]

		# Process each character in the line
		for {set index 0} {$index < $linelength} {incr index} {

			# Quit if there are too many errors
			if {$maxerrors != "all"} {
				if {$errors == $maxerrors} {
					set stack ""
					utlInfo "\nStopped due to reaching error limit ($maxerrors)"
					set stop 1
					break
				}
			}

			# Do not check this character if it is an escape character
			if {$escape} {
				set escape 0
				continue
			}

			# Check if the character is one that needs to be processed
			set char [string index $line $index]
			switch -- $char {
				"(" {
					incr lparentotal; incr parens
					utlPush stack "("
				}
				")" {
					incr rparentotal; incr parens -1
					if {$parens < 0} {
						incr errors
						utlInfo "Line $linenumber, char $index: Parenthesis unmatched"
					} else {
						set lastchar [utlPop stack]
						if {$lastchar != "("} {
							incr errors
							utlInfo "Line $linenumber, char $index: Last delimiter \"$lastchar\" does not match \")\""
						}
					}
				}
				"[" {
					incr lbrackettotal; incr brackets
					utlPush stack "\["
				}
				"]" {
					incr rbrackettotal; incr brackets -1
					if {$brackets < 0} {
						incr errors
						utlInfo "Line $linenumber, char $index: Bracket unmatched"
					} else {
						set lastchar [utlPop stack]
						if {$lastchar != "\["} {
							incr errors
							utlInfo "Line $linenumber, char $index: Last delimiter \"$lastchar\" does not match \"\]\""
						}
					}
				}
				"\{" {
					incr lbracetotal; incr braces
					utlPush stack "\{"
				}
				"\}" {
					incr rbracetotal; incr braces -1
					if {$braces < 0} {
						incr errors
						utlInfo "Line $linenumber, char $index: Brace unmatched"
					} else {
						set lastchar [utlPop stack]
						if {$lastchar != "\{"} {
							incr errors
							utlInfo "Line $linenumber, char $index: Last delimiter \"$lastchar\" does not match \"\}\""
						}
					}
				}
				"\"" {
					incr dquotetotal
					if {[utlTop stack] == "dquote"} {
						utlPop stack
					} else {
						utlPush stack "dquote"
					}
				}
				"\'" {
					incr squotetotal
					if {[utlTop stack] == "squote"} {
						utlPop stack
					} else {
						utlPush stack "squote"
					}
				}
				"\\" {
					# The next character is an escape character
					set escape 1
				}
			}
		}
		incr linenumber
		if {$stop} break
				
	}
	utlClose $handle

	# Summary of results
	utlInfo "\nSummary of Results:\n"
	while {[llength $stack] > 0} {
		incr errors
		utlInfo "Unmatched [utlPop stack]"
	}
	if {$lparentotal != $rparentotal} {
		incr errors
		utlInfo "Parenthesis unbalanced: left=$lparentotal, right=$rparentotal"
	} else {
		utlInfo "Parenthesis pairs=$lparentotal"
	}
	if {$lbrackettotal != $rbrackettotal} {
		incr errors
		utlInfo "Brackets unbalanced: left=$lbrackettotal, right=$rbrackettotal"
	} else {
		utlInfo "Bracket pairs=$lbrackettotal"
	}
	if {$lbracetotal != $rbracetotal} {
		incr errors
		utlInfo "Braces unbalanced: left=$lbracetotal, right=$rbracetotal"
	} else {
		utlInfo "Brace pairs=$lbracetotal"
	}
	utlInfo "Double quotes total=$dquotetotal"
	utlInfo "Single quotes total=$squotetotal"
	utlInfo "Total errors=$errors"
}


proc dbgPromptRM {file} {

	puts -nonewline "Delete $file? "
	set answer [utlGetsStdin]
	if {$answer == "y"} {
		puts "utlRM: [utlRM $file]"
	}
}


#######################################################################
# General Functions
#######################################################################

#######################################################################
# Return the integer result of any boolean name
# Options are:
# -defaulttrue: non-boolean values like "" default to true
# -defaultfalse: non-boolean values like "" default to false
# -mustexist: "" generates a "" result

proc utlBoolean {val {option -defaultfalse}} {

	# True
	if {[utlIn $val {1 true on yes}]} {
		return 1

	# False
	} elseif {[utlIn $val {0 false off no}]} {
		return 0

	# Undefined
	} elseif {$val == ""} {
		if {$option == "-mustexist"} {
			return ""
		} elseif {$option == "-defaulttrue"} {
			return 1
		} elseif {$option == "-defaultfalse"} {
			return 0
		} else {
			utlError "utlBoolean: invalid option \"$option\""
			return ""
		}

	} else {
		utlError "utlBoolean: invalid boolean value \"$val\""
		return ""
	}
}


#######################################################################
# Execute a command, but also handle errors and write debug info

proc utlCommand args {
	dbg {>utlCommand: $args}

	set result ""
	if [catch {
		set result [eval [concat $args]]
	} msg] {
		dbg {*** Caught error for \"$args\": $msg}
	}

	dbg {<utlCommand: $result}
	return $result
}


######################################################################
# utlConsole
# Activate a console-based function

proc utlConsole {arg} {
	global PROGRAM

	# Currently not needed on unix
	if {[utlSysname] != "MSWindows"} {
		return
	}

	# Don't ever try to manipulate a console for pvext
	if {$PROGRAM == "pvext"} {
		return
	}

	if {$arg == "-open"} {
		# NOTES: 
		# 1) 274=WM_SYSCOMMAND, 61728=SC_RESTORE
		# 2) catch is needed because pvext causes an error
		catch {winpost self 274 61728 0}
	}
}


#######################################################################
# Let the windows console update

proc utlConsoleYield {} {
	if {[utlSysname] == "MSWindows"} {
		global PROCESSVARS

		# Deal with special states of the process
		if {$PROCESSVARS(STATE) != ""} {

			# Check for process stop
			if {$PROCESSVARS(STATE) == "quit"} {
				set PROCESSVARS(STATE) ""
				error ""
			}

			# Check for process pause
			while {$PROCESSVARS(STATE) == "pause"} {
				utlSleep 1
			}
		}

		# Do the console yield
		console_yield
	}
}


######################################################################
# Control the current process

proc utlProcessControl {arg} {
	global PROCESSVARS

	if {$arg == "-stop"} {
		set PROCESSVARS(STATE) quit
	} elseif {$arg == "-pause"} {
		set PROCESSVARS(STATE) pause
	} elseif {$arg == "-unpause"} {
		set PROCESSVARS(STATE) ""
	} elseif {$arg == "-reset"} {
		set PROCESSVARS(STATE) ""
	} else {
		utlError "utlProcessControl: Unknown command \"$arg\""
	}

	return ""
}


######################################################################
# utlIsNumber
# Returns integer bool if this given string is a number

proc utlIsNumber {string} {
	set result [regexp {^[1-90\.]+$} $string]
	dbg {utlIsNumber: $result}
	return $result
}


######################################################################
# Generate a unique string

proc utlUniqueString {{prefix ""} {postfix ""}} {

	# Create string
	set strIndex [format %.3d [expr [utlUniqueNumber] % 1000]]
	set strResult "$prefix[utlDateTime -reversedtimestring][pid]$strIndex$postfix"

	return $strResult
}


proc utlUniqueNumber {} {

	# Simulate static variable by using a global
	global utlUniqueNumberVars
	if {![info exists utlUniqueNumberVars(index)]} {
		set utlUniqueNumberVars(index) 0
	}

	set result $utlUniqueNumberVars(index)
	incr utlUniqueNumberVars(index)

	return $result
}

	
######################################################################
# Get date/time information
# NOTE: This should be the only entry point to rtiTime, which allows
# changes to tcl code globally if rtiTime gets altered.

proc utlDateTime {{request "-fields"}} {
	set datetime [rtiTime]
	set year [string range $datetime 0 3]
	set month [string range $datetime 4 5]
	set day [string range $datetime 6 7]
	set hour [string range $datetime 9 10]
	set min [string range $datetime 11 12]
	set sec [string range $datetime 13 14]

	if {$request == "-fields"} {
		utlSet datetimelist year $year month $month day $day 
		utlSet datetimelist hour $hour min $min sec $sec
		return $datetimelist
	} elseif {$request == "-fullstring"} {
		return $datetime
	} elseif {$request == "-datestring"} {
		return [string range $datetime 0 7]
	} elseif {$request == "-timestring"} {
		return [string range $datetime 9 14]
	} elseif {$request == "-reversedtimestring"} {
		return $sec$min$hour
	} else {
		utlError "Invalid command \"$request\" in utlTime"
	}
}


######################################################################
# Get the time in the specified format
# fmt: format specifier (case insensitive)
# H = hour
# M = minutes
# S = seconds
# A = AM/PM setting
# X = triggers military time
# N = triggers non-military time
# H/M/S may be preceeded by a number representing the string length
# for the substituted hour/minutes/seconds value. If this number begins
# with a zero, then the value is padded on the left by zeros.  If this
# number is less than the string length of the value, then the value
# is truncated on the left.
#
# For example (assuming the time is 4:30:07PM):
# fmt              return value
# -------------------------------
# "H:M:S A"        "4:30:7 PM"
# "2H-2M-2S A"     " 4-30- 7 PM"
# "02H.02M.02S"    "04.30.07"
# "XHM N(H:M A)"   "1630 (4:30 PM)"
# "N02H:02M:02S"   "04:30:07"       # note this is the default setting

proc utlGetTime {{fmt ""}} {

	# get format string
	if {[string length $fmt] == 0} {
		set fmt [utlDefaultConverter TimeFormat]
		if {[string length $fmt] == 0} {
			# use default format string based on language
			if {[utlLanguage] == "English"} {
				set fmt "N02H:02M:02S"
			} else {
				set fmt "XH:M:S"
			}

			# use default format string
			dbg {Using default time format: $fmt}
		} else {
			dbg {Using TimeFormat time format: $fmt}
		}
	} else {
		dbg {Using command time format: $fmt}
	}

	# get year, month, and day
	set datetime [utlDateTime]
	set hour [string trimleft [utlGet datetime hour] 0]
	set min [string trimleft [utlGet datetime min] 0]
	set sec [string trimleft [utlGet datetime sec] 0]
	if {[string length $hour] == 0} {set hour 0}
	if {[string length $min] == 0} {set min 0}
	if {[string length $sec] == 0} {set sec 0}

	# build result string (parse format string left to right)
	set fmt [string toupper $fmt]
	set strlen [string length $fmt]
	set digits ""
	set military 0
	for {set idx 0} {$idx < $strlen} {incr idx} {
		set char [string index $fmt $idx]

		switch -- $char {
			H -
			M -
			S {
				# set hour/minutes/seconds value
				if {$char == "H"} {
					if {$military} {
						set val $hour
					} elseif {$hour == 0} {
						set val 12
					} elseif {$hour > 12} {
						set val [expr {$hour - 12}]
					} else {
						set val $hour
					}
				} elseif {$char == "M"} {
					set val $min
				} else {
					set val $sec
				}

				# format value if necessary
				if {[string length $digits] > 0} {
					set dlen [string trimleft $digits 0]
					if {[string length $dlen] == 0} {set dlen 0}
					set vlen [string length $val]
					if {$dlen < $vlen} {
						# truncate value from left, if necessary
						set val [string range $val [expr {$vlen - $dlen}] end]
					} else {
						# format the year/month/day
						set val [format "%${digits}d" $val]
					}
				}

				# append hour/minutes/seconds to result
				append result $val
				set digits ""
			}
			A { # AM/PM setting
				if {$military} {
					# don't do anything if we're in military mode
				} elseif {$hour < 12} {
					append result "AM"
				} else {
					append result "PM"
				}
			}
			X { # trigger military time
				set military 1
			}
			N { # trigger non-military time
				set military 0
			}
			default {
				# if it's a digit, then save it to digits string
				if {[regexp {[0-9]} $char]} {
					append digits $char

				# append any other character to the result string
				} else {
					append result ${digits}${char}
					set digits ""
				}
			}
		}
	}

	# add any remaining digits specified
	append result $digits
	dbg {utlGetTime: the time is ($fmt) -> ($result)}
	return $result
}


######################################################################
# Get date in format specified
# fmt: format specifier (case insensitive)
# Y = year
# M = month
# D = day
# Y/M/D may be preceeded by a number representing the string length
# for the substituted year/month/day value. If this number begins with
# a zero, then the value is padded on the left by zeros.  If this
# number is less than the string length of the value, then the value
# is truncated on the left.
#
# For example (assuming the date is March 5th in the year 2001):
# fmt              return value
# -------------------------------
# "M/D/Y"          "3/5/2001"
# "4Y-2M-2D"       "2001- 3- 5"
# "02D.02M.02Y"    "05.03.01"
# "03Y#03M#03D"    "001#003#005"
# "02M/02D/04Y"    "03/05/2001"    # this is the default setting

proc utlGetDate {{fmt ""}} {

	# get format string
	if {[string length $fmt] == 0} {
		set fmt [utlDefaultConverter DateFormat]
		if {[string length $fmt] == 0} {
			# use default format string based on language
			if {[utlLanguage] == "English"} {
				set fmt "M/D/Y"
			} else {
				set fmt "D/M/Y"
			}
			dbg {Using default date format: $fmt}
		} else {
			dbg {Using DateFormat date format: $fmt}
		}
	} else {
		dbg {Using command date format: $fmt}
	}

	# get year, month, and day
	set datetime [utlDateTime]
	set year [string trimleft [utlGet datetime year] 0]
	set month [string trimleft [utlGet datetime month] 0]
	set day [string trimleft [utlGet datetime day] 0]
	if {![regexp {[0-9]+ [0-9]+ [0-9]+} "$year $month $day"]} {
		utlError "Could not get date and time info"
		return ""
	}

	# build result string (parse format string left to right)
	set fmt [string toupper $fmt]
	set strlen [string length $fmt]
	set digits ""
	for {set idx 0} {$idx < $strlen} {incr idx} {
		set char [string index $fmt $idx]

		# if it's a digit, then save it to digits string
		if {[regexp {[0-9]} $char]} {
			append digits $char

		# process the year, month, or day
		} elseif {[utlIn $char {Y M D}]} {
			# set value
			if {$char == "Y"} {
				set val $year
			} elseif {$char == "M"} {
				set val $month
			} else {
				set val $day
			}

			# format year/month/day if necessary
			if {[string length $digits] > 0} {
				set dlen [string trimleft $digits 0]
				if {[string length $dlen] == 0} {set dlen 0}
				set vlen [string length $val]
				if {$dlen < $vlen} {
					# truncate value from left, if necessary
					set val [string range $val [expr {$vlen - $dlen}] end]
				} else {
					# format the year/month/day
					set val [format "%${digits}d" $val]
				}
			}

			# append year/month/day to result
			append result $val
			set digits ""

		# append any other character to the result string
		} else {
			append result ${digits}${char}
			set digits ""
		}

	}

	# add any remaining digits specified
	append result $digits
	dbg {utlGetDate: the date is ($fmt) -> ($result)}
	return $result
}


######################################################################
# Returns the given month name as a month number

proc utlMonthToInt {name} {
	set name [string tolower $name]
	switch -glob $name {
		ja* {set result 1}
		f* {set result 2}
		mar* {set result 3}
		ap* {set result 4}
		may {set result 5}
		jun* {set result 6}
		jul* {set result 7}
		au* {set result 8}
		s* {set result 9}
		o* {set result 10}
		n* {set result 11}
		d* {set result 12}
		default {
			utlError "Month \"$name\" not valid"
			return ""
		}
	}
	return $result
}	


######################################################################
# Converting HHMMSS into seconds

proc utlTime2Secs {time} {
	set t2 0
	set t2 [expr {[string index $time 0] * 36000 + \
				  [string index $time 1] *	3600 + \
				  [string index $time 2] *	 600 + \
				  [string index $time 3] *	  60 + \
				  [string index $time 4] *	  10 + \
				  [string index $time 5]   }]
	return $t2
}


######################################################################
# Get a text string from standard input.  On windows, this currently
# requires a special command.
# NOTE: For windows, this requires the 990606 interpreter or later.

proc utlGetsStdin {} {
	if {[utlSysname] == "MSWindows"} {
		set result [console_gets]
	} else {
		gets stdin result
	}
	return $result
}


######################################################################
# Entry point for using interp_version (returns build date).  Also 
# translates version info into numeric string when using 
# "-datenumber".

proc utlInterpVersion {{opt ""}} {
	dbg {>utlInterpVersion: $opt}

	set error 0
	if {[utlIn $opt {"-exec" "-exe"}]} {
		set error [catch {set version [interp_version -exec]}]
	} else {
		set error [catch {set version [interp_version]}]
	}
	if {$error} {
		# The interp_version command isn't even implimented in this
		# version of the interpreter.
		dbg {<utlInterpVersion: Not available}
		return 0
	}

	if {$opt == "-datenumber"} {
		utlFields $version month day year
		set month [format "%.2d" [utlMonthToInt $month]]
		set day [format "%.2d" $day]
		set version "${year}${month}${day}"
	}

	dbg {<utlInterpVersion: $version}
	return $version
}


######################################################################
# Determine if the tcl version is at least the requested version.

proc utlTclVersionAt {requested_version {error -noerror}} {
	if {[info tclversion] >= $requested_version} {
		return 1
	} elseif {$error == "-error"} {
		utlError "The requested action requires an interpreter based on tcl version $requested_version or later"
		return 0
	} else {
		return 0
	}
}


######################################################################
# Determine if interpreter build date is at least the requested date.

proc utlInterpVersionAt {year {month january} {day 1}} {

	set currentnum [utlInterpVersion -datenumber]
	if {$currentnum == 0} {
		return 0
	}

	set month [format "%.2d" [utlMonthToInt $month]]
	set day [format "%.2d" $day]
	set comparenum "${year}${month}${day}"

	if {$currentnum >= $comparenum} {
		return 1
	} else {
		return 0
	}
}


#######################################################################
# Entry point for retrieving various peices of version information.
# NOTE: This should be used rather than direct variables, etc. since
# the way those are implimented may change.  The way this routine is
# called and the format of the information it returns won't change.

proc utlVersion {infotype} {
	global VERSION PROGRAM PVEXT

	# Determine standard version number information
	if {$VERSION == "(dev)"} {
		set baseversion "(dev)"
		set subversion1 "(dev)"
		set subversion2 "(dev)"
	} else {
		set baseversion [string index $VERSION 0]
		set subversion1 [string index $VERSION 2]
		set subversion2 [string index $VERSION 4]
	}

	# Return requested information
	switch $infotype {
		version {
			return $VERSION
		}
		baseversion {
			return $baseversion
		}
		subversion -
		subversion1 {
			return $subversion1
		}
		subversion2 {
			return $subversion2
		}
		productline {
			# The product line can be explicitly defined or else is determined by
			# the version number and program.
			set productlinesetting [utlDefault ProductLine]
			if {[info exists PVEXT(PROGRAM)]} {
				set pvextprog $PVEXT(PROGRAM)
			} else {
				set pvextprog ""
			}

			if {$PROGRAM == "pvext" && [utlIn $pvextprog {VISVIEW PREVIEW}]} {
				# A program using pvext can explicitly define itself
				set productline $pvextprog
			} elseif {[utlIn $productlinesetting {VISVIEW PREVIEW}]} {
				# The resource entry can force the result
				set productline $productlinesetting
			} elseif {[string match "5.*" $VERSION]} {
				# For now, version 5 and above indicates PreView.
				# (this will need to change eventually)
				set productline PREVIEW
			} elseif {$PROGRAM == "pvext" && [winexists "" "PreVIEW*"]} {
				# Try to decide if VisView or PreView invoked pvext.
				set vvexists [winexists "" "VisView Standard*"]
				set vvexists [expr $vvexists || [winexists "" "VisMock*"]]
				set vvexists [expr $vvexists || [winexists "" "VisView Pro*"]]
				set vvexists [expr $vvexists || [winexists "" "VisView 2d*"]]
				if {!$vvexists && [utlDefault ProductV "Pvwm Setup"] == 8} {
					set productline PREVIEW
				} else {
					set productline VISVIEW
				}
			} else {
				# Default to VisView
				set productline VISVIEW
			}
			return $productline
		}
		default {
			utlError "utlVersion: Unknown argument \"$infotype\""
		}
	}
}


#######################################################################
# UNC-compatible pwd command (strips drive letter and colon from UNC path)

proc utlPWD {} {
	set dir [pwd]
	regexp {^[a-zA-Z]:(//.+)$} $dir _ dir
	return $dir
}

#######################################################################
# Capitalize the first character in a string.  E.g., in utlDefault
# sets the program name to "Prepare" instead of "prepare."
#
# NOTE: this function is NOT internationalized
#
proc utlStringToTitle { str } {
	return [string toupper [string index $str 0]][string range $str 1 end]
}

#######################################################################
# Change the case of a string correctly by taking the OS language
# into consideration (it is not correct to change the case for some
# international character sets with the "string tolower" command).
# Flags are always set to lower.

proc utlStringToLower { filename } {
	if {[string compare [string index $filename 0] "-"] == 0} {
		return [string tolower $filename]
	}
	if {[utlIn [utlLanguage] {"" "English"}]} {
		return [string tolower $filename]
	} else {
		return $filename
	}
}


#######################################################################
# Exit interpreter session

proc utlExit {} {
	global HADERROR

	if { [utlSysname] == "MSWindows" } {
		# NOTE: Don't use exit in Windows because it pops up
		# the Program Manager.
		winkill self
	} else {
		exit
	}
}


#######################################################################
# Waiting for N sec

proc utlSleep {sec} {
	dbg {utlSleep: $sec}
	sleep ${sec}000
}


#######################################################################
# Yield for a second to let other processes work

proc utlYield {{when -lowprio}} {
	global LOWPRIO

	if { $when != "-lowprio" && $LOWPRIO } {
		if { [utlSysname] == "MSWindows" } {
			utlSleep 1
		} else {
			# don't do anything on UNIX (for now)
		}
	} else {
		utlSleep 1
	}
}


#######################################################################
# Watch mode: eval a command repeatedly at a timed interval
#
# Platform differences:
#    Windows: Evaluate and then post as next command so that other
#     commands can get in between (e.g., drag&drop)
#    Unix: Either use the tcl event loop (default) or else use a simple
#     loop (set event to "-none")
#
# NOTES:
#    Stopping watch mode: Setting the global "WATCHMODESTOP" will stop 
#     all watch mode commands.  This can be done at the command-line 
#     (if an event loop makes this available) or by the watch mode 
#     command.  A watch command returning an error value may
#     also use "WATCHMODESTOP".

proc utlWatchMode {command pause {event -first}} {
	global utlWatchModeVars WATCHMODESTOP
	dbg {>utlWatchMode $command $pause $event}

	# Indicate that watch mode is active
	set utlWatchModeVars(WATCHMODEACTIVE) 1

	# Check for a request to stop watch mode
	if {[info exists WATCHMODESTOP]} {
		if {$WATCHMODESTOP} {
			# Reset stop
			set WATCHMODESTOP 0
			set utlWatchModeVars(WATCHMODEACTIVE) 0

			# Do not leave the application
			return -wait
		}
	}

	# Check for intermediate control
	if {[info exists utlWatchModeVars(setpause)]} {
		if {$utlWatchModeVars(setpause) != ""} {
			set pause $utlWatchModeVars(setpause)
			set utlWatchModeVars(setpause) ""
		}
	}

	# Windows method
	if {[utlSysname] == "MSWindows"} {

		# Evaluate the command and process the result
		set msg ""
		set stop 0

		dbg {Evaluating command}
		set bStatus [catch {eval $command} msg]
		dbg {Return status of command=$bStatus, message=$msg}
		if {$bStatus && $msg == "WATCHMODEEXIT"} {
			set utlWatchModeVars(WATCHMODEACTIVE) 0
			# Leave the top level loop
			utlExit
		} elseif {$msg == "WATCHMODESTOP"} {
			set utlWatchModeVars(WATCHMODEACTIVE) 0
			# Do not leave the application
			return -wait
		} elseif {[debugOn *] && $msg != ""} {
			dbg {utlWatchMode: got msg=$msg}
		}

		# PR4342727: The following commands were commented out
		# because the winpost method was causing a crash
		# after about 250 times
		# Pause and then post the command to be executed again
		# utlSleep $pause
		# msg is WM_USER+30 (WM_TCL_EXECUTE)
		# winpost self 1054 0 [list !utlWatchMode $command $pause]
		after [expr {$pause * 1000}] utlWatchMode [list $command] $pause

	# Start the event loop
	} elseif {$event == "-first"} {

		if {[utlDefaultBool WatchModePrompt "" -defaulttrue]} {
			after 1 utlWatchMode [list $command] $pause -event
			utlInfo "Entering watch mode interactive mode"
			utlInfo "(enter further standard commands, or \"exit\")\n"
			utlEventLoop
		} else {
			utlWatchMode $command $pause -none
		}

	# This is a callback started by the initial call
	} elseif {$event == "-event"} {
		set msg ""
		if {[catch {eval $command} msg] && $msg == "stop watch mode"} {
			set utlWatchModeVars(WATCHMODEACTIVE) 0
			# Leave the top level loop
			utlExit
		} elseif {$msg == "WATCHMODESTOP"} {
			set utlWatchModeVars(WATCHMODEACTIVE) 0
			# Do not leave the application
			return -wait
		} elseif {[debugOn *] && $msg != ""} {
			dbg {utlWatchMode: got msg=$msg}
		}
		set pausetime [expr $pause * 1000]
		after $pausetime utlWatchMode [list $command] $pause -event

	# Use a simple loop rather than the event loop
	# NOTE: Will prevent user interaction
	} elseif {$event == "-none"} { 
		while {1} {
			set msg ""
			if {[catch {eval $command} msg] && $msg == "WATCHMODEEXIT"} {
				set utlWatchModeVars(WATCHMODEACTIVE) 0
				# Leave the top level loop
				utlExit
			} elseif {$msg == "WATCHMODESTOP"} {
				set utlWatchModeVars(WATCHMODEACTIVE) 0
				# Do not leave the application
				return -wait
			} elseif {[debugOn *] && $msg != ""} {
				dbg {utlWatchMode: got msg=$msg}
			}
			utlSleep $pause
		}

	} else {
		set utlWatchModeVars(WATCHMODEACTIVE) 0
		utlError "utlWatchMode: Invalid event parameter \"$event\""
	}

	dbg {<utlWatchMode $command $pause}
}


#######################################################################
# utlWatchModeControl
# -stop: Stops watch mode

proc utlWatchModeControl {option {arg ""}} {
	global utlWatchModeVars WATCHMODESTOP

	if {$option == "-stop"} {
		set WATCHMODESTOP 1
	} elseif {$option == "-pause"} {
		if {[utlIsNumber $arg]} {
			set utlWatchModeVars(setpause) $arg
		} else {
			utlError "Invalid pause value \"$arg\""
		}
	} elseif {$option == "-status"} {
		if {![info exists utlWatchModeVars(WATCHMODEACTIVE)]} {
			set utlWatchModeVars(WATCHMODEACTIVE) 0
		}
		return $utlWatchModeVars(WATCHMODEACTIVE)
	} else {
		utlError "Unknown watch mode control command \"$option\""
	}

	return ""
}


#######################################################################
# Spawn a process and retrieve the results

proc utlSpawn {proc params {getresults -getresults} } {
	global PVDIR PROGRAM TMPDIR
	dbg {>utlSpawn: $proc $params $getresults}

	# Determine mode
	if {$getresults == "-getresults"} {
		set bGetResults 1
	} else {
		set bGetResults 0
	}

	# Initializations
	set id "spawn-[utlUniqueNumber]"
	set rfile_base "[utlGetRootTempDir]/rti-spawn"

	# Result retrieval setup
	if {$bGetResults} {

		# Error check: Do not spawn too many processes
		# because that may indicate a recursive error.
		set MaxSpawn 5
		if {[llength [utlLS ${rfile_base}*]] > $MaxSpawn} {
			utlError "Spawn maximum of $MaxSpawn reached"
			dbg {<utlSpawn: ERROR}
			return ""
		}
		set rfile [utlUniqueFile $rfile_base tmp]
		utlTouchFile $rfile
	} else {
		set rfile ""
	}

	# Set up parameters
	utlSet cvp rfile $rfile PROGRAM $PROGRAM TMPDIR $TMPDIR
	if [debugOn] {
		set filename [dbgGetInfo -filename]
		set fileroot [file root $filename]
		set fileext [file extension $filename]
		utlSet cvp DEBUGF "${fileroot}-${id}${fileext}"
	}
	dbg {cvp: $cvp}

	# Invoke the app
	set args [list $params $cvp]
	dbg {Invoking app: $PVDIR/rtitcl -runproc $proc $args}
	winexec "$PVDIR/rtitcl -runproc $proc $args" minimize

	# Wait for results
	if {$bGetResults} {

		dbg {Waiting for results ...}
		set nMaxTime [utlDefault AppMaxWait "" "" 300]
		set nTime 0
		set nPause 1
		utlCheckFileComplete $rfile "" $nPause $nMaxTime $nMaxTime
		if {[utlCheckFile $rfile -delete]} {
			set result [lindex [utlReadFile $rfile] 0]
			utlRM $rfile
			dbg {Spawned process succeeded}
		} else {
			dbg {Spawned process failed}
			set result ""
		}
	} else {
		dbg {Not getting results}
		set result ""
	}

	dbg {<utlSpawn: $result}
	return $result
}


#######################################################################
# utlExecAsBatch
	
proc utlExecAsBatch {cmd {mode "nowait"} {timeout 30}} {
	global TMPDIR
	dbg {utlExecAsBatch: $cmd}
	if {[utlSysname] != "MSWindows"} return
	
	# create and execute batch file
	catch {
		set batfile [utlTempFile temp bat]
		set fd [utlOpen $batfile w]
		puts $fd $cmd
		utlClose $fd
		regsub -all / $batfile {\\} batfile
		winexec "\"$batfile\"" hide $mode $timeout
		utlYield -always
	}
}


#######################################################################
# utlExec
# Execute system command, catch any errors
#
# OPTIONS:
#	-errok: Do not return errors
#	-filter [list of filters]: Do not return the listed errors
#	-filtererrs: Do not return common problem errors
#	-notimeout: Do not use a timeout value (ignore resource entry) (windows only)
#	-returnerrorcode: Return an error code if there is an error (capture 
#		with "catch" command)
#	-stdredirect: Causes redirection (unix only)
#	-timeout [seconds]: Timeout for winexec (windows only)
#	-wait: Wait for the application to quit (windows only)
#	-waitfor [seconds]: Wait for the application to quit with the
#		given timeout (windows only)
#	-winstate [state]: State of the application when running on windows
#		(hide, normal, min, max) (windows only)
#
# NOTE: Using a windows- or unix-only command on the other will not cause
# any errors (allows for making only one call).

proc utlExec args {
	dbg {utlExec: $args}

	# Initializations
	set errok 0
	set useerrorcode 0
	set filters ""
	set notimeout 0
	set stdredirect 0
	set timeout 0
	set usefilter 0
	set wait 0
	set winstate -

	# Process arguments
	for {set ind 0} {$ind < [llength $args]} {incr ind} {
		set arg [lindex $args $ind]
		switch -glob -- $arg {
			-er* { # -errok
				set errok 1
			}
			-filter { # -filter
				set usefilter 1
				incr ind
				append filters [lindex $args $ind]
			}
			-filtere* { # -filtererrs
				set usefilter 1
				lappend filters "error waiting for process to exit: child process lost*"
				lappend filters "POSIX ECHILD*o child*"
				lappend filters "child killed: kill signal"
			}
			-no* { # -notimeout
				set notimeout 1
			}
			-returnerrorcode* { # -returnerrorcode
				set useerrorcode 1
			}
			-st* { # -stdredirect
				set stdredirect 1
			}
			-ti* { # -timeout
				incr ind
				set timeout [lindex $args $ind]
			}
			-wait { # -wait
				set wait 1
			}
			-waitf* { # -waitfor
				set wait 1
				incr ind
				set timeout [lindex $args $ind]
			}
			-wi* { # -winstate
				incr ind
				set winstate [lindex $args $ind]
			}
			default {
				set args [lrange $args $ind end]
				break
			}
		}
	}
	dbg {utlExec: after parsing the arguments, args=$args}

	# Set up wait time
	if {$notimeout} {
		set timeout 0
	} elseif {$wait} {
		set timeoutsetting [utlDefault AppMaxWait]
		if {$timeoutsetting != ""} {
			set timeout $timeoutsetting
			dbg {utlExec: resource setting "AppMaxWait" set timeout to $timeout}
		}
	}

	# Set up the command
	if { [utlSysname] == "MSWindows" } {
		set cmd [list winexec [join $args] $winstate]
		if {$wait} {
			lappend cmd "wait" 
			if {$timeout > 0} {
				lappend cmd $timeout
			}
		}
	} elseif { $stdredirect == 1} {
		set cmd "exec [join $args] >@stdout 2>@stderr"
	} else {
		set cmd "exec [join $args]"
	}
	dbg {utlExec: $cmd}

	# Execute the command and return the results, taking common problem 
	# error messages or filters into consideration
	if {[catch {set result [eval $cmd]} msg]} {
		global errorCode
		dbg {utlExec: errorCode=$errorCode, msg=$msg}
		if { $errok } {
			return ""
		} elseif {$usefilter} {
			dbg {utlExec: filters=$filters}
			set lines [split $msg \n]
			set result ""
			foreach line $lines {
				set rmline 0
				foreach filter $filters {
					if {[string match $filter $line]} {
						set rmline 1 
					}
				}
				if {!$rmline} {
					append result $line "\n"
				}
			}
		} else {
			set result ""
			if {[string match "error waiting for process to exit: child process lost*" $msg]} {
				# HP-UX sometimes returns this error without good reason
			} elseif {[string match "POSIX ECHILD*o child*" $errorCode]} {
				# Solaris, HP-UX sometimes returns this error without good reason
			} elseif { $errorCode == "NONE" && [string match "Distilling*" $msg]} {
				# distiller returns this after a good run
			} elseif {[string match "child killed: kill signal" $msg]} {
				# Solaris returns this error without good explanation
				set result "could not start program [lindex $args 0]"
			} elseif { $msg != 0 && $msg != "" } {
				regsub -all "\n" $msg "; " msg
				set result $msg
			} else {
				set result "Error while executing $args"
			}
		}
		if {$useerrorcode && $result != ""} {
			return -code error $result
		}
	}

	return $result
}


#######################################################################
# Find executable in path

proc utlIsExec { name } {
	global env
	if { [file tail $name] != $name } {
		if {[file executable $name] || \
		([utlSysname] == "MSWindows" && [file executable $name.exe])} {
			return 1
	} else {
		return 0
	}
	} elseif {[utlSysname] == "MSWindows" && \
		  [catch {set pathlist [split $env(PATH) ";"]}]} {
		return 0
	} elseif {[utlSysname] == "UNIX" && \
		  [catch {set pathlist [split $env(PATH) :]}]} {
		return 0
	}
	foreach dir $pathlist {
	if {[file executable $dir/$name] || \
		([utlSysname] == "MSWindows" && [file executable $dir/$name.exe])} {
		return 1
		}
	}
	return 0
}


proc utlFindExec { name } {
	global env
	if { [file tail $name] != $name } {
		if {[file executable $name] || \
		([utlSysname] == "MSWindows" && [file executable $name.exe])} {
			return [utlFullPath $name]
		} else {
			return ""
		}
	}
	if {[utlSysname] == "MSWindows" && \
	   [catch {set pathlist [split $env(PATH) ";"]}]} {
		return ""
	} elseif {[utlSysname] == "UNIX" && \
		  [catch {set pathlist [split $env(PATH) :]}]} {
		return ""
	}
	foreach dir $pathlist {
		if {[file executable $dir/$name] || \
		([utlSysname] == "MSWindows" && [file executable $dir/$name.exe])} {
			return [utlFullPath $dir/$name]
		}
	}
	return ""
}


#######################################################################
# Determine the OS

proc utlSysname {{flag -brief}} {
	global tcl_msWindows UTL_SYSNAME
	if { [info exists tcl_msWindows] } {
		if { $flag == "-brief" } {
			return "MSWindows"
		} elseif { $tcl_msWindows == 1 } {
			return "MSWindows 3.x"
		} elseif { $tcl_msWindows == 2 } {
			return "MSWindows 95"
		} else {
			return "MSWindows NT"
		}
	} else {
		if {$flag == "-brief"} {
			return "UNIX"
		} elseif { ![info exists UTL_SYSNAME]} {

			set UTL_SYSNAME ""
			if {[catch {set UTL_SYSNAME [exec uname]} msg]} {
				dbg {caught error : $msg}
			}

			# The OS name is sometimes wrapped up in standard error
			if {[regexp {(SunOS|HP-UX|AIX|IRIX)} $msg _ UTL_SYSNAME]} {
				dbg {Found OS in error message}
			}

			# Last resort, assume HP-UX  (the command fails sometimes on this OS for strange reasons)
			if {$UTL_SYSNAME == ""} {
				set UTL_SYSNAME "HP-UX"
				dbg {Assuming HP-UX}
			}

			dbg {utlSysname: $UTL_SYSNAME}
		}
		return $UTL_SYSNAME
	}
}


#######################################################################
# Determine the language being used on this OS

proc utlLanguage { } {

	if {[utlSysname] == "MSWindows"} {
		# Windows: Determine the language through the win32 API
		switch [string tolower [WinGetLanguage -primary]] {
			01 {set language "Arabic"}
			02 {set language "Bulgarian}
			03 {set language "Catalan"}
			04 {
				switch [string tolower [WinGetLanguage -sublanguage]] {
					01 {set language "ChineseT"}
					02 {set language "ChineseS"}
					default {set language "ChineseS"}
				}
			}
			05 {set language "Czech"}
			06 {set language "Danish"}
			07 {set language "German"}
			08 {set language "Greek"}
			09 {set language "English"}
			0a {set language "Spanish"}
			0b {set language "Finnish"}
			0c {set language "French"}
			0d {set language "Hebrew"}
			0e {set language "Hungarian"}
			0f {set language "Icelandic"}
			10 {set language "Italian"}
			11 {set language "Japanese"}
			12 {set language "Korean"}
			default {set language "English"}
		}
	} else {
		# Unix: Determine the language by checking the locale
		# NOTE: This uses the unix "setlocale" api function
		# and solaris, hpux, aix, and irix all support this
		# to query the current locale info but return the info
		# in different formats.
		if [catch {set locale [UnixGetLocale]}] {
			return ""
		}
		set locale [string tolower $locale]
		switch -glob -- $locale {
			*de* {set language "German"}
			*fr* {set language "French"}
			*it* {set language "Italian"}
			*ja* {set language "Japanese"}
			*ko* {set language "Korean"}
			*zh_cn* {set language "ChineseS"}
			*zh_tw* {set language "ChineseT"}
			default {set language "English"}
		}	
	}

	dbg {-utlLanguage: $language} 2
	return $language
}


#######################################################################
# Get a configuration setting for any platform
#
# Configuration settings are defined in one of four ways:
# 1) -resource generic parameter
# 2) pvwm.ini for windows (get via rtiDefault)
# 3) X-resource file for unix (get via utlGetRCValue)
# 4) hardwired default
#
# Inputs:
#    param: the setting name
#    section: the section for this key on any platform
#    usection: the section for this key if it is different on unix

proc utlDefault {param {section ""} {usection ""} {defaultval ""}} {
	global PROGRAM RESOURCE_VALUES
	dbg {>utlDefault: $param $section $usection} 2

	# Special case: if looking for pv*in, assume that the
	# key needs a ".value".
	if {[string match "pv*in" $param]} {
		append param ".value"
		dbg {pv*in detected, key modified: $param}
	}

	# Initializations
	set value ""
	set found 0

	# Make case insensative
	set program [utlStringToLower $PROGRAM]
	set param [utlStringToLower $param]

	# non-English UNIX systems are case sensitive, so check for "Prepare"
	# and "Pvprint" instead of "prepare" and "pvprint"
	set program2 [utlStringToTitle $PROGRAM]
	
	# Check command-line provided resource entries, if any
	if {$RESOURCE_VALUES != ""} {
		dbg {Checking parameter-provided settings: $RESOURCE_VALUES}

		foreach rv $RESOURCE_VALUES {
			utlFields $rv ssection skey svalue
			set skey [utlStringToLower $skey]
			if {$param == $skey} {
				dbg {Param \"$param\" found - comparing section name \"$ssection\" ...}

				# Make sure that the section matches
				if {$section == $ssection || [string tolower $section] == [string tolower $ssection]} {
					set found 1
				} elseif {$ssection == $program || $ssection == $program2} {
					set found 1
				} elseif {$ssection == "*"} {
					set found 1
				} elseif { [utlSysname] != "MSWindows" && $usection == $ssection} {
					set found 1
				}
				if {$found} {
					dbg {Section matches}
					set value $svalue
					break
				} else {
					dbg {Section does not match}
				}
			}
		}
	}

	# Return now if the value has been found
	if {$found} {
		dbg {Value found in parameter-provided settings}
		dbg {<utlDefault: $value} 2
		return $value
	} else {
		dbg {Value not found in parameter-provided setting}
	}

	# Look in the resource file
	if { [utlSysname] == "MSWindows" } {
		if {$section != ""} {
			set value [rtiDefault $section $param ""]
		} else {
			set value [rtiDefault $program $param ""]
		}
	} else { # retrieve from resource file if necessary
		if {$usection != ""} {
			set value [utlGetRCValue $usection $param]
		} elseif {$section != ""} {
			set value [utlGetRCValue $section $param]
		}
		if {[string length $value] == 0} {
			set value [utlGetRCValue $program $param]
		}
		if {[string length $value] == 0} {
			set value [utlGetRCValue $program2 $param]
		}
	}

	# Apply default value, if needed
	if {$value == ""} {
		set value $defaultval
	}

	dbg {<utlDefault: $value} 2
	return $value
}

############################################################
# check for setting under PROGRAM section, if not found
# then check under [Converter] or Preview section

proc utlDefaultConverter {param} {
	set val [utlDefault $param]
	if {[string length $val] == 0} {
		set val [utlDefault $param Converter]
	}
	dbg {utlDefaultConvert ($param): $val}
	return $val
}


#######################################################################
# Configuration defaults of type boolean; if not present then 0 (false)
# unless default set to true.

proc utlDefaultBool {param {section ""} {option -defaultfalse}} {
	set val [string tolower [utlDefault $param $section]]
	return [utlBoolean $val $option]
}


#######################################################################
# Returns 1 (true) or 0 (false) for if a resource setting exists or
# not.

proc utlHasDefault {param {section ""}} {
	if {[utlDefault $param $section] != ""} {
		return 1
	} else {
		return 0
	}
}


#######################################################################
# Get resource file: simulate X resource search path

proc utlGetRCFile { } {
	global env
	dbg {>utlGetRCFile}

	set result ""
	foreach rcvar {VVCP_RESOURCE_FILE XENVIRONMENT} {
		if {[info exists env($rcvar)]} {
			set rcfile $env($rcvar)
			if {[file isfile $rcfile] && [file readable $rcfile]} {
				dbg {resource file from $rcvar=$rcfile}
				set result $env($rcvar)
				break
			} else {
				dbg {cannot access resource file from $rcvar: $rcfile}
			}
		} else {
			dbg {$rcvar environmental variable not defined}
		}
	}

	dbg {<utlGetRCFile: $result}
	return $result
}


#######################################################################
# Open resource file: simulate X resource search path
#	read contents of resource file into RESOURCES

global RESOURCES; set RESOURCES {}

proc utlOpenRCFile {{arg ""}} {
	dbg {>utlOpenRCFile: $arg}
	global RESOURCES RESOURCES_CACHE

	# By default, don't do this more than once
	if {[string length $RESOURCES] > 0 && $arg != "-reload"} {
		dbg {<utlOpenRCFile: 1 (buffer already loaded)}
		return 1
	}

	# Initializations
	set RESOURCES "\n"
	if [info exists RESOURCES_CACHE] {
		unset RESOURCES_CACHE
	}

	# open resource file
	set rcfile [utlGetRCFile]
	if {[string length $rcfile] == 0} {
		dbg {<utlOpenRCFile: 0 (no resource file found)}
		return 0
	}
	dbg {resource file: $rcfile}
	if {[catch {set file [utlOpen $rcfile r]}]} {
		utlError "Could not open resource file $rcfile"
		dbg {<utlOpenRCFile: 0}
		return 0
	}

	# Load file into buffer
	fileproc $file line * {
		# Remove extra spaces
		set line [string trim $line]
		# Skip over comments and blank lines
		if {$line != "" && [string index $line 0] != "!"} {
			# Separate into key and value and make key case insensative
			set key ""; set value ""
			if {[regexp {(.*):(.*)} $line _ key value]} {
				set key [utlStringToLower $key]
				if {$key != ""} {
					set line [string trim "${key}:$value"]
					append RESOURCES "$line\n"
				}
			} else {
				append RESOURCES "$line\n"
			}
		}
	}

	catch {utlClose $file}

	dbg {<utlOpenRCFile: 1}
	return 1
}

#######################################################################
# get program name

proc utlGetProgram {} {
	global PROGRAM
	if {[info exists PROGRAM]} {
		return [utlStringToLower $PROGRAM]
	} else {
		return ""
	}
}

#######################################################################
# Retrieve value from X resource file (Preview, Prepare, or Pvprint)
# Set resource cache so that we don't do it over and over again

proc utlGetRCValue {program param {default ""}} {
	global RESOURCES RESOURCES_CACHE
	dbg {-utlGetRCValue: $program $param $default}

	# Make case insensative
	set program [utlStringToLower $program]
	set param [utlStringToLower $param]

	# Check if setting is already in the cache
	if {[info exists RESOURCES_CACHE(${program}*$param)]} {
		return $RESOURCES_CACHE(${program}*$param)
	}

	# Read in the resource file, if needed
	utlOpenRCFile

	# Check resource file

	# "PROGRAM*PARAM:" format
	if {[regexp "\n$program\\*$param:(\[^\n]+)" $RESOURCES _ res]} {
		set result [string trim $res]
		dbg {utlGetRCValue: ${program}*$param -> $result}

	# "*PARAM:" format
	} elseif {[regexp "\n\\*$param:(\[^\n]+)" $RESOURCES _ res]} {
		set result [string trim $res]
		dbg {utlGetRCValue: *$param -> $result}

	# Check "Preview*" settings for pvext
	} elseif {$program == "pvext" &&
			[regexp "\npreview\\*$param:(\[^\n]+)" $RESOURCES _ res]} {
		set result [string trim $res]
		dbg {utlGetRCValue: Preview*$param -> $result}

	# Default
	} else {
		set result [string trim $default]
		dbg {utlGetRCValue: ${program}*$param not found, using default: $result}
	}

	# Add this setting to the cache
	set RESOURCES_CACHE(${program}*$param) $result

	return $result
}


#######################################################################
# Set a value in the configuration file
# return values: 0 for error, 1 for success

proc utlSetRCValue {program param value {rcfile ""}} {
	dbg {>utlSetRCValue: $program $param $value $rcfile}

	if {[utlSysname] == "MSWindows"} {
		rtiDefault $program $param $value $rcfile
		dbg {<utlSetRCValue}
		return
	}

	# get program name
	set progname [string toupper [string index $program 0]]
	append progname [string tolower [string range $program 1 end]]

	# open resource file
	if {$rcfile == ""} {
		set rcfile [utlGetRCFile]
	}
	if {[string length $rcfile] == 0} {
		dbg {<utlSetRCValue: 0 (no resource file found)}
		return 0
	}
	dbg {resource file: $rcfile}
	if {[catch {set infd [utlOpen $rcfile r]}]} {
		dbg {<utlSetRCValue: 0 (could not open resource file $rcfile)}
		return 0
	}

	# open temp resource file
	set outfile [utlOutFile $rcfile tmp]
	if {[catch {set outfd [utlOpen $outfile w]}]} {
		dbg {<utlSetRCValue: 0 (could not open temp resource file $outfile)}
		catch {utlClose $infd}
		return 0
	}

	# need to set all occurrences in the resource file
	# (some converters pick up only the last entry)
	set hits 0
	fileproc $infd line * {

		# Determine replacement line for matches
		set newline ""
		set trimline [string trim $line]
		if {[string length $trimline] == 0} {
			# keep blank lines
		} elseif {[regexp "^$progname\\*$param:" $trimline]} {
			set newline "$progname*$param: $value"
		} elseif {[regexp "^\\*$param:" $trimline]} {
			set newline "*$param: $value"
		} elseif {[regexp "^$program\\*$param:" $trimline]} {
			set newline "*$program*$param: $value"
		} elseif {$program == "pvext" &&
				[regexp "^Preview\\*$param:" $trimline]} {
			set newline "Preview*$param: $value"
		}

		# Special check when a match found
		set bDelete 0
		if {$newline != ""} {
			dbg {Found matching line: $line}

			# A value of "" means remove the line altogether
			if {$value == ""} {
				set bDelete 1 
				dbg {Line removed}
			} else {
				dbg {Changed to: $newline}
			}

		# Use the original line if no match
		} else {
			set newline $line
		}

		# write line
		if {!$bDelete} {
			puts $outfd $newline
			if {[string compare $line $newline] != 0} {
				dbg {replacing $line --> $newline}
				incr hits
			}
		}
	}

	# add as the last entry if necessary
	if {$hits == 0 && $value != ""} {
		set newline "$progname*$param: $value"
		puts $outfd $newline
		dbg {added new line: $newline}
	}

	# final steps: close and move files
	catch {utlClose $outfd}
	catch {utlClose $infd}
	utlRM $rcfile
	utlMoveFile $outfile $rcfile

	dbg {<utlSetRCValue: 1}
	return 1
}


#######################################################################
# Set a configuration value internally

proc utlSetInternalRCValue {section key value} {
	global RESOURCE_VALUES
	dbg {>utlSetInternalRCValue: $section $key $value}

	# Delete any existing value
	set NEW_RV ""
	foreach record $RESOURCE_VALUES {
		utlFields $record ssection skey svalue
		if {$key == $skey && $section == $ssection} {
			dbg {Removing old field $record}
		} else {
			lappend NEW_RV $record
		}
	}
	set RESOURCE_VALUES $NEW_RV

	# Add the new value
	lappend RESOURCE_VALUES [list $section $key $value]

	dbg {Current RESOURCE_VALUES: $RESOURCE_VALUES}
	dbg {<utlSetInternalRCValue}
}


######################################################################
# Launch the resource file in an editor

proc utlEditResourceFile {} {
	set found 1
	if {[utlSysname] == "MSWindows"} {
		set app [prpGetWinAppPath ini]
		if {$app == "" || [string match *notepad* [string tolower $app]]} {
			# Use WordPad
			set app [prpFixWinAppPath [WinGetRegValue HKEY_CLASSES_ROOT {Wordpad.Document.1\shell\open\command} ""]]
		}
		set rcfile [utlGetWinResourceFile]
		if {$app != "" && $rcfile != ""} {
			winexec "$app $rcfile"
		} else {
			set found 0
		}
	} else {
		utlInfo "Only available on windows"
		set found 0
	}

	return $found
}


######################################################################
# Get the location of the windows resource file

proc utlGetWinResourceFile {} {
	global env rtitclRCFILE
	dbg {>utlGetWinResourceFile}

	# Error check for old interpreters
	if {![info exists rtitclRCFILE]} {
		dbg {<utlGetWinResourceFile: variable rtitclRCFILE not defined}
		return ""
	}

	# Determine full path
	set result ""
	if {[file exists $rtitclRCFILE]} {
		set result $rtitclRCFILE
	} else {
		foreach path [list [pwd] $env(windir)] {
			set rcfile "${path}\\$rtitclRCFILE"
			dbg {Verifying existance: $rcfile}
			if {[file exists $rcfile]} {
				set result $rcfile
			}
		}
	}

	dbg {<utlGetWinResourceFile: $result}
	return $result
}


######################################################################
# Get an environment variable

proc utlGetEnv { var } {
	global env

	if {[catch {set envnames [array names env]}]} {
	dbg {*** could not query env array}
	return ""
	}

	if {[utlSysname] == "MSWindows"} {
	set var [string tolower $var]
	foreach envname $envnames {
		if {[string compare [string tolower $envname] $var] == 0} {
		return $env($envname)
		}
	}
	} else {
	foreach envname $envnames {
		if {[string compare $envname $var] == 0} {
		return $env($envname)
		}
	}
	}
	return ""
}


######################################################################
# Get user's login name

proc utlGetUsername {} {
	global env
	
	# return the user's login name
	if {[info exists env(PVDAEMONID)]} {
		set user $env(PVDAEMONID)
	} elseif {[info exists env(USER)]} {
		set user $env(USER)
	} elseif {[info exists env(LOGNAME)]} {
		set user $env(LOGNAME)
	} elseif {[info exists env(USERNAME)]} {
		set user $env(USERNAME)
	} elseif {[utlSysname] == "UNIX"} {
		set user [lindex [utlExec -errok who am i] 0]
	} else {
		set user [rtiDefault "MS User Info" "DefName" "" "win.ini"]
	}
	
	return $user
}


#############################################################
# Add escape (\) to characters reserved in regexp

proc utlFixForRegexp { aline } {
	regsub -all "\\*" $aline "\\*" aline
	regsub -all "\\." $aline "\\." aline
	regsub -all "\\^" $aline "\\^" aline
	regsub -all "\\$" $aline "\\$" aline
	regsub -all "\\+" $aline "\\+" aline
	regsub -all "\\?" $aline "\\?" aline
	regsub -all "\\|" $aline "\\|" aline
	regsub -all "\\(" $aline "\\(" aline
	regsub -all "\\)" $aline "\\)" aline
	return $aline
}


#######################################################################
# Double the number of backslashes so that they are recognized in a
# string as backslashes rather than part of an escape sequence.

proc utlEscapeBackslashes {string} {
	regsub -all {\\} $string {\\\\} string
	return $string
}


#######################################################################
# Replace a substring with another substring.  This supports nested
# substring replacement (unlike regsub).  The "limit" parameter is
# the maximum number of substrings to replace and is used to prevent
# endless loops.

proc utlSubstring {str sub1 sub2 {limit 99}} {

	# check for valid inputs
	set len [string length $sub1]
	if {$len == 0 || [string length $str] < $len || $sub1 == $sub2} {
		dbg {-utlSubstring: nothing to do with str=$str sub1=$sub1 sub2=$sub2}
		return $str
	}

	# perform sub string substitutions
	# keep to the limit to prevent endless loops
	set result $str
	set count 0
	while {[incr count] < $limit && [string length $result] >= $len} {
		# find next occurrance of substring
		set idx [string first $sub1 $result]
		if {$idx < 0} {
			# break out of loop if substring not found
			break
		}

		# do substring replacement
		set result [string replace $result $idx [expr {$idx + $len - 1}] $sub2]
	}

	# check for out of limit condition
	if {$count >= $limit} {
		dbg {-utlSubstring: possible out of limit condition}
	}

	# return result
	dbg {-utlSubstring ($sub1 -> $sub2): ($str) -> ($result)}
	return $result
}


#######################################################################
# Find the value of a given key in a mapping file
#
# NOTES: (format of the mapping file)
# 1) One line per mapping
# 2) The syntax is KEY = VALUE
# 3) Embedded spaces don't require quotes, but quotes are accepted
# 4) Lines not matching KEY = VALUE are ignored, so comments are ok
# 5) KEY may be any regular expression (".*" means wildcard, for 
# example)
# 6) Leading or trailing spaces in KEY are ignored
# 7) Case is ignored
# 8) The first match found is the one used, so wildcards should be at
# the end.

proc utlQueryMappingFile {filename searchkey} {

	# Initializations
	set searchkey [utlStringToLower $searchkey]
	set handle [utlOpen $filename r]

	# Do the search
	set result ""
	while {[gets $handle line] >= 0} {
		if {[regexp {^(.*)=(.*)$} $line _ key value]} {
			set key [utlStringToLower [string trim $key]]
			regexp {^"(.*)"$} $key _ key
			if {[regexp "^$key$" $searchkey]} {
				set value [string trim $value]
				regexp {^"(.*)"$} $value _ value
				set result $value
				break
			}
		}
	}

	utlClose $handle

	dbg {-utlQueryMappingFileValue: $result}
	return $result
}


#######################################################################
# Temp File Handling
#######################################################################

#######################################################################
# If filename doesn't have the correct extension or is larger than
# 8.3, then copy it to a new 8.3 filename with the correct extension

proc utlGetWinFile {infile extension} {
	set infile [prpIntlStringToLower $infile]
	set extension [prpIntlStringToLower $extension]
	set basename [file rootname [file tail $infile]]
	if {[file extension $infile] != $extension || [string length $basename] > 8} {
		set tmpfile [utlTempFile83 $basename $extension]
		utlCopyFile $infile $tmpfile
		return $tmpfile
	}
	return $infile
}


#######################################################################
# Create temporary file with same name if possible

proc utlTempSameFile {basename} {
	global TMPDIR
	regsub -all {\\} $basename / basename
	set result $TMPDIR/[file tail $basename]
	if {[file exists $result]} {
		set result [utlUniqueFile $result [file extension $basename]]
	}
	catch {close [open $result w]}
	utlSetFilePermissions $result
	utlAddTempFile1 $result
	return $result
}


#######################################################################
# Create unique temporary file

proc utlTempMkdir { {basename temp} {extension ""} } {
	global TMPDIR
	regsub -all {\\} $basename / basename
	if {$extension == ""} {set extension [file extension $basename]}
	set result [utlUniqueFile $TMPDIR/[file tail $basename] $extension]
	utlMkdir $result
	utlAddTempFile1 $result
	return $result
}


#######################################################################
# Create unique temporary file

proc utlTempFile { {basename temp} {extension ""} } {
	global TMPDIR
	if {$extension == ""} {set extension [file extension $basename]}
	set result [utlUniqueFile $TMPDIR/[file tail $basename] $extension]
	utlAddTempFile1 $result
	catch {close [open $result w]}
	utlSetFilePermissions $result
	return $result
}


#######################################################################
# Create unique output file

proc utlOutFile {infile ext} {
	global TMPDIR
	set result [utlUniqueFile $TMPDIR/[file rootname [file tail $infile]] $ext]
	utlAddTempFile1 $result
	catch {close [open $result w]}
	utlSetFilePermissions $result
	return $result
}


#######################################################################
# if a filename has multiple characters, then copy to a temp ascii file
# because some converters can't handle multi-byte filenames
proc utlGetAsciiFilename {infile} {
	# don't do anything if the filename is all ascii
	if {[string is ascii $infile]} {
		return $infile
	}

	# copy file to a temp ascii filename
	set newfile [utlTempFile]
	utlCopyFile $infile $newfile
	if {[utlCheckFile $newfile]} {
		dbg {utlGetAsciiFile: ($infile) -> ($newfile)}
		return $newfile
	} else {
		dbg {utlGetAsciiFile: can't process ($infile)}
		return $infile
	}

}


#######################################################################
# determine if specified format needs an ascii filename
#
proc utlNeedAsciiFilename {type} {
	if {[utlIn $type {xls ppt}]} {
		dbg {utlNeedAsciiFilename: $type -> YES}
		return 1
	} else {
		dbg {utlNeedAsciiFilename: $type -> NO}
		return 0
	}
}


#######################################################################
# Create unique temporary 8.3 filename, basename must not contain path

proc utlTempFile83 {{basename temp} {extension ""}} {
	global TMPDIR

	# Make sure the base name is only 4 characters, since
	# utlUniqueFile always generates a filename with 4
	# more characters in the base name (a dash and 3
	# numbers).
	if {[string length $basename] > 4} {
		set basename [string range $basename 0 3]
	}

	# Generate the result
	set result [utlUniqueFile $TMPDIR/$basename $extension]
	utlAddTempFile1 $result
	catch {close [open $result w]}
	utlSetFilePermissions $result
	return $result
}


#######################################################################
# Add single file to temp files

proc utlAddTempFile1 { file }  {
	global TMPFILES

	# Error check
	if {$file == ""} {
		utlError "utlAddTempFile1 - no file specified"
		return
	}

	if {[utlSysname] == "MSWindows"} {
		regsub -all {\\} [winshortname [utlFullPath $file]] / file
		lappend TMPFILES $file
	} else {
		lappend TMPFILES [utlFullPath $file]
	}
	dbg {utlAddTempFile1: $file}
}


#######################################################################
# Add to temp files

proc utlAddTempFile { files }  {
	foreach file $files {utlAddTempFile1 $file}
}


#######################################################################
# Subtract all occurrences of the given file from the temp files list

proc utlSubTempFile {file} {
	global TMPFILES
	dbg {utlSubTempFile: $file}

	set idx 0
	foreach tmpfile $TMPFILES {
		if {[utlSameFile $file $tmpfile]} {
			set TMPFILES [lreplace $TMPFILES $idx $idx]
		} else {
 			incr idx
		}
	}
}


#######################################################################
# Check if file is in TMPFILES

proc utlIsTempFile {file} {
	global TMPFILES
	foreach tfile $TMPFILES {
		if {[utlSameFile $file $tfile]} {return 1}
	}
	return 0
}


#######################################################################
# Remove temporary files

proc utlRMTempFiles {} {
	global TMPFILES
	dbg {>utlRMTempFiles}

	set redo ""
	if {! [dbgSaveTempFiles] } {
		foreach file $TMPFILES {
			utlRM $file
			if {[file exists $file]} {lappend redo $file}
		}
	}

	dbg {<utlRMTempFiles: ($TMPFILES) -> ($redo)}
	set TMPFILES $redo
}


#####################################################################
# Determine drive name of a given file or path

proc utlGetDriveName {file} {
	dbg {>utlGetDriveName: $file}

	set sDriveName ""
	set file [utlFullPath $file]
	if {[regexp {^(//.+?/.+?/).*} $file _ sDriveName]} {
		# UNC drive
	} elseif {[regexp {^(.+?/).*} $file _ sDriveName]} {
		# Standard drive
	} else {
		utlInfo "WARNING: Could not get drive name of $file"
	}

	# Make sure slashes are backslashes, since system functions
	# using drive names require this.
	regsub -all / $sDriveName {\\} sDriveName

	dbg {<utlGetDriveName: $sDriveName}
	return $sDriveName
}


#####################################################################
# If the file has a network path, copy it to the local temp 
# directory so that operations that can't handle UNC or network
# locations will function and for efficiency.

# Copy for UNC only
proc utlCheckUNC {file} {
	if {[regexp {^//} $file]} {
		set oldfile $file
		set file [utlTempSameFile $file]
		utlCopyFile $oldfile $file
		dbg {UNC infile $oldfile copied to $file}
	}
	return $file
}

# Copy for all network locations
proc utlCopyIfNetwork {file} {
	dbg {>utlCopyIfNetwork: $file}

	# Only for Windows
	if {[utlSysname] != "MSWindows"} {
		dbg {<utlCopyIfNetwork: not needed, unix}
		return $file
	}

	# Get drive name
	set sDriveName [utlGetDriveName $file]
	if {$sDriveName == ""} {
		return $file
	}

	# Determine if drive is network or not
	if {[WinGetDriveType $sDriveName] == "REMOTE"} {
		set oldfile $file
		set file [utlTempSameFile $file]
		utlCopyFile $oldfile $file
		dbg {UNC infile $oldfile copied to $file}
	}

	dbg {<utlCopyIfNetwork: $file}
	return $file
}


#####################################################################
# Creates a unique subdirectory in the temp directory, copies the
# list of files into it, and returns the new directory name.
# NOTE: This proc is not associated with the special temp 
# subdirectory routines (utlSetupTempSubdir, etc.).

proc utlCopyToTempSubdir {filelist} {
	global TMPDIR

	set tempsubdir "$TMPDIR/[utlUniqueString tmp]"
	utlMkdir $tempsubdir

	# Verify file existance and deal with wildcards to create a new list
	set newfilelist ""
	foreach file $filelist {
		set filels [utlLS $file]
		if {$filels != ""} {
			set newfilelist [concat $newfilelist [utlLS $file]]
		}
	}
	set filelist $newfilelist

	# Copy each file to the new temp subdirectory
	foreach file $filelist {
		utlCopyFile $file $tempsubdir
	}

	return $tempsubdir
}


#####################################################################
# Set up and use temp subdirectory, if option turned on
# NOTE: Return value indicates if temp subdir being used or not

proc utlSetupTempSubdir {prefix {option "-defaulton"}} {
	global TMPDIR OTMPDIR
	dbg {>utlSetupTempSubdir: $prefix $option}

	# Determine whether to use it or not
	if {$option == "-defaulton"} {
		set use 1
	} else {
		set use 0
	}

	# Set up the temp subdirectory 
	if {$use} {

		# Initializations
		utlRegisterQuitAction TempSubdir "utlCleanUpTempSubdir" -last

		# Error check: Make sure that a temp subdirectory is not already being used
		if {[info exists OTMPDIR]} {
			if {$OTMPDIR != "UNDEFINED"} {
				dbg {Temp subdirectory already defined as $TMPDIR (original is $OTMPDIR)}
				dbg {<utlSetupTempSubdir: ERROR}
				return 1
			}
		}

		# Create the subdirectory and set the related globals
		set OTMPDIR $TMPDIR
		set subdirname [utlUniqueString $prefix]
		set TMPDIR "$TMPDIR/$subdirname"
		utlMkdir $TMPDIR
		dbg {New TMPDIR = $TMPDIR}
		dbg {<utlSetupTempSubdir: 1}
		return 1
	} else {
		set OTMPDIR "UNDEFINED"
		dbg {<utlSetupTempSubdir: 0}
		return 0
	}
}


#####################################################################
# Remove temp subdirectory and restore original temp directory

proc utlCleanUpTempSubdir {} {
	global TMPDIR OTMPDIR
	dbg {>utlCleanUpTempSubdir}

	if {[info exists OTMPDIR]} {
		if {[file exists $TMPDIR] && $OTMPDIR != "UNDEFINED"} {

			# Error check
			if {$TMPDIR == $OTMPDIR} {
				utlError "Temp subdirectory will not be removed; it is the same as the original temp directory (which indicates that there is a problem)"
				set OTMPDIR "UNDEFINED"
				dbg {<utlCleanUpTempSubdir}
				return
			}

			# Remove temp directory and restore it to the original location
			# NOTE: Do not remove it in debug mode
			if { [dbgSaveTempFiles] } {
				utlInfo "Not cleaning up temp subdirectory \"$TMPDIR\" (debug mode is active); this will need to be done manually"
			} else {
				set result [utlRM $TMPDIR]
				if {$result != ""} {
					# This indicates that utlRM failed
					dbg {WARNING: Failed to remove $result - closing all registered file handles and trying again}
					utlCloseAll
					set result [utlRM $TMPDIR]
					if {$result != ""} {
						utlError "WARNING: Failed to remove $result"
					}
				}
			}
			set TMPDIR $OTMPDIR
			set OTMPDIR "UNDEFINED"
			dbg {TMPDIR restored to $TMPDIR}
		}
	}

	dbg {<utlCleanUpTempSubdir}
}


#####################################################################
# Replace the temp subdirectory, when needed (files exist)
# This is useful for activities such as watch mode so that the temp
# subdirectory is only cleaned up and recreated when needed.

proc utlRefreshTempSubdir {prefix} {
	global TMPDIR OTMPDIR

	if {[info exists OTMPDIR]} {
		if {$OTMPDIR != "UNDEFINED"} {
			set tmpcontents [utlLS $TMPDIR]
			if {$tmpcontents != ""} {
				dbg {utlRefreshTempSubdir: Refreshing, tmpdir contains $tmpcontents}
				utlCleanUpTempSubdir
				utlSetupTempSubdir $prefix
			}
		}
	}
}


#######################################################################
# Get the root temp directory

proc utlGetRootTempDir {} {
	global RTMPDIR
	return $RTMPDIR
}


#######################################################################
# File handling
#######################################################################


#######################################################################
# Open file

proc utlOpen {filename {access "r"}} {
	global OPENFILES
	if {[catch {set handle [open $filename $access]} message]} {
		dbg {utlOpen error: $message}
		error $message
	} else {
		set pair [list $handle $filename]
		lappend OPENFILES [list $handle $filename]
		dbg {utlOpen: $handle -> $filename $access}
		return $handle
	}
}


#######################################################################
# Close file

proc utlClose {handle} {
	global OPENFILES
	set index 0
	foreach p $OPENFILES {
		if {[lindex $p 0] == $handle} {
			dbg {utlClose: $handle -> [lindex $p 1]}
			if {[catch {close $handle} message]} {
				dbg {utlClose error: $message}
				error $message
			} else {
				set OPENFILES [lreplace $OPENFILES $index $index]
				return
			}
		} else {
			incr index
		}
	}
	dbg {***utlClose: handle not found}
}


#######################################################################
# Close all files

proc utlCloseAll {} {
	global OPENFILES
	foreach p $OPENFILES {
		dbg {utlCloseAll: [lindex $p 1]}
		if {[catch {close [lindex $p 0]} message]} {
			dbg {utlCloseAll error: $message}
		}
	}
	set OPENFILES {}
}


#######################################################################
# Return the list of all open files

proc utlListOpenFiles {} {
	global OPENFILES

	return $OPENFILES
}


#######################################################################
# Create a unique file name of form $basename-nnn.$extension

proc utlUniqueFile { basename extension } {
	dbg {>utlUniqueFile $basename $extension}
	set basename [file rootname $basename]
	if { [utlFile83] } { # observe 8.3
		set basename [file dirname $basename]/[string range [file tail $basename] 0 3]
	}
	set extension [string trimleft $extension "\."]
	if { [regexp {%[0-9]*d} $basename]} {
		set pattern $basename
	} elseif { [regexp {(.+)-[0-9][0-9][0-9]$} $basename _ pattern] } {
		if {$extension == ""} {
			append pattern "-%03d"
		} else {
			append pattern "-%03d.$extension"
		}
	} elseif { $extension == "" } {
		set pattern $basename-%03d
	} else {
		set pattern $basename-%03d.$extension
	}
	dbg {Using pattern $pattern}
	for {set count 1} \
		{ $count < 1000 && [file exists [set fname [format $pattern $count]]] } \
		{incr count} {}

	# return unique file, if found
	if {![file exists $fname]} {
		dbg {<utlUniqueFile: $fname}
		return $fname
	}

	# reset extension to include "."
	if {[string length $extension] > 0 && [string index $extension 0] != "."} {
		set extension .$extension
	}

	# limit has been exceeded, reconfigure the pattern
	if {![utlFile83]} {
		# find next available file, no limit
		set pattern $basename-%d$extension
		set count 1000
		while {[file exists [set fname [format $pattern $count]]]} {incr count}

		# return unique file
		if {![file exists $fname]} {
			dbg {<utlUniqueFile: $fname}
			return $fname
		}
	} else {
		# handle 8.3 filenames
		set tail [file tail $basename]
		set dirname [file dirname $basename]

		# find next available filename
		set count 0
		while {$count < 99999999} {
			# reset tail to fit 8.3 filename, get new pattern
			set flen [string length $count]
			if {$flen == 3} {
				# we already checked 3 digits, move on to 4 digits
				set count 1000
				continue
			} elseif {$flen < 7} {
				set tail [string range $tail 0 [expr {6 - $flen}]]
				set pattern $dirname/${tail}-%d$extension
			} else {
				# filename is all numbers
				set pattern $dirname/%d$extension
			}

			# check for unique file, return when found
			while {1} {
				set fname [format $pattern [incr count]]
				if {![file exists $fname]} {
					# unique file found
					dbg {<utlUniqueFile: $fname}
					return $fname
				}
				if {[regexp {^9+$} $count]} break
			}
		}
	}

	# no unique file was found, fatal error
	# this can only happen when doing 8.3 filenames
	utlError "Could not find a unique filename"
	return ""
}


#######################################################################
# Create a unique file as close to the given name as possible

proc utlUniqueFileSameName {filename} {
	utlUniqueFile [file rootname $filename] [file extension $filename]
}


#######################################################################
# Get a unique basename in a directory

proc utlGetUniqueBasename {dir} {
    set base [string trimleft [string range [rtiTime] 11 end] 0]
    set idx 0
    while {[incr idx] <= 9999} {
        set idx2 0
        while {[incr idx2] <= 999} {
            set retval [format "%04d-%03d" $base $idx2]
            if {[llength [utlLS $dir/in/${retval}*]] == 0 && \
                    [llength [utlLS $dir/out/${retval}*]] == 0} {
                return $retval
            }
        }
        if {[incr base] > 9999} {set base 0}
    }
    utlError "Could not obtain a unique filename for directory $dir"
    return ""
}


#######################################################################
# utlRM
# Remove one or more file
# Returns "" if success, list of failed files otherwise

proc utlRM args {
	dbg {>utlRM: $args}

	# Initializations
	set result ""
	set files ""

	# Resolve wildcards
	foreach file $args {

		# DO NOT do glob on an empty string - it resolves to "." which
		# deletes everything in the current directory.
		if {$file == ""} {
			continue
		}

		set newfiles [glob -nocomplain $file]
		if {$newfiles != ""} {
			set files [concat $files $newfiles]
			dbg {Resolved wildcards, new files: $files}
		} else {
			lappend files $file
		}
	}

	# Remove each file
	foreach file $files {

		# Error check
		if {![file exists $file]} continue

		# Deal with directories
		if {[file isdirectory $file]} {
			# delete files in directory first
			foreach subfile [utlLS $file/*] {
				set result [concat $result [utlRM $subfile]]
			}
			if {[pwd] == $file} {cd ..}
		}

		# Remove the file
		utlChmod $file 511
		if {[catch {file delete $file} msg]} {
			utlError "utlRM: Could not remove $file : $msg"
			lappend result $file
		}
	}

	dbg {<utlRM: $result}
	return $result
}


#######################################################################
# change file permissions (don't do for UNC filenames since it will
# crash the TCL console
# return 0 if successful
# return 1 if failure (only if actual chmod command fails)
proc utlChmod {infile value} {
	# check for UNC filename
	if {[regexp {^//} $infile]} {
		dbg {utlChmod: skipping chmod for UNC file: $infile $value}
		return 0
	}

	# do chmod
	if {![file exists $infile]} {
		dbg {utlChmod: skipping non-existent file $infile $value ($msg)}
		return 0
	} elseif {[catch {chmod $infile $value} msg]} {
		dbg {utlChmod: **** error $infile $value ($msg)}
		return 1
	} else {
		dbg {utlChmod: $infile $value}
		return 0
	}
}

#######################################################################
# Determine if a file exists or not; can deal with names enclosed in
# braces.

proc utlFileExists {filename} {
	regexp {^{(.*)}$} $filename _ filename
	set result [file exists $filename]
	dbg {-utlFileExists: $result}
	return $result
}


#######################################################################
# Return 1 if the directory is empty, 0 if not

proc utlIsEmpty directory {
	if {[glob -nocomplain $directory/*] == ""} {
		return 1
	} else {
		return 0
	}
}


#######################################################################
# Change a file name to Unix syntax

proc utlUnixFileName { name } {
	if { [utlSysname] == "MSWindows" } {
		regsub -all {\\} "$name" / name1
		dbg {utlUnixFileName: $name -> $name1}
		return $name1
	} else {
		return $name
	}
}


#######################################################################
# Change a file name to DOS syntax

proc utlDOSFileName { name } {
	regsub -all / "$name" {\\} name1
	dbg {utlDOSFileName: $name -> $name1}
	return $name1
}


#######################################################################
# Change a file name to native syntax; might include change to short name
# Inputs: UNIX-style-filename, form = [-long | -short]

proc utlNativeFileName { name {form -long}} {
	if { [utlSysname] == "MSWindows" } {
		if {$form == "-short"} {
			set name1 [winshortname $name]
		} else {
			set name1 $name
		}
		regsub -all / "$name1" {\\} name2
		dbg {utlNativeFileName: $name -> $name2}
		return $name2
	} else {
		return $name
	}
}


########################################################################
# Format a filename for OS command

proc utlCommandFileName {file} {
	if {[utlSysname] == "MSWindows"} {
		return [utlNativeFileName $file -short]
	} else {
		return "\{[utlNativeFileName $file]\}"
	}
}


#######################################################################
# Put a string in a file without a newline

proc utlPutFile { filename string {accessmode "w"}} {
	dbg {utlPutFile $filename}
	catch {set file [utlOpen $filename $accessmode]
		   puts -nonewline $file $string
		   utlClose $file
	}
}


#############################################################################	 
# Read the contents of a file into a list of lines.
# Use flag = -erraise | -errok to set error handling and maxlength to set
# maximum number of bytes to be read.

proc utlReadFile {fname {flag -erraise} {maxlength 9999999}} {
	if { $flag == "-errok"} {
		if {[catch {set file [utlOpen $fname r]}]} {return ""}
	} else {
		set file [utlOpen $fname r]
	}
	set result [split [read $file $maxlength] "\n"]
	utlClose $file
	return $result
}


#############################################################################	 
# Read the entire contents of a file
# Use flag = -erraise | -errok to set error handling

proc utlReadAllFile {fname {flag -erraise}} {
	if { $flag == "-errok"} {
		if {[catch {set file [utlOpen $fname r]}]} {return ""}
	} else {
		set file [utlOpen $fname r]
	}
	set result [read $file]
	utlClose $file
	return $result
}


#######################################################################
# Peek at the next line. Make sure next gets will not be affected.

proc utlPeekLine {file} {
	set mark [tell $file]
	set nextline ""
	fileproc $file nextline * break
	seek $file $mark
	return [string trim $nextline]
}


#####################################################################
# read a line from a binary file (from the specified cursor
# position up to the next non-printable ascii character)

proc utlReadBinaryLine {fd pos {max 100}} {
	seek $fd $pos
	set line ""
	for {set i 0} {$i < $max && ![eof $fd]} {incr i} {
		seek $fd [expr {$pos + $i}]
		binary scan [read $fd 1] c ch
		if {$ch < 0} {incr ch 256}
		if {$ch >= 32 && $ch <= 126} {
			append line [format "%c" $ch]
		} else {
			# end of string found
			break
		}
	}
	return $line
}

#######################################################################
# read text file that contains both ASCII and non-ASCII characters
# return list of TYPE-STRING pairs
# if TYPE=ASCII, then STRING=text string
# if TYPE=HEX, then STRING=hex string

proc utlReadAsciiHexFile {infile} {

	# init variables
	if {[catch {set fsize [file size $infile]; set fd [utlOpen $infile r]} msg]} {
		dbg {utlReadAsciiHexFile: *** could not process file $infile : $msg}
		return ""
	}
	set fidx -1
	set ascii_str ""; set hex_str ""
	set type "ASCII"
	set lines ""

	# read the file byte by byte, line by line
	# mark line as "HEX" if there's a non-ASCII character
	while {[incr fidx] < $fsize} {

		# read next character, and check for newline
		set c [readbin $fd $fidx]
		if {$c == 10 || $c == 13} {
			# if it's a carriage return, then check for newline
			set nextidx [expr {$fidx + 1}]
			if {$c == 13 && $nextidx < $fsize && [readbin $fd $nextidx] == 10} {
				incr fidx
			}

			# add the line to return variable
			if {$type == "HEX"} {
				lappend lines [list "HEX" $hex_str]
			} else {
				lappend lines [list "ASCII" $ascii_str]
			}

			# reset the variables for the next line
			set type "ASCII"
			set ascii_str ""
			set hex_str ""
			continue
		}

		# if the character is not ASCII, then mark the line as HEX
		if {$c > 127 || $c < 32} {
			set type "HEX"
		}
		append hex_str [format "%02X" $c]
		append ascii_str [format "%c" $c]
	}
	utlClose $fd

	# save the last line and return the result
	if {[string length $hex_str] > 0} {
		if {$type == "HEX"} {
			lappend lines [list "HEX" $hex_str]
		} else {
			lappend lines [list "ASCII" $ascii_str]
		}
	}
	return $lines
}

#######################################################################
# read a file as a HEX string

proc utlReadHexFile {infile} {

	# init variables
	if {[catch {set fsize [file size $infile]; set fd [utlOpen $infile r]} msg]} {
		dbg {utlReadHexFile: *** could not process file $infile : $msg}
		return ""
	}
	set fidx -1; set line ""; set lines ""

	# read the file byte by byte, line by line
	while {[incr fidx] < $fsize} {

		# read next character, and check for linefeed
		set c [readbin $fd $fidx]
		if {$c == 10 || $c == 13} {
			# if it's a carriage return, then check for newline
			set nextidx [expr {$fidx + 1}]
			if {$c == 13 && $nextidx < $fsize && [readbin $fd $nextidx] == 10} {
				incr fidx
			}

			# add the line to result list
			lappend lines $line
			set line ""
		} else {
			# append character to current line
			append line [format "%02X" $c]
		}
	}
	utlClose $fd

	# save the last line and return the result
	if {[string length $line] > 0} {
		lappend lines $line
	}
	return $lines
}

#######################################################################
# read a file as a single HEX string

proc utlTextToHex {text} {
	set tempfile [utlTempFile]
	utlPutFile $tempfile $text
	set lines [utlReadHexFile $tempfile]
	set result [lindex $lines 0]
	foreach line [lrange $lines 1 end] {
		# append newline character to each line
		append result "10$line"		
	}
	return $result
}

#####################################################################
# convert a Hex string to a character string

proc utlHexToChar {str} {
	# use "catch" in case the input string has invalid hex characters
	set result ""
	set tmpstr $str
	if {[catch {
		while {[string length $tmpstr] >= 2} {
			append result [format "%c" 0x[string range $tmpstr 0 1]]
			set tmpstr [string range $tmpstr 2 end]
		}}]} {
		# an error occurred, return original string
		dbg {utlHexToChar: *** error occurred with input string ($str)}
		return $result
	}

	# check for leftover hex characters, then return result
	if {[string length $tmpstr] > 0} {
		dbg {utlHexToChar: leftover characters ($tmpstr)}
	}
	dbg {utlHexToChar: ($str) -> ($result)}
	return $result
}


#####################################################################
# convert a string to a Dec string

proc utlCharToDec {str} {
	if {[binary scan $str c* result]} {
		dbg {utlCharToDec: ($str) -> ($result)}
		return $result
	}

	# error occurred
	dbg {utlCharToDec: *** could not convert to Dec string ($str)}
	return $str
}


#####################################################################
# convert a string to a Hex string

proc utlCharToHex {str} {
	if {[binary scan $str H* result]} {
		dbg {utlCharToHex: ($str) -> ($result)}
		return $result
	}

	# error occurred
	dbg {utlCharToHex: *** could not convert to Hex string ($str)}
	return $str
}


#####################################################################
# convert a string to a byte string

proc utlStringToBytes {str {type %d}} {
	dbg {>utlCharToHex: $str}

	set result ""
	set nLength [GetStringByte LENGTH $str]
	for {set nIndex 0} {$nIndex < $nLength} {incr nIndex} {
		set result "$result [GetStringByte $type $str $nIndex]"
	}

	dbg {<utlCharToHex: $result}
	return $result
}


###########################################################
# convert Shift-JIS character string (represented as a hex
# string) to a JIS hex string for use with Ripset

proc utlEncode-SJIS {str} {
	# try using built-in TCL encoding first
	set sjis [encoding convertfrom shiftjis [utlHexToChar $str]]
	set jis [encoding convertto jis0208 $sjis]
	set result [utlCharToHex $jis]
	dbg {utlEncode-SJIS: ($str) -> ($result)}
	return $result
}

proc utlEncode-SJIS2JIS {str} {
	return [utlEncode-SJIS $str]
}


###########################################################
# convert a EUC string (represented in hex) to a JIS hex
# string for use with Ripset

proc utlEncode-EUC {str} {
	# encode string
	set result ""; set tempstr [string tolower $str]
	while {[string length $tempstr] >= 4} {
		# get next two bytes
		set byte1 [string range $tempstr 0 1]
		set byte2 [string range $tempstr 2 3]
		set tempstr [string range $tempstr 4 end]
		if {![string is xdigit -strict $byte1] || ![string is xdigit -strict $byte2]} {
			dbg {utlEncode-ASCII: *** invalid hex character 0x${byte1}$byte2}
			continue
		}
		set byte1 0x$byte1
		set byte2 0x$byte2

		# toggle highest order bit for each byte
		if {$byte1 >= 128} {
			append result [format "%02x" [expr {$byte1 - 128}]]
		} else {
			append result [format "%02x" [expr {$byte1 + 128}]]
		}
		if {$byte2 >= 128} {
			append result [format "%02x" [expr {$byte2 - 128}]]
		} else {
			append result [format "%02x" [expr {$byte2 + 128}]]
		}
	}

	# return result
	dbg {utlEncode-EUC: ($str) -> ($result)}
	return $result
}

###########################################################
# convert character string (represented as a hex
# string) to a JIS hex string for use with Ripset
#
proc utlEncode-ASCII {str} {
	# init some constants
	set a 0x[utlCharToHex a]
	set z 0x[utlCharToHex z]
	set A 0x[utlCharToHex A]
	set Z 0x[utlCharToHex Z]
	set zero 0x[utlCharToHex 0]
	set nine 0x[utlCharToHex 9]

	# encode string
	set result ""; set tempstr [string tolower $str]
	while {[string length $tempstr] > 0} {
		# get next character
		set char [string range $tempstr 0 1]
		set tempstr [string range $tempstr 2 end]
		if {![string is xdigit $char]} {
			dbg {utlEncode-ASCII: *** invalid hex character 0x$char}
			continue
		}
		set char 0x$char

		switch $char {
			0x20 {append result 2121}
			0x21 {append result 212A}
			0x22 {append result 2137}
			0x23 {append result 2174}
			0x24 {append result 2170}
			0x25 {append result 2173}
			0x26 {append result 2175}
			0x27 {append result 212d}
			0x28 {append result 214a}
			0x29 {append result 214b}
			0x2a {append result 2176}
			0x2b {append result 215c}
			0x2c {append result 2124}
			0x2d {append result 215d}
			0x2e {append result 2125}
			0x2f {append result 213f}
			0x3a {append result 2127}
			0x3b {append result 2128}
			0x3c {append result 2163}
			0x3d {append result 2161}
			0x3e {append result 2164}
			0x3f {append result 2129}
			0x40 {append result 2177}
			0x5b {append result 214e}
			0x5c {append result 2140}
			0x5d {append result 214f}
			0x5e {append result 2130}
			0x5f {append result 2132}
			0x60 {append result 212e}
			0x7b {append result 2150}
			0x7c {append result 2143}
			0x7d {append result 2151}
			0x7e {append result 2141}
			default {
				if {($char >= $a && $char <= $z) ||
					($char >= $A && $char <= $Z) ||
					($char >= $zero && $char <= $nine)} {
					# letters or numbers
					append result [format "23%02x" $char]
				}
			}
		}
	}

	# return result
	dbg {utlEncode-ASCII ($str) -> ($result)}
	return $result
}


#######################################################################
# Create an empty file or update its modify date

proc utlTouchFile {fname} {
	catch {close [open $fname a]}
}


#######################################################################
# Concatenate a file to a file (UNIX cat command)

proc utlCat {source target} {
	dbg {utlCat $source $target}
	if {[utlSysname] == "MSWindows"} {
		rtiCat $target $source
	} else {
		utlExec cat $source >> $target
	}
}


#######################################################################
# Concatenate a line to a file

proc utlConcatFile { fname line {linefeed 1}} {
	dbg {utlConcatFile $fname $line}
	set file [utlOpen $fname a]
	if { $linefeed } {
		puts $file "\n$line"
	} else {
		puts $file "$line"
	}
	utlClose $file
}	


#######################################################################
# Append a file to another file (UNIX cat command except file1 is open)

proc utlAppendFile {file1 fname2} {
	if {[catch {set file2 [utlOpen $fname2 "r"]}]} { return }
	set contents [split [read $file2] "\n"]
	utlClose $file2
	foreach line $contents {puts $file1 $line}
}


#######################################################################
# Create full (absolute) path name; might be relative to 2nd path

proc utlFullPath {fname {path ""}} {
	regsub -all {\\} $fname / fname
	regsub -all {\\} $path / path

	# Error check
	if {$fname == ""} {
		return ""
	}

	# check for condition of a Windows root directory (e.g. D: or X:\)
	# and return correct value immediately
	if {[utlSysname] == "MSWindows" && [regexp {^[a-zA-Z]:/.*$} $fname]} {
		if {[string last "/" $fname] < 0 && [string length $fname] == 2} {
			set result $fname/
		} else {
			set result $fname
		}
		return $result
	}

	# Remove trailing / from filename
	set fname [string trimright $fname "/"]

	# Determine/fix path
	if { $path == "" } {
		set path [utlPWD]
	} else {
		regsub -all {\\} $path / path
	}
	set path [string trimright $path "/"]

	# Unix filename starts with /
	if {[utlSysname] != "MSWindows" && [string index $fname 0] == "/" } {
		set result $fname

	# Windows filename starts with a drive letter or UNC
	} elseif {[utlSysname] == "MSWindows" && ([string index $fname 1] == ":" \
					|| [string range $fname 0 1] == "//")} {
		set result $fname

	# Windows filename with relative path
	} elseif {[utlSysname] == "MSWindows" && [string index $fname 0] == "/" \
				&& [string index $path 1] == ":"} {
		set result [string range $path 0 1]$fname

	# Filename with relative path of ./
	} elseif { [string range $fname 0 1] == "./" } {
		set result $path[string range $fname 1 end]

	# Filename with relative path of ../
	} elseif { [string range $fname 0 2] == "../" } {
		set result [file dirname $path][string range $fname 2 end]

	# Do not modify home paths (start with a tilde)
	} elseif { [string index $fname 0 ] == "~" } {
		set result $fname

	# Filename with other relative path
	} else {
		set result $path/$fname
	}

	# Change back slashes to forward slashes
	regsub -all {\\} $result / result

	# What is the following line for?  Removed, because it causes an
	# error with "utlFullPath ../samples/3pg.doc" (result is //samples/3pg.doc)
	#regexp {^[a-zA-Z0-9]:(//.+)$} $result _ result

	# Remove all "/./" patterns
	regsub -all {/\./} $result / result

	# Remove all doubled slashes (except at the start for UNC)
	set s1 ""
	set s2 $result
	regexp {^(//)(.*)$} $result _ s1 s2
	regsub -all {//} $s2 / s2
	set result "${s1}${s2}"

	# Windows: prepend drive letter to path if file is in root directory
	if {[utlSysname] == "MSWindows" && [string last "/" $result] == 0} {
		set drive [string range [utlPWD] 0 1]
		if {[regexp {^[a-zA-Z]:$} $drive]} {
			set result $drive$result
		}
	}

	return $result
}


#######################################################################
# Check whether two file names mean the same file.
# In Windows, names are not case sensitive and one could be the shortname.
# On all platforms either one could be relative or absolute.

proc utlSameFile {fname1 fname2} {
	# strip quotes and spaces off end of filenames
	set fname1 [string trim $fname1 { "}]
	set fname2 [string trim $fname2 { "}]
	regsub -all {\\} [utlFullPath $fname1] / fname1
	regsub -all {\\} [utlFullPath $fname2] / fname2
	set fname1 [string trimright $fname1 {/}]
	set fname2 [string trimright $fname2 {/}]
	if {[utlSysname] == "MSWindows"} {
		set fname1 [string tolower [winshortname $fname1]]
		set fname2 [string tolower [winshortname $fname2]]
	}
	if {[string compare $fname1 $fname2] == 0} {return 1}
	return 0
}


#######################################################################
# Copy file to directory or file

proc utlCopyFile {source target {permissions ""}} {
	dbg {>utlCopyFile: $source $target $permissions}

	# Copy the file
	set error [catch {file copy -force -- $source $target} msg]

	if {$error} {
		utlError "utlCopyFile: Could not copy $source to $target ($msg)"
		if {[utlSysname] == "UNIX" && [regexp {^[0-9]+$} $permissions]} {
			utlChmod $target $permissions
		}
		return $source
	}

	# Change the permissions
	if {[utlSysname] == "UNIX" && [regexp {^[0-9]+$} $permissions]} {
		utlChmod $target $permissions
	}

	dbg {<utlCopyFile}
	return ""
}


#######################################################################
# Move file to other name or directory, return non-empty string if error

proc utlMoveFile {source target {permissions ""}} {
	dbg {>utlMoveFile: $source $target $permissions}

	# Resolve wildcards
	set files ""
	set newfiles [glob -nocomplain $source]
	if {$newfiles != ""} {
		set files [concat $files $newfiles]
	} else {
		lappend files $source
	}

	# Initialize result
	# NOTE: The result is the name of the source file/dir if the move
	# failed.  It is "" if there is no error.
	set result ""
	set origsource $source

	# Process each file
	foreach source $files {

		# Attempt to move the file, try up to 3 times
		set nTry 1
		while {[catch {file rename -force -- $source $target} msg]} {
			dbg {Error moving $source to $target: $msg}
			if {$nTry >= 3} {
				utlError "utlMoveFile: Could not move $source to $target"
				set result $origsource
				break
			}
			utlInfo "WARNING (utlMoveFile): Could not move $source to $target, retrying"
			incr nTry
			utlSleep 1
		}

		# Change permissions if needed
		if {[utlSysname] == "UNIX" && [regexp {^[0-9]+$} $permissions]} {
			if {[utlChmod $target $permissions]} {
				utlError "utlMoveFile: Could not change permissions for $target to $permissions"
			} else {
				dbg {Changed permissions for $target to $permissions}
			}
		}
	}

	dbg {<utlMoveFile: $result}
	return $result
}


#######################################################################
# UNC-compatible file listing command, mimic UNIX's "ls" command, but
# only returns filenames (not file attributes)
#
# input: list of directories/filenames, wildcards are acceptable
# output: list of filenames found, full pathnames are always returned

proc utlLS {args} {
	if {[llength $args] == 0} {
		set args "."
	}
	set results ""; set curdir [utlPWD]

	foreach item $args {
		regsub -all {\\} $item / item
		set item [string trimright $item /]
		if {[string index $item 0] == "~"} {
			if {[catch {[file isdirectory $item]}]} {
				set item ./$item
			}
		}
		if {[file isdirectory $item]} {
			append item "/*"
		}
		cd [file dirname $item]
		if {[utlSysname] == "UNIX"} {
			foreach file [lsort [glob -nocomplain *]] {
				if {[string index $file 0] == "~"} {
					set file ./$file
				}
				if {[string match [file tail $item] [file tail $file]] && \
				![utlIn [utlFullPath $file] $results]} {
					lappend results [utlFullPath $file]
				}
			}
		} else {
			# make match case insensitive for MS Windows
			foreach file [lsort [glob -nocomplain *]] {
				if {[string index $file 0] == "~"} {
					set file ./$file
				}
				if {[string match [string tolower [file tail $item]] \
				[string tolower [file tail $file]]] && \
				![utlIn [utlFullPath $file] $results]} {
					lappend results [utlFullPath $file]
				}
			}
		}
		cd $curdir
	}
	return $results
}


#######################################################################
# sort a list of files by their "file stat" values
#
proc utlFileSort {filelist {type ctime} {order ascending}} {
	dbg {>filesort: $filelist type=$type order=$order}

	# build ordered and non_ordered lists
	set ordered ""; set non_ordered ""
	foreach f $filelist {
		if {[catch {file stat $f stat} msg]} {
			dbg {*** cannot get file stat on $f : $msg}
			lappend non_ordered $f
		} elseif {[catch {set value $stat($type)} msg]} {
			dbg {*** cannot determine stat($type) : $msg}
			lappend non_ordered $f
		} else {
			# check for first item
			if {[llength $ordered] == 0} {
				lappend ordered [list $f $value]
				continue
			}

			# sort item
			set addidx -1
			if {$order == "ascending"} {
				# sort in ascending order
				for {set i 0} {$i < [llength $ordered]} {incr i} {
					set compare [string compare $value [lindex [lindex $ordered $i] 1]]
					if {$compare < 0} {
						set addidx $i
						break;
					}
				}

			} else {
				# sort in descending order
				for {set i 0} {$i < [llength $ordered]} {incr i} {
					set compare [string compare $value [lindex [lindex $ordered $i] 1]]
					if {$compare > 0} {
						set addidx $i
						break;
					}
				}
			}

			# add to list
			if {$addidx >= 0} {
				set ordered [linsert $ordered $addidx [list $f $value]]
			} else {
				lappend ordered [list $f $value]
			}
		}
	}

	# generate file list (ordered items first)
	set result ""
	foreach item $ordered {
		lappend result [lindex $item 0]
	}
	foreach item $non_ordered {
		lappend result $item
	}

	# return result
	dbg {<filesort: $result}
	return $result
}


#######################################################################
# Create directory

proc utlMkdir {name {permissions ""}} {
	dbg {utlMkdir $name $permissions}
	mkdir [utlNativeFileName $name]
	if {[utlSysname] == "UNIX" && [regexp {^[0-9]+$} $permissions]} {
		utlChmod $name $permissions
	}
}


#######################################################################
# Find a string pattern in a text file (grep)
# returns list of lines; will catch file errors.
# optionally searches just for first (howmany -first).
# can also position in file: positive from beginning; negative from end.

proc utlGrep { pattern filename {howmany -all} {filepos 0}} {
	dbg {utlGrep $pattern $filename $howmany filepos=$filepos}

	# Error check: return if file isn't accessible
	if {![file readable $filename]} {return ""}

	# Emulate UNIX grep; can't trust eof on Windows because of binary data
	if {[catch {set file [utlOpen $filename r]}]} {return ""}
	set result {}
	if {[expr abs($filepos)] > [file size $filename]} {
		dbg {Warning: filepos value is larger than the file size; no file position change done}
	} else {
		if {$filepos > 0} {
			seek $file $filepos
		} elseif {$filepos < 0} {
			seek $file $filepos end
		}
	}

	# Make sure backslashes are not considered escapes (tcl 8 regexp fails)
	regsub -all {\\} "$pattern" {\\\\} pattern

	# Search method depends on the OS and options
	if {$howmany == "-first" && [utlSysname] == "MSWindows" && [string first "*" $pattern] < 0} {
		# use special version of filesearch (needed for binary files)
		set result [filesearch $file $pattern]
	} elseif {$howmany == "-firstline"} {
		# Just check the first line
		set line [gets $file]
		if {[regexp $pattern $line]} {
			set result $line
		}
	} else { 
		fileproc $file line * {
			if {[regexp $pattern $line]} {
				if {$howmany == "-all"} {
					lappend result $line
				} else {
					set result $line
					break
				}
			}
		}
	}
	utlClose $file
	return $result
}


#######################################################################
# Filter text file to suppress lines between and/or including two string patterns.
# Copies result to other file; will catch file errors and report.
# Optionally searches just for first (howmany -first), default is -all.
# Can also determine whether to strip begin and end lines or keep one or
# the other (-stripboth, -stripbegin, -stripend, -stripnone).

proc utlFilterFile {infile bgnpattern endpattern outfile {howmany -all} {mode -stripboth}} {
	dbg {utlFilterFile $infile $bgnpattern $endpattern $outfile $howmany}
	if {[catch {set ifile [utlOpen $infile r]}]} {utlError "could not open file $infile"; return}
	if {[catch {set ofile [utlOpen $outfile w]}]} {utlError "could not write file $outfile"; utlClose $ifile; return}
	
	set ignore 0; set count 0
	fileproc $ifile line * {
		if {($howmany == "-all" || $count == 0) && !$ignore && [regexp $bgnpattern $line]} {
			if {$mode == "-stripend" || $mode == "-stripnone"} {puts $ofile $line}
			set ignore 1
		}
		if {!$ignore} {
			puts $ofile $line
		} elseif {[regexp $endpattern $line]} {
			if {$mode == "-stripbegin" || $mode == "-stripnone"} {puts $ofile $line}
			set ignore 0; incr count
		}
	}
	utlClose $ifile
	utlClose $ofile
}


#######################################################################
# Filter text file to keep only the lines between and including two string patterns
# (complement of utlFilterFile)

proc utlExtractFile { infile bgnpattern endpattern outfile {howmany -all} {mode -append}} {
	dbg {utlExtractFile $infile $bgnpattern $endpattern $outfile $howmany $mode}

	# open files
	if {[catch {set ifile [utlOpen $infile r]}]} {
		utlError "could not open file $infile"
		return
	}
	if {$mode == "-append"} {
		set mode "a+"
	} else {
		set mode "w"
	}
	if {[catch {set ofile [utlOpen $outfile $mode]}]} {
		utlError "could not write file $outfile"
		utlClose $ifile
		return
	}

	# extract file
	set extract 0
	fileproc $ifile line * {
		if {[regexp $bgnpattern $line]} { set extract 1 }
		if {$extract} { puts $ofile $line }
		if {[regexp $endpattern $line]} {
			set extract 0
			if {$howmany != "-all"} break
		}
	}
	utlClose $ifile
	utlClose $ofile
}


#######################################################################
# Substitute string in each line of file

proc utlSubstFile {infname pattern replace outfname} {
	dbg {utlSubstFile $infname $pattern $replace $outfname}

	# return if file isn't accessible
	if {![file exists $infname] || ![file readable $infname]} {
		return 0
	}

	if {[utlSysname] == "MSWindows"} {
		filesubst $infname $pattern $replace $outfname
	} else {
		utlExec sed -e s/$pattern/$replace/g $infname > $outfname
	}
}


#######################################################################
# csplit (UNIX command) - split files at character string

proc utlCSplit { string file pages} {
	dbg {utlCSplit $string $file $pages}

	# verify inputs
	set stringlen [string length $string]
	if {$stringlen > 1000} {
		dbg {*** string is too long}
		return ""
	}
	if {$stringlen == 0} {
		dbg {*** null string}
		return ""
	}
	if {![file isfile $file] || ![file readable $file]} {
		dbg {*** file $file not accessible}
		return ""
	}
	if {![regexp {[0-9]+} $pages]} {
		dbg {*** invalid page specification}
		return ""
	}

	# create temp directory
	set curdir [utlPWD]
	set file [utlFullPath $file]
	set workdir [utlTempMkdir cspl]
	cd $workdir

	# perform split
	if { [utlSysname] != "MSWindows" } {
	catch {exec csplit -k -s $file "/$string/" "\{$pages\}"}
	cd $curdir
	return [utlLS $workdir/xx*]
	} else {
	# NOTE: pages is ignored for MSWindows

	# open input file
	if {[catch {set oldfd [utlOpen $file r]}]} {
		dbg {*** could not open input file $file}
		cd $curdir
		utlRM $workdir
		return ""
	}

	# create output file
	set pageidx 0
	set newfile [format "xx%02d" $pageidx]
	dbg {creating new file $newfile}
	if {[catch {set curfd [utlOpen $newfile w]}]} {
		dbg {*** could not open output file $newfile}
		utlClose $oldfd
		cd $curdir
		utlRM $workdir
		return ""
	}

	# split file
	set buff ""; set started 0
	while {1} {
		# read more from input file if necessary
		if {[string length $buff] < 7000} {
		append buff [read $oldfd 10000]
		}
		set bufflen [string length $buff]
		if {$bufflen <= 0} {
		break
		}

		# split buffer
		set idx [string first $string $buff]
		if {$idx < 0} {
		# if string not found, then put buffer in current file
		if {$bufflen <= 5000} {
			puts -nonewline $curfd $buff
			set buff ""
		} else {
			puts -nonewline $curfd [string range $buff 0 4999]
			set buff [string range $buff 5000 end]
		}
		} elseif {$idx == 0} {
		# if string into current file
		puts -nonewline $curfd [string range $buff 0 [expr {$stringlen - 1}]]
		set buff [string range $buff $stringlen end]
		
		# close current file, open next file if next string
		# immediately follows
		if {[string first $string $buff] == 0} {
			utlClose $curfd
			incr pageidx
			set newfile [format "xx%02d" $pageidx]
			dbg {creating new file $newfile}
			if {[catch {set curfd [utlOpen $newfile w]}]} {
			dbg {*** could not open output file $newfile}
			utlClose $oldfd
			cd $curdir
			utlRM $workdir
			return ""
			}
		}
		} else {
		# if string is found, then split buffer into current file
		# and next file
		puts -nonewline $curfd [string range $buff 0 [expr {$idx -1}]]
		set buff [string range $buff $idx end]
		utlClose $curfd
		incr pageidx
		set newfile [format "xx%02d" $pageidx]
		dbg {creating new file $newfile}
		if {[catch {set curfd [utlOpen $newfile w]}]} {
			dbg {*** could not open output file $newfile}
			utlClose $oldfd
			cd $curdir
			utlRM $workdir
			return ""
		}
		}
	}

	# close files, then return result
	utlClose $curfd
	utlClose $oldfd
	cd $curdir
	return [utlLS $workdir/xx*]
	}
}


##########################################################
# Perform regsub substitutions on each line in a file

proc utlRegsubFile {infile patterns newvals} {
	dbg {>utlRegsubFile: $infile $patterns $newvals}

	set wildsubs {}
	# do simple case first (substitutions without wildcards)
	foreach pat $patterns value $newvals {
		if {$pat == "" || $value == ""} {
			dbg {*** mismatched lists}
			break
		}
		if {[string first "*" $pat] < 0} {
			set outfile [utlOutFile $infile ps]
			regsub -all {\.} $pat "?" pat
			utlSubstFile $infile $pat $value $outfile
			set infile $outfile
		} else {
			lappend wildsubs $pat $value
		}
	}

	if {$wildsubs != {}} {
		# do wildcard substitutions
		set inf ""; set outf ""
		set inf [utlOpen $infile r]
		if {[string length $inf] == 0} {
			dbg {*** cannot open $infile}
			return
		}
		set outfile [utlOutFile $infile ps]
		set outf [utlOpen $outfile w]
		if {[string length $outf] == 0} {
			dbg {*** cannot open $outfile}
			utlClose $inf
			return
		}
		
		# do pattern matching
		fileproc $inf line * {
			foreach {pat value} $wildsubs {
				regsub -all $pat $line $value line
			}
			puts $outf $line
		}

		# close files and return
		utlClose $inf
		utlClose $outf
	}
	dbg {<utlRegsubFile: $outfile}
	return $outfile
}


#######################################################################
# Wait for a file to appear

proc utlWaitForFile { filename {timeout 60} {pause 3}} {
	dbg {>utlWaitForFile: $filename $timeout $pause}

	while {[glob -nocomplain $filename] == "" && $timeout > 0} {
		utlSleep $pause
		incr timeout -$pause
	}

	dbg {<utlWaitForFile}
}


#######################################################################
# Check that a file exists and its size is not <= than $size, if 
# necessary delete

proc utlCheckFile {filename {action -nothing} {size 0}} {
	dbg {>utlCheckFile: file=$filename, action=$action, size=$size}

	# Check file existance
	if {![file isfile $filename]} {
		dbg {<utlCheckFile: file does not exist}
		return 0
	}

	# Determine file size
	set fsize 0
	if {[catch {set fsize [file size $filename]}]} {
		dbg {<utlCheckFile: failed to get size}
		return 0
	}

	# Determine if size is too low (0 in most cases)
	if {$fsize <= $size} {
		dbg {File size less than $size ($fsize)}
		if {$action == "-delete"} {
			dbg {Deleting file ...}
			utlRM $filename
		}
		dbg {<utlCheckFile}
		return 0
	}

	dbg {<utlCheckFile: File complete}
	return 1
}


#######################################################################
# Check that file is completely copied or created
# (e.g. while waiting in watch mode).

proc utlCheckFileComplete { filename {ackdlgs ""} {pause 2} {timeout 300} {timeout0 30} } {
	dbg {>utlCheckFileComplete: filename=$filename, ackdlgs=$ackdlgs, pause=$pause, timeout=$timeout, timeout0=$timeout0}

	# Provide backward-compatability with the older version of the parameter
	if {$ackdlgs == 1} {set ackdlgs "-ackdlgs"}

	# Make sure that nothing here interupts the conversion
	set msg ""
	set error [catch {

		# Determine the pause value
		if {![regexp {^[0-9]+$} $pause]} {set pause 2}
		set pausesetting [utlDefault FileCheckPause Converter]
		if {$pausesetting != ""} {
			dbg {utlCheckFileComplete: pause parameter=$pause, FileCheckPause setting=$pausesetting}
		}
		if {[regexp {^[0-9]+$} $pausesetting]} {set pause $pausesetting}
		if {$pause < 2} {set pause 2}

		# Determine the timeout value
		set timeoutsetting [utlDefault FileCheckWait Converter]
		if {$timeoutsetting != ""} {
			dbg {utlCheckFileComplete: timeout parameter=$timeout, FileCheckWait setting=$timeoutsetting}
		}
		if {[regexp {^[0-9]+$} $timeoutsetting]} {set timeout $timeoutsetting}
		if {$timeout < 2} {set timeout 2}

		# Determine the timeout0 value
		set timeout0setting [utlDefault FileCheckWaitForZero Converter]
		if {$timeout0setting != ""} {
			dbg {utlCheckFileComplete: timeout0 parameter=$timeout0, FileCheckWaitForZero setting=$timeout0setting}
		}
		if {[regexp {^[0-9]+$} $timeout0setting]} {set timeout0 $timeout0setting}
		if {$timeout0 < 2} {set timeout0 2}

		# timeout should be at least as much as timeout0
		if {$timeout0 > $timeout} {set timeout $timeout0}

		# Debug output for the parameters that will be used
		dbg {utlCheckFileComplete: file=$filename, pause=$pause, timeout=$timeout, timeout0=$timeout0}

		# Check for file size changes or time-out, if needed
		if {[file exists $filename]} {
			set size [file size $filename]
		} else {
			set size 0
		}
		for {set i 0} {$i < $timeout} {incr i $pause} {

			# Acknowledge dialogs
			if {$ackdlgs == "-ackdlgs"} {prpWinAckDlgs}

			# Pause
			utlSleep $pause

			# Get the current file size
			if {[file exists $filename]} {
				set cursize [file size $filename]
			} else {
				set cursize 0
			}

			# Check timeouts or if done 
			if {$size != $cursize} {
				set size $cursize 
			} elseif {$size == 0 && $i < $timeout0} {
				# assume the file size may still increase
			} else {
				break
			}
		}
	} msg]

	# Display any errors
	if {$error} {
		utlError "utlCheckFileComplete failed: $msg"
	}

	dbg {<utlCheckFileComplete}
}


########################################################################
# Determine a file's transfer filename based on the time

proc utlGetTransferName { filename serverdir {ext ""}} {

	set filename [string tolower $filename]
	set ext [string tolower $ext]
	dbg {>utlGetTransferName: filename=$filename serverdir=$serverdir ext=$ext}
	
	# ensure serverdir exists
	if { ![file isdirectory $serverdir] || ![file writable $serverdir]} {
		utlError "Server directory $serverdir not accessible"
		dbg {<utlGetTransferName: ERROR}
		return
	}
	
	# set filename extension if not given
	if {$ext == ""} {
		# if extension not specified, use the input filename's extension
		set ext [file extension $filename]
	} elseif {[string index $ext 0] != "."} {
		set ext ".$ext"
	}
	set ext [string range $ext 0 3]

	# Create a unique filename.  In very rare cases, another machine may
	# have created the same name, so make sure that the filename is not 
	# already being used in serverdir's "in" or "out" subdirectories.
	set indir $serverdir/in
	set outdir $serverdir/out
	set idx 0
	set newname "t[utlUniqueString]$ext"
	set result ""
	while {$idx < 10000000} {

		# return the new filename only when we're sure it's unique
		if {![file exists $indir/$newname] && \
		![file exists $outdir/$newname]} {
			set result $newname
			break
		}

		# compute a new name if it's not unique
		dbg {got filename conflict: $fvalue}
		set newname "t[utlUniqueString]$ext"
		incr idx
	}

	# If a unique filename couldn't be found, then abort program
	if {$result == ""} {
		utlError "Could not compute a unique filename for $filename for directories $indir and $outdir"
		dbg {<utlGetTransferName: ERROR}
		utlExit
	}

	dbg {<utlGetTransferName: $result}
	return $result
}


########################################################################
# Set file permissions

proc utlSetFilePermissions {files} {
	global FILEPERMS
	if {[utlSysname] != "UNIX"} return

	if {![info exists FILEPERMS]} {
	set FILEPERMS [utlDefault ClientOutUmask]
	if {[string length $FILEPERMS] == 0} {
		return ""
	} elseif {[regexp {^[0-9]+$} $FILEPERMS]} {
		set FILEPERMS [oct2dec $FILEPERMS]
	} else {
		utlError "Invalid ClientOutUmask setting: $FILEPERMS"
		set FILEPERMS ""
	}
	}

	if {[string length $FILEPERMS] == 0} return
	dbg {chmod $FILEPERMS $files}
	foreach file $files {utlChmod $file $FILEPERMS}
}


########################################################################
# Check whether or not to use 8.3 filenames

proc utlFile83 {} {
	global FILE83

	if {![info exists FILE83]} {
		set FILE83 0
		if {[utlSysname -full] == "MSWindows 3.x"} {
			set FILE83 1
		} elseif {[utlDefaultBool filename83 Converter]} {
			set FILE83 1
		}
	}

	return $FILE83
}


#######################################################################
# Create an empty file or update its modify date

if {![info exists REQUEST_ID]} {set REQUEST_ID 0}

proc utlLockFile {fname {info ""}} {
	if {[file exists $fname]} {return 0}
	global REQUEST_ID LOCKFILE_ID
	if {![info exists LOCKFILE_ID]} {set LOCKFILE_ID [utlUniqueString]}
	if {$info == ""} {set info $REQUEST_ID}
	dbg {utlLockFile $fname $info}
	set line "$LOCKFILE_ID $info"
	if {[catch {set file [utlOpen $fname a]; puts $file $line; utlClose $file}]} {
		return 0
	}
	if {[catch {set file [utlOpen $fname r]}]} {return 0}
	if {[read $file [string length $line]] == $line} {
		utlClose $file
		dbg {utlLockFile $fname - got it}
		return 1
	}
	utlClose $file
	return 0
}


######################################################################
# Window-related routines
######################################################################

#######################################################################
# Wait for application window to show up (-showup) or disappear
# (-disappear).

proc utlWaitForWindow {WinClass {Mode -disappear} {Timeout 360000}} {
	if {[utlSysname] == "MSWindows"} {
		if {$Mode == "-showup"} {
			while {![winexists $WinClass] && $Timeout > 0} {
				utlSleep 5
				incr Timeout -5
			}
		} else {
			while {[winexists $WinClass] && $Timeout > 0} {
				utlSleep 5
				incr Timeout -5
			}
		}
	}
}


#######################################################################
# Waits for a windows to appear or disappear
#
# Differs from utlWaitForWindow in the parameters available and in
# that pause and timeout are in milliseconds.
#
# Parameters:
#    mode: "-appear" or "-disappear"
#    winclass, wintitle: info to find the window, one of the two may
#     be "" (optional).
#    pause: delay between checking again (in milliseconds)
#    timeout: maximum time to keep checking (in milliseconds)

proc utlWaitForWindow2 {mode winclass wintitle pause timeout} {
	dbg {>utlWaitForWindow2: $mode $winclass $wintitle $pause $timeout}

	# Determine mode
	if {[string match "-dis*" $mode]} {
		set disappearmode 1
	} elseif {[string match "-app*" $mode]} {
		set disappearmode 0
	} else {
		utlError "Invalid mode \"$mode\""
	}

	# Initializations
	set time 0
	set complete 1

	# Wait loop
	while {1} {

		# Dialog checks
		if {$disappearmode} {
			if {![winexists $winclass $wintitle]} {
				break
			}
		} else {
			if {[winexists $winclass $wintitle]} {
				break
			}
		}

		# Timeout check
		if {$time >= $timeout} {
			set complete 0
			break
		}

		utlConsoleYield
		after $pause
		incr time $pause
	}

	dbg {<utlWaitForWindow2: $complete}
	return $complete
}


#######################################################################
# Send a series of character-related commands to a window
#
# Structure of the "commands" parameter:
# commands = "command param command param ..."
# command = STRING | BACKSPACE | RIGHT | LEFT
# string param = [value]
# other command = [repeat]

proc utlSendChars {commands class {title ""} {chclass ""} {chid ""}} {
	dbg {>utlSendChars: $commands $class $title $chclass $chid}

	set nIndex 0
	while {$nIndex < [llength $commands]} {
		set type [lindex $commands $nIndex]
		incr nIndex;
		set param [lindex $commands $nIndex]
		dbg {type=$type, param=$param}

		if {$type == "STRING"} {
			set strlen [GetStringByte LENGTH $param]
			for {set index 0} {$index < $strlen} {incr index} {
				set char [GetStringByte %d $param $index]
				catch {winpost $class 258 $char 0 $title $chclass $chid}
			}
		} else {

			if {[regexp {^[0-9]$} $param]} {
				set repeats $param
			} else {
				set repeats 1
			}

			dbg {$type ($repeats times)}

			for {set repeatindex 0} {$repeatindex < $repeats} {incr repeatindex} {
				switch -glob -- $type {

				backsp* { # BACKSPACE
					catch {winpost $class 258 8 0 $title $chclass $chid}
				}

				right {
					catch {winpost $class 256 39 0 $title $chclass $chid}
				}

				left {
					catch {winpost $class 256 37 0 $title $chclass $chid}
				}

				}
			}
		}
	}

	dbg {<utlSendChars}
}


######################################################################
# Stamping-related routines
######################################################################

######################################################################
# add client's attributes to beginning of GENATTR list
# "attrlist" is the client's list of key-value pairs

proc utlAddClientAttributes {attrlist} {
	global GENATTR SAVEGENATTR
	dbg {utlAddClientAttributes $attrlist}
	if {![info exists GENATTR]} {set GENATTR ""}
	set SAVEGENATTR $GENATTR
	set GENATTR [concat $attrlist $GENATTR]
}

######################################################################
# delete client's attributes from beginning of GENATTR list

proc utlDelClientAttributes {} {
	global GENATTR SAVEGENATTR
	dbg {utlDelClientAttributes}
	if {[info exists SAVEGENATTR]} {set GENATTR $SAVEGENATTR}
}


######################################################################
# get attribute from infofile -- used for Metaphase integration

proc utlGetAttribute {attrname {repl ""}} {
	global GENATTR

	dbg {utlGetAttribute $attrname $repl}

	# look for the attribute value
	if {[info exists GENATTR] && [utlHas GENATTR $attrname]} {
		dbg {utlGetAttribute -> [utlGet GENATTR $attrname]}
		return [utlGet GENATTR $attrname]
	} else {
		dbg {utlGetAttribute -> $repl}
		return $repl
	}
}


######################################################################
# get RGB values for a color

proc utlGetRGB {color} {
	# return RGB values taken from rgb.txt
	switch -exact -- [string tolower $color] {
		white	 {return {255 255 255}}
		yellow	 {return {255 255	0}}
		cornsilk {return {255 248 220}}
		green	 {return {	0 255	0}}
		cyan	 {return {	0 255 255}}
		"sky blue"		{return {135 206 235}}
		blue			{return {  0   0 255}}
		"midnight blue" {return { 25  25 112}}
		purple	{return {160  32 240}}
		magenta {return {255   0 255}}
		red 	{return {255   0   0}}
		orange	{return {255 165   0}}
		salmon	{return {250 128 114}}
		gray80	{return {204 204 204}}
		"slate gray" {return {112 128 144}}
		black		 {return {	0	0	0}}
		default {
			if {[regexp {^([0-9]+)[^0-9]+([0-9]+)[^0-9]+([0-9]+)$} $color _ R G B]} {
				return "$R $G $B"
			} else {
				dbg {unrecognized MDS color: $color}
				return {-1 -1 -1}
			}
		}
	}
}


############################################################################
# substitute an MDS command with its value
#
# Inputs: mdsfile: the MDS file
#		  cmd: the command to process
#		  value: the command's value
#		  replaceorig: if == 1, then replace original MDS file with new one
#
# returned is a new MDS file (which may be a temp file that will be deleted
# during cleanup) or the original MDS file
#
# the MDS commands that currently use this procedure are: \File \User

proc utlMDSSub { mdsfile cmd value {replaceorig 0}} {
	dbg {utlMDSSub $mdsfile $cmd $value $replaceorig}

	# return if the command is empty
	if {$cmd == ""} {
	return $mdsfile
	} else {
	set cmdlen [string length $cmd]
	}

	# return if file doesn't exist
	if {![file exists $mdsfile] || ![file readable $mdsfile]} {
	dbg {Dynamic MDS file $mdsfile not accessible}
	return $mdsfile
	}

	# return if the command isn't in the MDS file
	if {[utlGrep $cmd $mdsfile] == ""} {
	return $mdsfile
	}

	# process MDS file
	set newstamp [utlTempFile "mds" "mds"]
	if {[catch {set newfile [utlOpen $newstamp w]}]} {
	utlError "Could not open new stamp $newstamp for $mdsfile"
	return $mdsfile
	}
	foreach line [utlReadFile $mdsfile] {
	# process the command
	set idx [string first $cmd $line]
	while {$idx >= 0} {
		set part1 [string range $line 0 [expr $idx - 1]]
		set part2 [string range $line [expr {$idx + $cmdlen}] end]
		set line [format "%s%s%s" $part1 $value $part2]
		set idx [string first $cmd $line]
	}

	# put new line into temp file
	puts $newfile $line
	}
	utlClose $newfile

	# return the new stamp file, note that this is a temp file and will be
	# removed during cleanup (i.e., when utlRMTempFiles is called)
	if {$replaceorig} {
	utlRM $mdsfile
	utlMoveFile $newstamp $mdsfile
	return $mdsfile
	} else {
	return $newstamp
	}
}


##############################################################################
# prepare a stamp for use by processing various commands
# returns stamp file for use and, if transfer, the list of all \Include, \IncludeScaled, \Image files
# NOTES:
# o 030724: Removed the processing of \File and \Pageno; these MUST be 
# processed fully by the standard mds routine since: 1 - there are now new
# alternate version of these commands and 2 - it must detect and return
# info on the fact that there were certain types of commands processed
# (for example, when the return cvp indicates "HasPageCmd").  There is no
# reason why these must be processed here.

proc utlPrepStamp {stamp {filename ""} {username ""} {pageno ""} {transfer 0}} {
	dbg {>utlPrepStamp $stamp $filename $username $pageno}

	# if this is an SJIS stamp file, then just return it unprocessed
	if {[file isfile $stamp] && [GetIntlCode $stamp "mds"] == "SJIS2JIS"} {
		dbg {<utlPrepStamp: skipping for SJIS2JIS}
		return $stamp
	}

	# if stamp is file, then read it
	if {[string length $stamp] == 0} {return ""}
	if {[file isfile $stamp]} {
		set lines [utlReadAllFile $stamp]
	} else {
		set lines $stamp
	}

#	regsub -all {\\File} $lines $filename lines
	regsub -all {\\User} $lines $username lines

#	if {[string length $pageno] > 0} {
#		regsub -all {\\Pageno} $lines $pageno lines
#	}

	if {$transfer} {
		# Find all the \Image, \Include, \IncludeScaled files
		set l $lines
		set files {}
		set lines ""
		while {[regexp -indices {(\\Image|\\Include(Scaled)?)\(([^,\)]+)} $l _ _ _ fileix]} {
			set ix0 [lindex $fileix 0]
			set ix1 [lindex $fileix 1]
			set file [string range $l $ix0 $ix1]
			if {![utlIn $file $files]} {
				lappend files $file
			}
			append lines [string range $l 0 [expr $ix0-1]] 
			# Replace file by its tail
			append lines [file tail $file]
			set l [string range $l [expr $ix1+1] end]
		}
		append lines $l
	}

	# Create new stamp file; the name should be based on the stamp value
	# only if it actually refers to a file.
	if {[file isfile $stamp]} {
		set newstamp [utlTempSameFile $stamp]
	} else {
		set newstamp [utlTempFile]
	}
	if {[catch {set fd [utlOpen $newstamp w]}]} {
		dbg { *** could not open file $newstamp for writing}
		return $stamp
	}
	puts -nonewline $fd $lines
	utlClose $fd
	if {$transfer} {
		set result [list $newstamp $files]
	} else {
		set result $newstamp
	}
	dbg {<utlPrepStamp returns: $result}
	return $result
}


############################################################################
# Append a commamd or string to the beginning of a command-line stamp.
# This is useful for adding \Pos or other MDS commands to all stamps.
# NOTE: this applies to command-line stamps or stamps specified in the
# configuration file, not to stamps specified in PVL files.

proc utlPrependStamp {mds} {

	# check for StampPrepend setting
	set str [utlDefault StampPrepend]
	if {[string length $str] == 0 || [string length $mds] == 0} {
		# nothing to prepend
		dbg {utlPrependStamp (from [utlParentProc]): nothing to prepend, returning $mds}
		return $mds
	}

	# check for MDS file
	set newmds [utlTempFile prepend mds]
	if {[file isfile $mds]} {
		# prepend the string to file, return new file
		if {![catch {
			# open new file, prepend string to file
			set fd [utlOpen $newmds w]
			puts -nonewline $fd $str
			foreach line [utlReadFile $mds] {
				puts $fd $line
			}
			utlClose $fd
		}]} {
			# error, return original stamp
			dbg {utlPrependStamp (from [utlParentProc]): could not prepend \"$str\" to $mds}
			return $mds
		}

		# return new stamp
		dbg {utlPrependStamp (from [utlParentProc]): prepended \"$str\" to $mds -> new stamp file $newmds}
		return $newmds
	}

	# return prepended stamp string
	dbg {utlPrependStamp (from [utlParentProc]): prepended \"$str\" to $mds -> new stamp string $str$mds}
	return $str$mds
}


############################################################################
# Apply a stamp to a viewlist, processing \File and \User where possible.
# If a viewset contains a PVL file, the viewlist is expanded into include
# the viewsets in the PVL file.  A new viewlist containing a stamp in every
# viewset is returned.	Viewsets with pre-existing stamps retain their
# stamps with the \File and \User commands processed.
# If transfer, returns also the list of all \Include files in the stamps

proc utlApplyStamp { viewlist {cmdstamp ""} {cvp ""} {transfer 0}} {
	dbg {>utlApplyStamp $viewlist $cmdstamp}

	# determine if we're doing PDF background printing
	set pdfbgprint [utlHas cvp pdfbgprint]

	# build stamp file if necessary
	if {[string length $cmdstamp] > 0 && ![file isfile $cmdstamp]} {
		set temp [utlTempFile temp mds]
		utlPutFile $temp $cmdstamp
		set cmdstamp $temp
	}

	# expand all viewsets with PVL files
	set oldviewlist $viewlist; set viewlist ""
	foreach viewset $oldviewlist {
		utlFields [lindex $viewset 0] _ file format
		set file [utlFullPath $file]
		if {$format == "-"} {set format [prpFileType $file]}
		if {$format == "pvl"} {
			set viewlist [concat $viewlist [lrange [pvAnalyzeVL $file] 1 end]]
		} else {
		lappend viewlist $viewset
	}
	}

	# process the viewlist
	set oldviewlist $viewlist; set viewlist ""; set showmsg 0; set includefiles {}
	foreach viewset $oldviewlist {
		# check viewset for pre-existing stamp and get filename for \\File
		set sheetnames ""; set vsstamp ""; set fname ""
		foreach sheet $viewset {
			utlFields $sheet sname file format
			lappend sheetnames $sname
			set file [utlFullPath $file]
			if {$format == "-"} {set format [prpFileType $file]}
			if {$format == "mds"} {set vsstamp $file}
			if {[string length $fname] == 0 && ![utlIn $format {mds ovl}]} {
				set fname [file tail $file]

				# change file.ps to file.pdf
				set ext [file extension $fname]
				if {$pdfbgprint && $ext == ".ps"} {
					set fname [file rootname $fname].pdf
				}
			}
		}
		if {[llength $sheetnames] == 0} {
			lappend viewlist {}
			continue
		}

		# add stamp to the viewset
		if {[file isfile $vsstamp]} {
			# check for custom stamping procedure
			set CusStamp [utlDefault CustomStamp]
			if {[string length [info procs $CusStamp]] > 0} {
				set stamp [$CusStamp $vsstamp $fname [utlGetUsername]]
				set prepstamp [utlPrepStamp $stamp $fname [utlGetUsername] "" $transfer]
			} else {
				if {[file isfile $cmdstamp]} {set showmsg 1}
				set prepstamp [utlPrepStamp $vsstamp $fname [utlGetUsername] "" $transfer]
			}
			if {$transfer} {
				set stamp [lindex $prepstamp 0]
				set includefiles [concat $includefiles [lindex $prepstamp 1]]
			} else {
				set stamp $prepstamp
			}

			# replace viewset stamp if necessary
			if {$stamp != $vsstamp} {
				set oldviewset $viewset; set viewset ""
				foreach sheet $oldviewset {
					utlFields $sheet _ file format
					set file [utlFullPath $file]
					if {$format == "-"} {set format [prpFileType $file]}
					if {$format == "mds"} {set sheet [lreplace $sheet 1 1 $stamp]}
					lappend viewset $sheet
				}
			}
		} elseif {[file isfile $cmdstamp]} {
			# check for custom stamping procedure
			set CusStamp [utlDefault CustomStamp]
			if {[string length [info procs $CusStamp]] > 0} {
				set cmdstamp [$CusStamp $cmdstamp $fname [utlGetUsername]]
			}

			# add new stamp to viewset
			set prepstamp [utlPrepStamp $cmdstamp $fname [utlGetUsername] "" $transfer]
			if {$transfer} {
				set stamp [lindex $prepstamp 0]
				set includefiles [concat $includefiles [lindex $prepstamp 1]]
			} else {
				set stamp $prepstamp
			}
			set idx 1; set sname "MDS1"
			while {[string match "*${sname}*" $sheetnames]} {
				set sname [format "MDS%d" [incr idx]]
			}
			lappend viewset [list $sname $stamp "mds"]
		}

		if {[utlHas cvp combine] && [utlDefaultBool StampFirstPageOnly]} {set cmdstamp ""}
		lappend viewlist $viewset
	}

	if {$showmsg} {
		utlInfo "Applying Viewlist stamp instead of command line or resource file stamp"
	}

	# return the viewlist and, if transfer, the includefiles list
	if {$transfer} {
		set result [list $viewlist $includefiles]
	} else {
		set result $viewlist
	}
	dbg {<utlApplyStamp: $result}
	return $result
}


######################################################################
# Banner page routines
######################################################################

######################################################################
# 
# Get the BannerPage and BannerInfo files to be used.
#
# The following are checked (in order of priority) for the banner page:
#   1. configuration settings: Banner=none or <PRINTER>Banner=none
#   2. command line: -banner <FILE or STRING>
#   3. configuration setting: <PRINTER>Banner=<FILE or STRING>
#   4. configuration setting: Banner=<FILE or STRING>
#
# The following are checked (in order of priority) for the banner info
# page:
#   1. command line: -bannerinfo <FILE>
#   2. configuration setting: <PRINTER>BannerInfo=<FILE>
#   3. configuration setting: BannerInfo=<FILE>

proc utlGetBanner {cvp} {

	# get command-line settings
	set printer [utlGet cvp printer]
	set cmdBanner [utlGet cvp banner]
	set cmdInfo [utlGet cvp bannerinfo]

	# get config settings
	set printerBanner [utlDefault ${printer}Banner]
	set printerInfo [utlDefault ${printer}BannerInfo]
	set defaultBanner [utlDefault Banner]
	set defaultInfo [utlDefault BannerInfo]

	# check for Banner=none (disables banner pages for all pritners)
	if {[string tolower $defaultBanner] == "none"} {
		dbg {-utlGetBanner: banner pages have been disabled for all printers}
		return ""
	}

	# check for <PRINTER>Banner=none (disables banner pages for the selected printer)
	if {[string tolower $printerBanner] == "none"} {
		dbg {-utlGetBanner: banner pages have been disabled for printer $printer}
		return ""
	}

	# check for "-banner none"
	if {[string tolower $cmdBanner] == "none"} {
		dbg {-utlGetBanner: banner pages have been disabled via the command-line}
		return ""	
	}

	# get the banner page
	set banner ""
	if {$cmdBanner != ""} {
		# use the command line value
		set banner $cmdBanner
	} elseif {$printerBanner != ""} {
		# use the <PRINTER>Banner configuration setting
		set banner $printerBanner
	} elseif {$defaultBanner != ""} {
		# use the Banner configuration setting
		set banner $defaultBanner
	}

	# return now if no banner page is specified
	if {$banner == ""} {
		dbg {-utlGetBanner: no banner pages used for printer $printer}
		return ""
	}

	# get the banner info file
	set info ""
	if {$cmdInfo != ""} {
		# use the command line value
		set info $cmdInfo
	} elseif {$printerInfo != ""} {
		# use the <PRINTER>BannerInfo configuration setting
		set info $printerInfo
	} elseif {$defaultInfo != ""} {
		# use the BannerInfo configuration setting
		set info $defaultInfo
	}

	# returned the banner page and bannerinfo file
	dbg {-utlGetBanner: returning: banner=$banner and bannerinfo=$info}
	return [list $banner $info]
}


######################################################################
# 
# Get the banner format by checking for the cvp parameter
# "bannerformat" or the configuration setting "BannerFormat."  The
# default is "txt" for efficiency.

proc utlGetBannerFormat {cvp} {

	# check for command-line setting
	if {[utlHas cvp bannerformat]} {
		set bFormat [utlGet cvp bannerformat] 
		dbg {-utlGetBannerFormat: command-line setting: $bFormat}
		return $bFormat
	}

	# check for the configuration setting
	set bFormat [string tolower [utlDefault BannerFormat]]
	if {[utlIn bFormat {txt mds}]} {
		dbg {-utlGetBannerFormat: configuration setting: $bFormat}
		return $bFormat
	}

	# return the default "txt"
	dbg {-utlGetBannerFormat: default value: txt}
	return "txt"
}


######################################################################
# 
# Prepare a banner page by substituting the \Attribute commands with
# values in the given infofile.  Return a new banner file with the
# substituted values.
#
# In client/server mode, there will be two passes -- the first pass
# (mode = "first") will be done on the client side per the client
# infofile before transferring the banner page to the server.  The
# second and final pass (mode = "final") will be done on the server
# side to process any remaining \Attribute commands per the infofile
# on the server.
#
# Note: The "limit" parameter is the limit on \Attribute commands
# per line.  This is used to prevent endless loops on nested
# \Attribute commands.

proc utlPrepBanner {banner infofile {cvp ""} {mode final} {limit 99}} {

	# parse the infofile
	# if duplicate keys are found just use the last one
	set values() ""
	if {[file isfile $infofile] && [file readable $infofile]} {
		# parse the banner infofile
		foreach line [utlReadFile $infofile] {
			utlFields $line key value
			set values($key) $value
		}
	} else {
		# parse the banner info string
		foreach line [split $infofile] {
			utlFields $line key value
			set values($key) $value
		}
	}

	# open the return file
	set newBanner [utlTempFile $banner [utlGetBannerFormat $cvp]]
	set fd [utlOpen $newBanner w]

	# substitute the values
	foreach line [utlReadFile $banner] {

		# substitute \Date, \Time, and \Copies values
		regsub -all {\\Date} $line [utlGetDate] line
		regsub -all {\\Time} $line [utlGetTime] line
		regsub -all {\\Copies} $line [utlGet cvp copies] line

		# check each line for multiple matches
		set found 1
		set count 0
		while {[incr count] <= $limit && $found} {

			# check for \Attribute(key,replacement text)
			if {[regexp {\\Attribute\(([^,)]+),([^)]+)\)} $line attr key repl]} {
				# check for match
				set found 1
				if {[info exists values($key)]} {
					# exact match found, replace with value
					set line [utlSubstring $line $attr $values($key)]
					set found 1
				} elseif {$mode == "final"} {
					# match not found, replace with blank for final mode
					set line [utlSubstring $line $attr $repl]
					set found 1
				} else {
					set found 0
				}

			# check for \Attribute(key)
			} elseif {[regexp {\\Attribute\(([^)]+)\)} $line attr key] } {
				# check for match
				if {[info exists values($key)]} {
					# exact match found, replace with value
					set line [utlSubstring $line $attr $values($key)]
					set found 1
				} elseif {$mode == "final"} {
					# match not found, replace with blank for final mode
					set line [utlSubstring $line $attr ""]
					set found 1
				} else {
					set found 0
				}

			# break out of loop if no matches are found
			} else {
				set found 0
			}
		}

		# write the new line to the file
		puts $fd $line
	}

	# close the file
	utlClose $fd

	# return the new banner file
	dbg {-utlPrepBanner (from [utlParentProc]): banner=$banner infofile=$infofile mode=$mode --> $newBanner}
	return $newBanner
}


######################################################################
# pvl file routines
######################################################################

############################################################################
# write the conversion parameters to a PVL file (useful for passing the
# conversion parameters from client to server)
# if overwrite=1, then overwrite value if key already exists in file
# return 0=success or 1=fail

proc utlWritePVLValue {infile outfile key value {overwrite 0}} {
	dbg {utlWritePVLValue $infile $outfile $key $value $overwrite}

	# verify files
	if {![file isfile $infile] || ![file readable $infile]} {
	dbg {*** file \"$infile\" is not accessible}
	return 1
	}
	set lines [utlReadFile $infile]
	if {[catch {set ofile [utlOpen $outfile w]} msg]} {
	dbg {*** could not open file \"$outfile\" for writing $msg}
	return 1
	}

	# verify key
	set key [string trim $key]
	set value [string trim $value]
	if {[string length $key] == 0} {
	set wroteval 1
	} else {
	set wroteval 0
	}

	# write new file
	foreach line $lines {
	set line [string trim $line]
	if {[string length $line] == 0} {
		continue
	}
	if {$wroteval} {
		puts $ofile $line
	} elseif {[regexp -nocase {^\#(.+)$} $line _ comment]} {
		# check if key already exists
		utlFields $comment key1
		if {[regexp -nocase $key1 $key]} {
		if {$overwrite} {
			puts $ofile "\# $key \{$value\}"
		} else {
			puts $ofile $line
		}
		set wroteval 1
		} else {
		puts $ofile $line
		}
	} else {
		if {!$wroteval} {
		puts $ofile "\# $key \{$value\}"
		set wroteval 1
		}
		puts $ofile $line
	}
	}
	if {!$wroteval} {
	puts $ofile "\# $key \{$value\}"
	}
	utlClose $ofile
	return 0
}


############################################################################
# retrieve a value (passed as a comment) from a PVL file
# key is case insensitive

proc utlGetPVLValue {infile key} {
	dbg {utlGetPVLValue: $infile $key}
	
	# return if key is blank
	set key [string tolower [string trim $key]]
	if {[string length $key] == 0} {
		return ""
	}

	# return if file doesn't exist
	if {![file isfile $infile] || ![file readable $infile]} {
		dbg {*** file \"$infile\" not accessible}
		return ""
	}

	# search for the key
	foreach line [utlReadFile $infile] {
		set line [string trim $line]
		if {[string index $line 0] != "\#"} {
			continue
		}
		utlFields $line _ key1 value
		set key1 [string tolower $key1]
		if {[string compare $key1 $key] == 0} {
			dbg {utlGetPVLValue returns $value}
			return $value
		}
	}
	
	# return "" if no match found
	return ""
}


#######################################################################
# Type/Number-base/Unit conversion utilities
#######################################################################

#######################################################################
# convert octal to decimal (positive only)

proc oct2dec {val} {
	if {![regexp {^[0-9]+$} $val]} {return 0}
	set result 0
	while {[string length $val] > 0} {
	set result [expr {$result * 8 + [string index $val 0]}]
	set val [string range $val 1 end]
	}
	return $result
}


#######################################################################
# convert decimal to hexidecimal

proc dec2hex {val} {
	set result ""
	if {[catch {set tmp [expr {int($val)}]}]} {return 0}
	while {$tmp > 0} {
	set char [expr {$tmp - ($tmp / 16 * 16)}]
	switch $char {
		10 {set char A}
		11 {set char B}
		12 {set char C}
		13 {set char D}
		14 {set char E}
		15 {set char F}
	}
	set result "${char}$result"
	set tmp [expr {$tmp / 16}]
	}

	if {[string length $result] == 0} {return "0"}
	return $result
}


#######################################################################
# Format a floating point value with no loss in precision
# return null if invalid

proc utlFloat {val} {
	if {![regexp {^-?[0-9.]+$} $val]} {return ""}

	# make sure there's only 1 decimal point
	set first [string first . $val]
	set last [string last . $val]
	if {$first != $last} {return ""}
	if {$first == 0 && [string length $val] == 1} {return ""}

	# format into proper format
	if {$first == -1} { 
		return $val.0
	} elseif {$first == 0} {
		return 0$val
	} elseif {[regexp {[.]$} $val]} {
		return ${val}0
	} else {
		return $val
	}
}

#######################################################################
# Check if a list of arguments are all valid floats.
proc utlIsFloat args {
	# check for empty list
	if {[llength $args] == 0} {
		return 0
	}

	# check if each item is a float
	for {set i 0} {$i < [llength $args]} {incr i} {
		set fval [utlFloat [lindex $args $i]]
		if {[string length $fval] == 0} {
			# non-float found
			return 0
		}
	}

	# all items are floats
	return 1
}


#######################################################################
# Return the ascii value of a given character

proc utlAsciiVal {char} {
	set charsets ""
	lappend charsets [list {ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\} 65]
	lappend charsets [list {]^_`abcdefghijklmnopqrstuvwxyz} 93]
	lappend charsets [list { !"#$%&'()*+'-./0123456789:;<=>?@} 32]
	lappend charsets [list "\{|\}~" 123]
	foreach charset $charsets {
		utlFields $charset matchstr offset
		set pos [string first $char $matchstr]
		if {$pos >= 0} {
			return [expr $pos + $offset]
		}
	}
	return -1
}


#######################################################################
# Returns the conversion factor to convert the given unit to inches
# Use "-defined" to return "" when the unit is not defined (otherwise
# defaults to 1).

proc utlUnit2In {unit {defined ""}} {

	set unit [string tolower $unit]
	switch -glob -- $unit {
		in* { # inches
			return 1
		}
		millimeter* -
		mil -
		mm { # millimeters
			return [expr 1/25.4]
		}
		ce* -
		cm { # centimeters
			return [expr 1.0/2.54]
		}
		fe* -
		ft { # feet
			return 12
		}
		mils -
		mile* -
		mi { # miles
			return [expr 1.0/25400]
		}
		ki* -
		km { # kilometers
			return [expr 1.0/0.0000254]
		}
		pplu -
		plu { # plu's
			return [expr 1.0/1016]
		}
		po* -
		ps { # postscript units
			return [expr 1.0/72]
		}
		micron* { # microns
			# One millionth of a meter
			return [expr 1.0/0.0254/1000000]
		}
		microin* { # microinches
			# One millionth of an inch
			return [expr 1.0/1000000]
		}
		me* -
		m { # meters
			return [expr 1.0/0.0254]
		}
		none -
		un* { # none or unknown
			# Explicitly undefined
			return 1
		}
		default {
			dbg {-utlUnit2In: undefined \"$unit\"}
			if {$defined == "-defined"} {
				return ""
			} else {
				return 1
			}
		}
	}
}


#######################################################################
# Convert a value from one unit to another

proc utlConvertUnits {val oldu newu} {
	set oldu [string tolower $oldu]
	set newu [string tolower $newu]
	if {$oldu == $newu} {
		dbg {utlConvertUnits: no units conversion necessary ($val $oldu $newu)}
		return $val
	}
	set oldconvval [utlUnit2In $oldu -defined]
	set newconvval [utlUnit2In $newu -defined]
	
	if {$oldconvval == "" || $newconvval == ""} {
		dbg {utlConvertUnits: conversion not possible ($val $oldu -> $newu)}
		return $val
	}
	set result [expr {$val * $oldconvval / $newconvval}]
	dbg {ultConvertUnits: $val $oldu -> $result $newu}
	return $result
}


#######################################################################
# Font utilities
#######################################################################

#######################################################################
# Determine if a given font name is an international font or not

proc utlIsIntlFont {infont} {
	global INTLFONTS

	# get list of international fonts, if necessary (support pattern matching)
	if {![info exists INTLFONTS]} {
		# get INI setting
		set INTLFONTS {}
		foreach font [utlDefaultConverter IntlFonts] {
			lappend INTLFONTS [string trim [string tolower $font]]
		}

		# add some default fonts
		foreach font {Ryumin* ExtendedLatin* Hangul* ZenKai* GBZenKai*} {
			if {[lsearch $font $INTLFONTS] < 0} {
				lappend INTLFONTS [string trim [string tolower $font]]
			}
		}
		dbg {International fonts: $INTLFONTS}
	}

	set infont [string tolower $infont]
	set result 0
	foreach font $INTLFONTS {
		if {[string match $font $infont]} {
			set result 1
			break
		}
	}

	# return result
	dbg {utlIsIntlFont: $infont : $result}
	return $result
}


#######################################################################
# Get default font based on locale

proc utlGetDefaultFont {{fmt ps} {locale ""}} {

	# check for <FORMAT>Font ini setting
	set fmt [string toupper $fmt]
	set font [utlDefaultConverter ${fmt}Font]
	if {[string length $font] > 0} {
		dbg {utlGetDefaultFont: $font}
		return $font
	}

	# get locale
	if {[string length $locale] == 0} {
		set locale [utlLanguage]
	}

	# get font based on locale
	set font ""
	switch -- $locale {
		Japanese {set font "Ryumin-Light-H-12"}
		English {set font "Courier-12"}
		ChineseS {
			# use SimHei for Windows, GMZenKai-Medium for UNIX
			if {[utlSysname] == "MSWindows"} {
				set font "SimHei"
			} else {
				set font "GBZenKai-Medium"
			}
		}
		ChineseT {
			# use SimHei for Windows, ZenKai-Medium for UNIX
			if {[utlSysname] == "MSWindows"} {
				set font "SimHei"
			} else {
				set font "ZenKai-Medium"
			}
		}
		Korean {set font "Hangul-12"}
		default {set font "Courier-12"}
	}

	# return result
	dbg {utlGetDefaultFont: $font}
	return $font
}


#######################################################################
# Some fonts do not always handle ascii text properly.
# This routine determines whether or not this is true for a given
# font.

proc utlRequireAsciiFont {font} {
	switch -glob -- $font {
		Ryumin* {set result 1}
		Hangul* {set result 1}
		default {set result 0}
	}
		
	dbg {utlRequireAsciiFont: $font -> $result}
	return $result
}


#######################################################################
# Get font's aspect ratio (width vs. height) so we can do the
# appropriate scaling so none of the text is cropped

proc utlGetFontAspect {fontname} {
	# check INI/resource file for aspect ratio
	set aspect [utlDefaultConverter ${fontname}Aspect]
	if {[string length $aspect] > 0} {
		# check result
		set result [utlFloat $aspect]
		if {[string length $result] > 0} {
			# return result
			dbg {utlGetFontAspect: user-defined value for ${fontname}Aspect : $result}
			return $result
		} else {
			# invalid result
			dbg {utlGetFontAspect: ignoring invalid ${fontname}Aspect: $aspect}
		}
	}

	# set aspect ratio based on fontname
	set lfontname [string tolower $fontname]
	if {[string match *courier* $lfontname]} {
		set result 0.6
	} elseif {[string match *ryumin* $lfontname]} {
		set result 1.0
	} elseif {[string match *extendedlatin* $lfontname]} {
		set result 0.6
	} else {
		set result 0.6
	}

	# return
	dbg {utlGetFontAspect: using default aspect ratio for $fontname: $result}
	return $result
}


#######################################################################
# Get scale value for ASCII Characters
# NOTE: we must always return a valid, non-zero floating value

proc utlGetAsciiScale {} {
	# check INI/resource file for scale value
	set val [utlDefaultConverter AsciiScale]
	utlFields $val xscale yscale
	set xscale [utlFloat $xscale]
	set yscale [utlFloat $yscale]
	if {[string length $xscale] == 0 || [string length $yscale] == 0 ||
		$xscale == 0.0 || $yscale == 0.0} {
		dbg {utlGetAsciiScale: invalid value ($val), ignoring}
		return [list 1.0 1.0]
	}
	dbg {utlGetAsciiScale: using scale values: $xscale $yscale}
	return [list $xscale $yscale]
}


#######################################################################
# Get the HPGL typeface value for a given font.

proc utlGetHPGLFontCode {font} {
	# remove spaces
	regsub -all " " [string tolower $font] "" lfont

	# get fontcode
	set fontcode ""
	switch -glob $lfont {
		"arialunicode*" {set fontcode 903}
		"arial*" {st fontcode 900}
		"bitstreamcharter*" {set fontcode 901}
		"centuryschoolbook*" {set fontcode 23}
		"courier*" {set fontcode 3}
		"draft*" {set fontcode 49}
		"fixedarc*" {set fontcode 50}
		"japanesegothic*" {set fontcode 902}
		"gothic*" {set fontcode 65}
		"hersheystick*" {set fontcode 48}
		"hershey*" {set fontcode 0}
		"timesroman*" {set fontcode 5}
	}

	dbg {utlGetHPGLFontCode: $font -> $fontcode}
	return $fontcode
}


#######################################################################
# Licensing
#######################################################################

#######################################################################
# Perform license checking.
#######################################################################
proc utlCheckLicense {} {
	global env PVDIR PROGRAM VERSION

	# Set EAI_LICENSE_FILE environment variable for Windows (this is
	# done by the launch scripts on Unix)
	if {[utlSysname] == "MSWindows" && ![info exists env(EAI_LICENSE_FILE)]} {
		# read the registy key for EAI_LICENSE_FILE
		set license_file ""
		if {[info exists PROGRAM]} {
			# get the registry key
			set regkey ""
			if {$PROGRAM == "prepare"} {
				set regkey "SOFTWARE\\EDS\\VisView Convert"
			} elseif {$PROGRAM == "pvprint"} {
				set regkey "SOFTWARE\\EDS\\VisView Print"
			}

			# get the version (set in common.tpg)
			if {[info exists VERSION] && [utlIsFloat [lindex $VERSION 0]]} {
				set version [lindex $VERSION 0]
			} else {
				# used for development versions (VERSION is set to "(dev)")
				set version 5.0
			}

			# get the EAI_LICENSE_FILE value for the current version
			if {[string length $regkey] > 0} {
				# get the value for EAI_LICENSE_FILE from the Registry
				set regkey "$regkey\\$version\\Environment"
				catch {set license_file [WinGetRegValue "HKEY_LOCAL_MACHINE" $regkey  "EAI_LICENSE_FILE"]}
				dbg {utlCheckLicense: EAI_LICENSE_FILE from HKEY_LOCAL_MACHINE\\$regkey: $license_file}
			}
		}

		# set default EAI_LICENSE_FILE value, if necessary
		if {[string length $license_file] == 0} {
			set license_file "[file dirname $PVDIR]/License/license_vvcp.dat"
			dbg {utlCheckLicense: using default EAI_LICENSE_FILE value of $license_file}
		}

		# set the environment variable to point to the license file
		dbg {utlCheckLicense: setting env(EAI_LICENSE_FILE) to $license_file}
		set env(EAI_LICENSE_FILE) $license_file
	}

	# perform license checking (allow the error to bubble up)
	check_license
}


#######################################################################
# Independant utilities
#######################################################################

#######################################################################
# Repeat a given command a given number of time
# Also allows for using the special variable "%value"

proc utlRepeat {command start stop {step 1}} {
	for {set value $start} {$value <= $stop} {incr value $step} {
		regsub -all %value $command $value command2
		if [catch {eval $command2} msg] {
			puts "ERROR: $msg"
		}
	}
}

 
#######################################################################
# show files referenced in a tclIndex file (useful for comparing 2
# tclIndex files)

proc showIndexFiles {fname} {
	if {[catch {set fd [utlOpen $fname r]}]} {
		utlError "couldn't open file $fname"
		return ""
	}

	set files ""
	fileproc $fd line * {
		if {[regexp {/([^\.]+).tcl} $line _ f]} {
			if {[lsearch -exact $files $f] < 0} {
				lappend files $f				
			}
		}
	}
	utlClose $fd
	return [lsort $files]
}


#######################################################################
# Generate a log file of checksums (Unix only)
# NOTE: Use checksums, not checksumsrecurse (that is just the
# recursive part of the code)

proc checksumsrecurse {dir logfile} {
	set files [exec ls -a $dir]
	foreach item $files {
		if {[file isfile $item]} {
			utlExec cksum $item >> $logfile
		} elseif {![utlIn $item {. ..}]} {
			checksumsrecurse "$item" $logfile
		}
	}
}


proc checksums {{dir ""} {logfile ""}} {
	if {[utlSysname] == "MSWindows"} {
		utlInfo "checksums is not available on windows"
	}
	if {$dir == ""} {
		set dir [pwd]
	}
	if {$logfile == ""} {
		set logfile "$dir/logfile.txt"
	}
	if {[file exists $logfile]} {
		utlRM $logfile
	}
	checksumsrecurse $dir $logfile
}