# # 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 }