#####################################################################
# @(#)init.tcl 1.3 2/15/01
#
# init.tcl: Defines "unknown" and auto-loading procedures.  Loaded
# automatically by the standard interpreter code at startup.
#
# Copyright (C) 2004 Electronic Data Systems Corporation.  All Rights Reserved.
#
# Based on default init.tcl, Copyright (C) 1991-1993 The Regents of 
# the University of California.  All rights reserved.
#
#####################################################################

# Auto-loading-related globals:
global auto_path
set auto_path [list [info library]]

#####################################################################
# unknown:
# Invoked when a Tcl command is invoked that doesn't exist in the
# interpreter:
#
#	1. See if the autoload facility can locate the command in a
#	   Tcl script file.  If so, load it and execute it.
#	2. See if the command exists as an executable UNIX program.
#	   If so, "exec" the command.
#	3. If the command was invoked at top-level:
#		(a) see if the command requests csh-like history substitution
#		in one of the common forms !!, !<number>, or ^old^new.	If
#		so, emulate csh's history substitution.
#		(b) see if the command is a unique abbreviation for another
#		command.  If so, invoke the command.

proc unknown args {
	global auto_noexec auto_noload env unknown_pending tcl_interactive;

	set name [lindex $args 0]
	if ![info exists auto_noload] {
		#
		# Make sure we're not trying to load the same proc twice.
		#
		if [info exists unknown_pending($name)] {
			unset unknown_pending($name)
			if {[array size unknown_pending] == 0} {
				unset unknown_pending
			}
			return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
		}
		set unknown_pending($name) pending;
		set ret [catch {auto_load $name} msg]
		unset unknown_pending($name);
		if {$ret != 0} {
			return -code $ret "error while autoloading \"$name\": $msg"
		}
		if ![array size unknown_pending] {
			unset unknown_pending
		}
		if $msg {
			return [uplevel $args]
		}
	}
	
	if {([info level] == 1) && ([info script] == "") && $tcl_interactive} {
		if ![info exists auto_noexec] {
			if [auto_execok $name] {
				return [uplevel exec >&@stdout <@stdin $args]
			}
		}
		if {$name == "!!"} {
			return [uplevel {history redo}]
		}
		if [regexp {^!(.+)$} $name dummy event] {
			return [uplevel [list history redo $event]]
		}
		if [regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new] {
			return [uplevel [list history substitute $old $new]]
		}
		set cmds [info commands $name*]
		if {[llength $cmds] == 1} {
			return [uplevel [lreplace $args 0 0 $cmds]]
		}
		if {[llength $cmds] != 0} {
			if {$name == ""} {
				return -code error "empty command name \"\""
			} else {
				return -code error \
				"ambiguous command name \"$name\": [lsort $cmds]"
			}
		}
	}

	return -code error "invalid command name \"$name\""
}


#####################################################################
# auto_load:
# Checks a collection of library directories to see if a procedure
# is defined in one of them.  If so, it sources the appropriate
# library file to create the procedure.  Returns 1 if it successfully
# loaded the procedure, 0 otherwise.

proc auto_load cmd {
	global auto_index auto_oldpath auto_path env errorInfo errorCode

	# If the load command has already been read from the tclIndex, attempt to
	# use it.
	if {[info exists auto_index($cmd)]} {
		uplevel #0 $auto_index($cmd)
		if {[info commands $cmd] == ""} {
			return 0
		} else {
			return 1
		}
	}
	
	if [catch {set path $auto_path}] {
		if [catch {set path $env(TCLLIBPATH)}] {
			if [catch {set path [info library]}] {
				return 0
			}
		}
	}
	
	if [info exists auto_oldpath] {
		if {$auto_oldpath == $path} {
			return 0
		}
	}
	set auto_oldpath $path
	catch {unset auto_index}
	
	for {set i [expr [llength $path] - 1]} {$i >= 0} {incr i -1} {
		set dir [lindex $path $i]
		set f ""
		if [catch {set f [open $dir/tclIndex]}] {
			continue
		}
		set error [catch {
			set id [gets $f]
			if {[string match "# Tcl autoload index file*" $id]} {
				eval [read $f]
			} else {
				error "$dir/tclIndex isn't a proper Tcl index file"
			}
		} msg]
		if {$f != ""} {
			close $f
		}
		if $error {
			error $msg $errorInfo $errorCode
		}
	}
	
	if [info exists auto_index($cmd)] {
		uplevel #0 $auto_index($cmd)
		if {[info commands $cmd] != ""} {
			return 1
		}
	}
	return 0
}


#####################################################################
# auto_execok:
# Returns 1 if there's an executable in the current path for the
# given name, 0 otherwise.	Builds an associative array auto_execs
# that caches information about previous checks, for speed.

proc auto_execok name {
	global auto_execs env

	if [info exists auto_execs($name)] {
		return $auto_execs($name)
	}
	set auto_execs($name) 0
	if {[string first / $name] >= 0} {
		if {[file executable $name] && ![file isdirectory $name]} {
			set auto_execs($name) 1
		}
		return $auto_execs($name)
	}
	foreach dir [split [utlGetEnv "PATH"] :] {
		if {[file executable $dir/$name] && ![file isdirectory $dir/$name]} {
			set auto_execs($name) 1
			return 1
		}
	}
	return 0
}


#####################################################################
# auto_reset:
# Destroy all cached information for auto-loading and auto-execution,
# so that the information gets recomputed the next time it's needed.
# Also delete any procedures that are listed in the auto-load index
# except those related to auto-loading.

proc auto_reset {} {
	global auto_execs auto_index auto_oldpath

	foreach p [info procs] {
		if {[info exists auto_index($p)] && ($p != "unknown")
			&& ![string match auto_* $p]} {
				rename $p {}
		}
	}
	catch {unset auto_execs}
	catch {unset auto_index}
	catch {unset auto_oldpath}
}


#####################################################################
# auto_mkindex:
# Regenerate a tclIndex file from Tcl source files.  Takes as argument
# the name of the directory in which the tclIndex file is to be placed,
# folowed by any number of glob patterns to use in that directory to
# locate all of the relevant files.
 
proc auto_mkindex {{dir $PVDIR/lib} args} {
	global PVDIR

	set libdir [eval concat $dir]
	set oldDir [utlPWD]
	cd $libdir
	if {[llength $args] == 0} {
		set files [utlLS *.tcl *.TCL]
	} else {
		set files [utlLS $args]
	}
	set procs() ""

	# List of files to skip
	set slist {pvprocs.tcl custom.tcl pvsherpa.tcl}

	# open new tclIndex file
	set saveIndex [utlUniqueFile $libdir/tclIndex ""]
	if {[utlMoveFile tclIndex $saveIndex] != ""} {
		puts "  Couldn't move tclIndex to $saveIndex"
		return ""
	}

	puts "Moved tclIndex to $saveIndex"

	# open new tclIndex file
	if {[catch {set outfd [utlOpen tclIndex w]}]} {
		puts "  Couldn't open tclIndex for writing"
		return ""
	}


	# put in header
	puts $outfd "# Tcl autoload index file, created [utlDateTime -datestring]"
	puts $outfd "# This file is generated by the \"auto_mkindex\" command"
	puts $outfd "# and sourced to set up indexing information for one or"
	puts $outfd "# more commands.  Typically each line is a command that"
	puts $outfd "# sets an element in the auto_index array, where the"
	puts $outfd "# element name is the name of a command and the value is"
	puts $outfd "# a script that loads the command.\n"

	# scan files for procedure definitions
	foreach f $files {
		if {[lsearch -exact $slist [file tail $f]] >= 0} {
			continue
		}
		# open TCL file
		if {[catch {set infd [utlOpen $f r]}]} {
			puts "  Couldn't open file $f"
			continue
		}

		# scan for procedure definitions, avoid duplicates
		fileproc $infd line proc* {
			if [regexp {^proc[	 ]+([^	 ]+).*} $line _ procName] {
				if {[info exists procs($procName)]} {
					puts "  Procedure $procName redefined (see $procs($procName) and $f)"
				}
				set procs($procName) $f
				puts $outfd "set auto_index($procName) \"source \\\"\$dir/[file tail $f]\\\"\""
			}
		}
		utlClose $infd
	}
	utlClose $outfd
	cd $oldDir
	return ""
}