AnonymousFox

//proc/self/root/lib64/tcl8.5/tclx8.4/autoload.tcl

#
# Modified version of the standard Tcl auto_load_index proc that calls a TclX
# command load TclX .tndx library indices. 
#
# $Id: autoload.tcl,v 1.2 2002/04/02 03:00:14 hobbs Exp $
# from Tcl: init.tcl,v 1.1.2.4 1998/12/02 20:08:05 welch Exp
#

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# auto_load_index --
# Loads the contents of tclIndex files on the auto_path directory
# list.  This is usually invoked within auto_load to load the index
# of available commands.  Returns 1 if the index is loaded, and 0 if
# the index is already loaded and up to date.
#
# Arguments: 
# None.

proc auto_load_index {} {
    global auto_index auto_oldpath auto_path errorInfo errorCode

if {[info exists auto_oldpath] && ($auto_oldpath == $auto_path)} {
	return 0
    }
    set auto_oldpath $auto_path

# Check if we are a safe interpreter. In that case, we support only
    # newer format tclIndex files.

set issafe [interp issafe]
    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
	set dir [lindex $auto_path $i]
        tclx_load_tndxs $dir
	set f ""
	if {$issafe} {
	    catch {source [file join $dir tclIndex]}
	} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
	    continue
	} else {
	    set error [catch {
		set id [gets $f]
		if {$id == "# Tcl autoload index file, version 2.0"} {
		    eval [read $f]
		} elseif {$id == \
		    "# Tcl autoload index file: each line identifies a Tcl"} {
		    while {[gets $f line] >= 0} {
			if {([string index $line 0] == "#")
				|| ([llength $line] != 2)} {
			    continue
			}
			set name [lindex $line 0]
			set auto_index($name) \
			    "source [file join $dir [lindex $line 1]]"
		    }
		} else {
		    error \
		      "[file join $dir tclIndex] isn't a proper Tcl index file"
		}
	    } msg]
	    if {[string compare $f ""]} {
		close $f
	    }
	    if {$error} {
		error $msg $errorInfo $errorCode
	    }
	}
    }
    return 1
}