merged tcl 8.1 branch back into the main trunk

1 files changed, 7 insertions, 1008 deletions

diff --git a/library/init.tcl b/library/init.tcl
index c592e01..acd403d 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.28 1999/03/31 22:37:03 welch Exp $
+# RCS: @(#) $Id: init.tcl,v 1.29 1999/04/16 00:46:56 stanton Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -16,7 +16,7 @@
 if {[info commands package] == ""} {
     error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
 }
-package require -exact Tcl 8.0
+package require -exact Tcl 8.1
 
 # Compute the auto path to use in this interpreter.
 # The values on the path come from several locations:
@@ -59,8 +59,8 @@ if {[info exist tcl_pkgPath]} {
 if {[info exists __dir]} {
     unset __dir
 }
-
-# Windows specific initialization to handle case isses with envars
+  
+# Windows specific end of initialization
 
 if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
     namespace eval tcl {
@@ -373,7 +373,7 @@ proc auto_load_index {} {
 
 # auto_qualify --
 #
-# compute a fully qualified names list for use in the auto_index array.
+# Compute a fully qualified names list for use in the auto_index array.
 # For historical reasons, commands in the global namespace do not have leading
 # :: in the index key. The list has two elements when the command name is
 # relative (no leading ::) and the namespace is not the global one. Otherwise
@@ -433,7 +433,7 @@ proc auto_qualify {cmd namespace} {
 
 # auto_import --
 #
-# invoked during "namespace import" to make see if the imported commands
+# Invoked during "namespace import" to make see if the imported commands
 # reside in an autoloaded library.  If so, the commands are loaded so
 # that they will be available for the import links.  If not, then this
 # procedure does nothing.
@@ -459,8 +459,6 @@ proc auto_import {pattern} {
     }
 }
 
-if {[string compare $tcl_platform(platform) windows] == 0} {
-
 # auto_execok --
 #
 # Returns string that indicates name of program to execute if 
@@ -472,6 +470,7 @@ if {[string compare $tcl_platform(platform) windows] == 0} {
 # Arguments: 
 # name -			Name of a command.
 
+if {[string compare $tcl_platform(platform) windows] == 0} {
 # Windows version.
 #
 # Note that info executable doesn't work under Windows, so we have to
@@ -532,17 +531,6 @@ proc auto_execok name {
 }
 
 } else {
-
-# auto_execok --
-#
-# Returns string that indicates name of program to execute if 
-# name corresponds to an executable in the path. Builds an associative 
-# array auto_execs that caches information about previous checks, 
-# for speed.
-#
-# Arguments: 
-# name -			Name of a command.
-
 # Unix version.
 #
 proc auto_execok name {
@@ -572,992 +560,3 @@ proc auto_execok name {
 }
 
 }
-# OPTIONAL SUPPORT PROCEDURES
-# In Tcl 8.1 all the code below here has been moved to other files to
-# reduce the size of init.tcl
-
-# 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 defined in this file.
-#
-# Arguments: 
-# None.
-
-proc auto_reset {} {
-    global auto_execs auto_index auto_oldpath
-    foreach p [info procs] {
-	if {[info exists auto_index($p)] && ![string match auto_* $p]
-		&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
-			tcl_findLibrary pkg_compareExtension
-			tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
-	    rename $p {}
-	}
-    }
-    catch {unset auto_execs}
-    catch {unset auto_index}
-    catch {unset auto_oldpath}
-}
-
-# tcl_findLibrary --
-#
-#	This is a utility for extensions that searches for a library directory
-#	using a canonical searching algorithm. A side effect is to source
-#	the initialization script and set a global library variable.
-#
-# Arguments:
-# 	basename	Prefix of the directory name, (e.g., "tk")
-#	version		Version number of the package, (e.g., "8.0")
-#	patch		Patchlevel of the package, (e.g., "8.0.3")
-#	initScript	Initialization script to source (e.g., tk.tcl)
-#	enVarName	environment variable to honor (e.g., TK_LIBRARY)
-#	varName		Global variable to set when done (e.g., tk_library)
-
-proc tcl_findLibrary {basename version patch initScript enVarName varName} {
-    upvar #0 $varName the_library
-    global env errorInfo
-
-    set dirs {}
-    set errors {}
-
-    # The C application may have hardwired a path, which we honor
-    
-    if {[info exist the_library] && [string compare $the_library {}]} {
-	lappend dirs $the_library
-    } else {
-
-	# Do the canonical search
-
-	# 1. From an environment variable, if it exists
-
-        if {[info exists env($enVarName)]} {
-            lappend dirs $env($enVarName)
-        }
-
-	# 2. Relative to the Tcl library
-
-        lappend dirs [file join [file dirname [info library]] \
-		$basename$version]
-
-	# 3. Various locations relative to the executable
-	# ../lib/foo1.0		(From bin directory in install hierarchy)
-	# ../../lib/foo1.0	(From bin/arch directory in install hierarchy)
-	# ../library		(From unix directory in build hierarchy)
-	# ../../library		(From unix/arch directory in build hierarchy)
-	# ../../foo1.0b1/library (From unix directory in parallel build hierarchy)
-	# ../../../foo1.0b1/library (From unix/arch directory in parallel build hierarchy)
-
-        set parentDir [file dirname [file dirname [info nameofexecutable]]]
-        set grandParentDir [file dirname $parentDir]
-        lappend dirs [file join $parentDir lib $basename$version]
-        lappend dirs [file join $grandParentDir lib $basename$version]
-        lappend dirs [file join $parentDir library]
-        lappend dirs [file join $grandParentDir library]
-        if {![regexp {.*[ab][0-9]*} $patch ver]} {
-            set ver $version
-        }
-        lappend dirs [file join $grandParentDir $basename$ver library]
-        lappend dirs [file join [file dirname $grandParentDir] $basename$ver library]
-    }
-    foreach i $dirs {
-        set the_library $i
-        set file [file join $i $initScript]
-
-	# source everything when in a safe interpreter because
-	# we have a source command, but no file exists command
-
-        if {[interp issafe] || [file exists $file]} {
-            if {![catch {uplevel #0 [list source $file]} msg]} {
-                return
-            } else {
-                append errors "$file: $msg\n$errorInfo\n"
-            }
-        }
-    }
-    set msg "Can't find a usable $initScript in the following directories: \n"
-    append msg "    $dirs\n\n"
-    append msg "$errors\n\n"
-    append msg "This probably means that $basename wasn't installed properly.\n"
-    error $msg
-}
-
-
-# ----------------------------------------------------------------------
-# auto_mkindex
-# ----------------------------------------------------------------------
-# The following procedures are used to generate the tclIndex file
-# from Tcl source files.  They use a special safe interpreter to
-# parse Tcl source files, writing out index entries as "proc"
-# commands are encountered.  This implementation won't work in a
-# safe interpreter, since a safe interpreter can't create the
-# special parser and mess with its commands.  If this is a safe
-# interpreter, we simply clip these procs out.
-
-if {! [interp issafe]} {
-
-    # 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,
-    # followed by any number of glob patterns to use in that directory to
-    # locate all of the relevant files.
-    #
-    # Arguments: 
-    # dir -		Name of the directory in which to create an index.
-    # args -	Any number of additional arguments giving the
-    #		names of files within dir.  If no additional
-    #		are given auto_mkindex will look for *.tcl.
-
-    proc auto_mkindex {dir args} {
-	global errorCode errorInfo
-
-	set oldDir [pwd]
-	cd $dir
-	set dir [pwd]
-
-	append index "# Tcl autoload index file, version 2.0\n"
-	append index "# This file is generated by the \"auto_mkindex\" command\n"
-	append index "# and sourced to set up indexing information for one or\n"
-	append index "# more commands.  Typically each line is a command that\n"
-	append index "# sets an element in the auto_index array, where the\n"
-	append index "# element name is the name of a command and the value is\n"
-	append index "# a script that loads the command.\n\n"
-	if {$args == ""} {
-	    set args *.tcl
-	}
-
-	auto_mkindex_parser::init
-	foreach file [eval glob $args] {
-	    if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
-		append index $msg
-	    } else {
-		set code $errorCode
-		set info $errorInfo
-		cd $oldDir
-		error $msg $info $code
-	    }
-	}
-	auto_mkindex_parser::cleanup
-
-	set fid [open "tclIndex" w]
-	puts $fid $index nonewline
-	close $fid
-	cd $oldDir
-    }
-
-    # Original version of auto_mkindex that just searches the source
-    # code for "proc" at the beginning of the line.
-
-    proc auto_mkindex_old {dir args} {
-	global errorCode errorInfo
-	set oldDir [pwd]
-	cd $dir
-	set dir [pwd]
-	append index "# Tcl autoload index file, version 2.0\n"
-	append index "# This file is generated by the \"auto_mkindex\" command\n"
-	append index "# and sourced to set up indexing information for one or\n"
-	append index "# more commands.  Typically each line is a command that\n"
-	append index "# sets an element in the auto_index array, where the\n"
-	append index "# element name is the name of a command and the value is\n"
-	append index "# a script that loads the command.\n\n"
-	if {$args == ""} {
-	    set args *.tcl
-	}
-	foreach file [eval glob $args] {
-	    set f ""
-	    set error [catch {
-		set f [open $file]
-		while {[gets $f line] >= 0} {
-		    if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
-			set procName [lindex [auto_qualify $procName "::"] 0]
-			append index "set [list auto_index($procName)]"
-			append index " \[list source \[file join \$dir [list $file]\]\]\n"
-		    }
-		}
-		close $f
-	    } msg]
-	    if {$error} {
-		set code $errorCode
-		set info $errorInfo
-		catch {close $f}
-		cd $oldDir
-		error $msg $info $code
-	    }
-	}
-	set f ""
-	set error [catch {
-	    set f [open tclIndex w]
-	    puts $f $index nonewline
-	    close $f
-	    cd $oldDir
-	} msg]
-	if {$error} {
-	    set code $errorCode
-	    set info $errorInfo
-	    catch {close $f}
-	    cd $oldDir
-	    error $msg $info $code
-	}
-    }
-
-    # Create a safe interpreter that can be used to parse Tcl source files
-    # generate a tclIndex file for autoloading.  This interp contains
-    # commands for things that need index entries.  Each time a command
-    # is executed, it writes an entry out to the index file.
-
-    namespace eval auto_mkindex_parser {
-	variable parser ""          ;# parser used to build index
-	variable index ""           ;# maintains index as it is built
-	variable scriptFile ""      ;# name of file being processed
-	variable contextStack ""    ;# stack of namespace scopes
-	variable imports ""         ;# keeps track of all imported cmds
-	variable initCommands ""    ;# list of commands that create aliases
-
-	proc init {} {
-	    variable parser
-	    variable initCommands
-	    
-	    if {![interp issafe]} {
-		set parser [interp create -safe]
-		$parser hide info
-		$parser hide rename
-		$parser hide proc
-		$parser hide namespace
-		$parser hide eval
-		$parser hide puts
-		$parser invokehidden namespace delete ::
-		$parser invokehidden proc unknown {args} {}
-
-		# We'll need access to the "namespace" command within the
-		# interp.  Put it back, but move it out of the way.
-
-		$parser expose namespace
-		$parser invokehidden rename namespace _%@namespace
-		$parser expose eval
-		$parser invokehidden rename eval _%@eval
-
-		# Install all the registered psuedo-command implementations
-
-		foreach cmd $initCommands {
-		    eval $cmd
-		}
-	    }
-	}
-	proc cleanup {} {
-	    variable parser
-	    interp delete $parser
-	    unset parser
-	}
-    }
-
-    # auto_mkindex_parser::mkindex --
-    #
-    # Used by the "auto_mkindex" command to create a "tclIndex" file for
-    # the given Tcl source file.  Executes the commands in the file, and
-    # handles things like the "proc" command by adding an entry for the
-    # index file.  Returns a string that represents the index file.
-    #
-    # Arguments: 
-    #	file	Name of Tcl source file to be indexed.
-
-    proc auto_mkindex_parser::mkindex {file} {
-	variable parser
-	variable index
-	variable scriptFile
-	variable contextStack
-	variable imports
-
-	set scriptFile $file
-
-	set fid [open $file]
-	set contents [read $fid]
-	close $fid
-
-	# There is one problem with sourcing files into the safe
-	# interpreter:  references like "$x" will fail since code is not
-	# really being executed and variables do not really exist.
-	# Be careful to escape all naked "$" before evaluating.
-
-	regsub -all {([^\$])\$([^\$])} $contents {\1\\$\2} contents
-
-	set index ""
-	set contextStack ""
-	set imports ""
-
-	$parser eval $contents
-
-	foreach name $imports {
-	    catch {$parser eval [list _%@namespace forget $name]}
-	}
-	return $index
-    }
-
-    # auto_mkindex_parser::hook command
-    #
-    # Registers a Tcl command to evaluate when initializing the
-    # slave interpreter used by the mkindex parser.
-    # The command is evaluated in the master interpreter, and can
-    # use the variable auto_mkindex_parser::parser to get to the slave
-
-    proc auto_mkindex_parser::hook {cmd} {
-	variable initCommands
-
-	lappend initCommands $cmd
-    }
-
-    # auto_mkindex_parser::slavehook command
-    #
-    # Registers a Tcl command to evaluate when initializing the
-    # slave interpreter used by the mkindex parser.
-    # The command is evaluated in the slave interpreter.
-
-    proc auto_mkindex_parser::slavehook {cmd} {
-	variable initCommands
-
-	# The $parser variable is defined to be the name of the
-	# slave interpreter when this command is used later.
-
-	lappend initCommands "\$parser eval [list $cmd]"
-    }
-
-    # auto_mkindex_parser::command --
-    #
-    # Registers a new command with the "auto_mkindex_parser" interpreter
-    # that parses Tcl files.  These commands are fake versions of things
-    # like the "proc" command.  When you execute them, they simply write
-    # out an entry to a "tclIndex" file for auto-loading.
-    #
-    # This procedure allows extensions to register their own commands
-    # with the auto_mkindex facility.  For example, a package like
-    # [incr Tcl] might register a "class" command so that class definitions
-    # could be added to a "tclIndex" file for auto-loading.
-    #
-    # Arguments:
-    #	name 	Name of command recognized in Tcl files.
-    #	arglist	Argument list for command.
-    #	body 	Implementation of command to handle indexing.
-
-    proc auto_mkindex_parser::command {name arglist body} {
-	hook [list auto_mkindex_parser::commandInit $name $arglist $body]
-    }
-
-    # auto_mkindex_parser::commandInit --
-    #
-    # This does the actual work set up by auto_mkindex_parser::command
-    # This is called when the interpreter used by the parser is created.
-    #
-    # Arguments:
-    #	name 	Name of command recognized in Tcl files.
-    #	arglist	Argument list for command.
-    #	body 	Implementation of command to handle indexing.
-
-    proc auto_mkindex_parser::commandInit {name arglist body} {
-	variable parser
-
-	set ns [namespace qualifiers $name]
-	set tail [namespace tail $name]
-	if {$ns == ""} {
-	    set fakeName "[namespace current]::_%@fake_$tail"
-	} else {
-	    set fakeName "_%@fake_$name"
-	    regsub -all {::} $fakeName "_" fakeName
-	    set fakeName "[namespace current]::$fakeName"
-	}
-	proc $fakeName $arglist $body
-
-	# YUK!  Tcl won't let us alias fully qualified command names,
-	# so we can't handle names like "::itcl::class".  Instead,
-	# we have to build procs with the fully qualified names, and
-	# have the procs point to the aliases.
-
-	if {[regexp {::} $name]} {
-	    set exportCmd [list _%@namespace export [namespace tail $name]]
-	    $parser eval [list _%@namespace eval $ns $exportCmd]
-	    set alias [namespace tail $fakeName]
-
-	    # The following proc definition does not work if you
-	    # want to tolerate space or something else diabolical
-	    # in the procedure name, (i.e., space in $alias)
-	    # The following does not work:
-	    # 	"_%@eval {$alias} \$args"
-	    # because $alias gets concat'ed to $args.
-	    # The following does not work because $cmd is somehow undefined
-	    #	"set cmd {$alias} \; _%@eval {\$cmd} \$args"
-	    # A gold star to someone that can make test
-	    # autoMkindex-3.3 work properly
-
-	    $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
-	    $parser alias $alias $fakeName
-	} else {
-	    $parser alias $name $fakeName
-	}
-	return
-    }
-
-    # auto_mkindex_parser::fullname --
-    # Used by commands like "proc" within the auto_mkindex parser.
-    # Returns the qualified namespace name for the "name" argument.
-    # If the "name" does not start with "::", elements are added from
-    # the current namespace stack to produce a qualified name.  Then,
-    # the name is examined to see whether or not it should really be
-    # qualified.  If the name has more than the leading "::", it is
-    # returned as a fully qualified name.  Otherwise, it is returned
-    # as a simple name.  That way, the Tcl autoloader will recognize
-    # it properly.
-    #
-    # Arguments:
-    # name -		Name that is being added to index.
-
-    proc auto_mkindex_parser::fullname {name} {
-	variable contextStack
-
-	if {![string match ::* $name]} {
-	    foreach ns $contextStack {
-		set name "${ns}::$name"
-		if {[string match ::* $name]} {
-		    break
-		}
-	    }
-	}
-
-	if {[namespace qualifiers $name] == ""} {
-	    return [namespace tail $name]
-	} elseif {![string match ::* $name]} {
-	    return "::$name"
-	}
-	return $name
-    }
-
-    # Register all of the procedures for the auto_mkindex parser that
-    # will build the "tclIndex" file.
-
-    # AUTO MKINDEX:  proc name arglist body
-    # Adds an entry to the auto index list for the given procedure name.
-
-    auto_mkindex_parser::command proc {name args} {
-	variable index
-	variable scriptFile
-	append index [list set auto_index([fullname $name])] \
-		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
-    }
-
-    # Conditionally add support for Tcl byte code files.  There are some
-    # tricky details here.  First, we need to get the tbcload library
-    # initialized in the current interpreter.  We cannot load tbcload into the
-    # slave until we have done so because it needs access to the tcl_patchLevel
-    # variable.  Second, because the package index file may defer loading the
-    # library until we invoke a command, we need to explicitly invoke auto_load
-    # to force it to be loaded.  This should be a noop if the package has
-    # already been loaded
-
-    auto_mkindex_parser::hook {
-	if {![catch {package require tbcload}]} {
-	    if {[info commands tbcload::bcproc] == ""} {
-		auto_load tbcload::bcproc
-	    }
-	    load {} tbcload $auto_mkindex_parser::parser
-
-	    # AUTO MKINDEX:  tbcload::bcproc name arglist body
-	    # Adds an entry to the auto index list for the given pre-compiled
-	    # procedure name.  
-
-	    auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
-		variable index
-		variable scriptFile
-		append index [list set auto_index([fullname $name])] \
-			" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
-	    }
-	}
-    }
-
-    # AUTO MKINDEX:  namespace eval name command ?arg arg...?
-    # Adds the namespace name onto the context stack and evaluates the
-    # associated body of commands.
-    #
-    # AUTO MKINDEX:  namespace import ?-force? pattern ?pattern...?
-    # Performs the "import" action in the parser interpreter.  This is
-    # important for any commands contained in a namespace that affect
-    # the index.  For example, a script may say "itcl::class ...",
-    # or it may import "itcl::*" and then say "class ...".  This
-    # procedure does the import operation, but keeps track of imported
-    # patterns so we can remove the imports later.
-
-    auto_mkindex_parser::command namespace {op args} {
-	switch -- $op {
-	    eval {
-		variable parser
-		variable contextStack
-
-		set name [lindex $args 0]
-		set args [lrange $args 1 end]
-
-		set contextStack [linsert $contextStack 0 $name]
-		$parser eval [list _%@namespace eval $name] $args
-		set contextStack [lrange $contextStack 1 end]
-	    }
-	    import {
-		variable parser
-		variable imports
-		foreach pattern $args {
-		    if {$pattern != "-force"} {
-			lappend imports $pattern
-		    }
-		}
-		catch {$parser eval [list _%@namespace import] $args}
-	    }
-	}
-    }
-
-# Close of the if ![interp issafe] block
-}
-
-# pkg_compareExtension --
-#
-#  Used internally by pkg_mkIndex to compare the extension of a file to
-#  a given extension. On Windows, it uses a case-insensitive comparison.
-#
-# Arguments:
-#  fileName	name of a file whose extension is compared
-#  ext		(optional) The extension to compare against; you must
-#		provide the starting dot.
-#		Defaults to [info sharedlibextension]
-#
-# Results:
-#  Returns 1 if the extension matches, 0 otherwise
-
-proc pkg_compareExtension { fileName {ext {}} } {
-    global tcl_platform
-    if {[string length $ext] == 0} {
-	set ext [info sharedlibextension]
-    }
-    if {[string compare $tcl_platform(platform) "windows"] == 0} {
-	return [expr {[string compare \
-		[string tolower [file extension $fileName]] \
-		[string tolower $ext]] == 0}]
-    } else {
-	return [expr {[string compare [file extension $fileName] $ext] == 0}]
-    }
-}
-
-# pkg_mkIndex --
-# This procedure creates a package index in a given directory.  The
-# package index consists of a "pkgIndex.tcl" file whose contents are
-# a Tcl script that sets up package information with "package require"
-# commands.  The commands describe all of the packages defined by the
-# files given as arguments.
-#
-# Arguments:
-# -direct		(optional) If this flag is present, the generated
-#			code in pkgMkIndex.tcl will cause the package to be
-#			loaded when "package require" is executed, rather
-#			than lazily when the first reference to an exported
-#			procedure in the package is made.
-# -verbose		(optional) Verbose output; the name of each file that
-#			was successfully rocessed is printed out. Additionally,
-#			if processing of a file failed a message is printed.
-# -load pat		(optional) Preload any packages whose names match
-#			the pattern.  Used to handle DLLs that depend on
-#			other packages during their Init procedure.
-# dir -			Name of the directory in which to create the index.
-# args -		Any number of additional arguments, each giving
-#			a glob pattern that matches the names of one or
-#			more shared libraries or Tcl script files in
-#			dir.
-
-proc pkg_mkIndex {args} {
-    global errorCode errorInfo
-    set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
-
-    set argCount [llength $args]
-    if {$argCount < 1} {
-	return -code error "wrong # args: should be\n$usage"
-    }
-
-    set more ""
-    set direct 0
-    set doVerbose 0
-    set loadPat ""
-    for {set idx 0} {$idx < $argCount} {incr idx} {
-	set flag [lindex $args $idx]
-	switch -glob -- $flag {
-	    -- {
-		# done with the flags
-		incr idx
-		break
-	    }
-	    -verbose {
-		set doVerbose 1
-	    }
-	    -direct {
-		set direct 1
-		append more " -direct"
-	    }
-	    -load {
-		incr idx
-		set loadPat [lindex $args $idx]
-		append more " -load $loadPat"
-	    }
-	    -* {
-		return -code error "unknown flag $flag: should be\n$usage"
-	    }
-	    default {
-		# done with the flags
-		break
-	    }
-	}
-    }
-
-    set dir [lindex $args $idx]
-    set patternList [lrange $args [expr {$idx + 1}] end]
-    if {[llength $patternList] == 0} {
-	set patternList [list "*.tcl" "*[info sharedlibextension]"]
-    }
-
-    append index "# Tcl package index file, version 1.1\n"
-    append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
-    append index "# and sourced either when an application starts up or\n"
-    append index "# by a \"package unknown\" script.  It invokes the\n"
-    append index "# \"package ifneeded\" command to set up package-related\n"
-    append index "# information so that packages will be loaded automatically\n"
-    append index "# in response to \"package require\" commands.  When this\n"
-    append index "# script is sourced, the variable \$dir must contain the\n"
-    append index "# full path name of this file's directory.\n"
-    set oldDir [pwd]
-    cd $dir
-
-    if {[catch {eval glob $patternList} fileList]} {
-	global errorCode errorInfo
-	cd $oldDir
-	return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
-    }
-    foreach file $fileList {
-	# For each file, figure out what commands and packages it provides.
-	# To do this, create a child interpreter, load the file into the
-	# interpreter, and get a list of the new commands and packages
-	# that are defined.
-
-	if {[string compare $file "pkgIndex.tcl"] == 0} {
-	    continue
-	}
-
-	# Changed back to the original directory before initializing the
-	# slave in case TCL_LIBRARY is a relative path (e.g. in the test
-	# suite). 
-
-	cd $oldDir
-	set c [interp create]
-
-	# Load into the child any packages currently loaded in the parent
-	# interpreter that match the -load pattern.
-
-	foreach pkg [info loaded] {
-	    if {! [string match $loadPat [lindex $pkg 1]]} {
-		continue
-	    }
-	    if {[lindex $pkg 1] == "Tk"} {
-		$c eval {set argv {-geometry +0+0}}
-	    }
-	    if {[catch {
-		load [lindex $pkg 0] [lindex $pkg 1] $c
-	    } err]} {
-		if {$doVerbose} {
-		    tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
-		}
-	    } else {
-		if {$doVerbose} {
-		    tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
-		}
-	    }
-	}
-	cd $dir
-
-	$c eval {
-	    # Stub out the package command so packages can
-	    # require other packages.
-
-	    rename package __package_orig
-	    proc package {what args} {
-		switch -- $what {
-		    require { return ; # ignore transitive requires }
-		    default { eval __package_orig {$what} $args }
-		}
-	    }
-	    proc tclPkgUnknown args {}
-	    package unknown tclPkgUnknown
-
-	    # Stub out the unknown command so package can call
-	    # into each other during their initialilzation.
-
-	    proc unknown {args} {}
-
-	    # Stub out the auto_import mechanism
-
-	    proc auto_import {args} {}
-
-	    # reserve the ::tcl namespace for support procs
-	    # and temporary variables.  This might make it awkward
-	    # to generate a pkgIndex.tcl file for the ::tcl namespace.
-
-	    namespace eval ::tcl {
-		variable file		;# Current file being processed
-		variable direct		;# -direct flag value
-		variable x		;# Loop variable
-		variable debug		;# For debugging
-		variable type		;# "load" or "source", for -direct
-		variable namespaces	;# Existing namespaces (e.g., ::tcl)
-		variable packages	;# Existing packages (e.g., Tcl)
-		variable origCmds	;# Existing commands
-		variable newCmds	;# Newly created commands
-		variable newPkgs {}	;# Newly created packages
-	    }
-	}
-
-	$c eval [list set ::tcl::file $file]
-	$c eval [list set ::tcl::direct $direct]
-	if {[catch {
-	    $c eval {
-		set ::tcl::debug "loading or sourcing"
-
-		# we need to track command defined by each package even in
-		# the -direct case, because they are needed internally by
-		# the "partial pkgIndex.tcl" step above.
-
-		proc ::tcl::GetAllNamespaces {{root ::}} {
-		    set list $root
-		    foreach ns [namespace children $root] {
-			eval lappend list [::tcl::GetAllNamespaces $ns]
-		    }
-		    return $list
-		}
-
-		# initialize the list of existing namespaces, packages, commands
-
-		foreach ::tcl::x [::tcl::GetAllNamespaces] {
-		    set ::tcl::namespaces($::tcl::x) 1
-		}
-		foreach ::tcl::x [package names] {
-		    set ::tcl::packages($::tcl::x) 1
-		}
-		set ::tcl::origCmds [info commands]
-
-		# Try to load the file if it has the shared library
-		# extension, otherwise source it.  It's important not to
-		# try to load files that aren't shared libraries, because
-		# on some systems (like SunOS) the loader will abort the
-		# whole application when it gets an error.
-
-		if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
-		    # The "file join ." command below is necessary.
-		    # Without it, if the file name has no \'s and we're
-		    # on UNIX, the load command will invoke the
-		    # LD_LIBRARY_PATH search mechanism, which could cause
-		    # the wrong file to be used.
-
-		    set ::tcl::debug loading
-		    load [file join . $::tcl::file]
-		    set ::tcl::type load
-		} else {
-		    set ::tcl::debug sourcing
-		    source $::tcl::file
-		    set ::tcl::type source
-		}
-
-		# See what new namespaces appeared, and import commands
-		# from them.  Only exported commands go into the index.
-
-		foreach ::tcl::x [::tcl::GetAllNamespaces] {
-		    if {! [info exists ::tcl::namespaces($::tcl::x)]} {
-			namespace import -force ${::tcl::x}::*
-		    }
-		}
-
-		# Figure out what commands appeared
-
-		foreach ::tcl::x [info commands] {
-		    set ::tcl::newCmds($::tcl::x) 1
-		}
-		foreach ::tcl::x $::tcl::origCmds {
-		    catch {unset ::tcl::newCmds($::tcl::x)}
-		}
-		foreach ::tcl::x [array names ::tcl::newCmds] {
-		    # reverse engineer which namespace a command comes from
-		    
-		    set ::tcl::abs [namespace origin $::tcl::x]
-
-		    # special case so that global names have no leading
-		    # ::, this is required by the unknown command
-
-		    set ::tcl::abs [auto_qualify $::tcl::abs ::]
-
-		    if {[string compare $::tcl::x $::tcl::abs] != 0} {
-			# Name changed during qualification
-
-			set ::tcl::newCmds($::tcl::abs) 1
-			unset ::tcl::newCmds($::tcl::x)
-		    }
-		}
-
-		# Look through the packages that appeared, and if there is
-		# a version provided, then record it
-
-		foreach ::tcl::x [package names] {
-		    if {([string compare [package provide $::tcl::x] ""] != 0) \
-			    && ![info exists ::tcl::packages($::tcl::x)]} {
-			lappend ::tcl::newPkgs \
-			    [list $::tcl::x [package provide $::tcl::x]]
-		    }
-		}
-	    }
-	} msg] == 1} {
-	    set what [$c eval set ::tcl::debug]
-	    if {$doVerbose} {
-		tclLog "warning: error while $what $file: $msg"
-	    }
-	} else {
-	    set type [$c eval set ::tcl::type]
-	    set cmds [lsort [$c eval array names ::tcl::newCmds]]
-	    set pkgs [$c eval set ::tcl::newPkgs]
-	    if {[llength $pkgs] > 1} {
-		tclLog "warning: \"$file\" provides more than one package ($pkgs)"
-	    }
-	    foreach pkg $pkgs {
-		# cmds is empty/not used in the direct case
-		lappend files($pkg) [list $file $type $cmds]
-	    }
-
-	    if {$doVerbose} {
-		tclLog "processed $file"
-	    }
-	}
-	interp delete $c
-    }
-
-    foreach pkg [lsort [array names files]] {
-	append index "\npackage ifneeded $pkg "
-	if {$direct} {
-	    set cmdList {}
-	    foreach elem $files($pkg) {
-		set file [lindex $elem 0]
-		set type [lindex $elem 1]
-		lappend cmdList "\[list $type \[file join \$dir\
-			[list $file]\]\]"
-	    }
-	    append index [join $cmdList "\\n"]
-	} else {
-	    append index "\[list tclPkgSetup \$dir [lrange $pkg 0 0]\
-		    [lrange $pkg 1 1] [list $files($pkg)]\]"
-	}
-    }
-    set f [open pkgIndex.tcl w]
-    puts $f $index
-    close $f
-    cd $oldDir
-}
-
-# tclPkgSetup --
-# This is a utility procedure use by pkgIndex.tcl files.  It is invoked
-# as part of a "package ifneeded" script.  It calls "package provide"
-# to indicate that a package is available, then sets entries in the
-# auto_index array so that the package's files will be auto-loaded when
-# the commands are used.
-#
-# Arguments:
-# dir -			Directory containing all the files for this package.
-# pkg -			Name of the package (no version number).
-# version -		Version number for the package, such as 2.1.3.
-# files -		List of files that constitute the package.  Each
-#			element is a sub-list with three elements.  The first
-#			is the name of a file relative to $dir, the second is
-#			"load" or "source", indicating whether the file is a
-#			loadable binary or a script to source, and the third
-#			is a list of commands defined by this file.
-
-proc tclPkgSetup {dir pkg version files} {
-    global auto_index
-
-    package provide $pkg $version
-    foreach fileInfo $files {
-	set f [lindex $fileInfo 0]
-	set type [lindex $fileInfo 1]
-	foreach cmd [lindex $fileInfo 2] {
-	    if {$type == "load"} {
-		set auto_index($cmd) [list load [file join $dir $f] $pkg]
-	    } else {
-		set auto_index($cmd) [list $type [file join $dir $f]]
-	    } 
-	}
-    }
-}
-
-# tclMacPkgSearch --
-# The procedure is used on the Macintosh to search a given directory for files
-# with a TEXT resource named "pkgIndex".  If it exists it is sourced in to the
-# interpreter to setup the package database.
-
-proc tclMacPkgSearch {dir} {
-    foreach x [glob -nocomplain [file join $dir *.shlb]] {
-	if {[file isfile $x]} {
-	    set res [resource open $x]
-	    foreach y [resource list TEXT $res] {
-		if {$y == "pkgIndex"} {source -rsrc pkgIndex}
-	    }
-	    catch {resource close $res}
-	}
-    }
-}
-
-# tclPkgUnknown --
-# This procedure provides the default for the "package unknown" function.
-# It is invoked when a package that's needed can't be found.  It scans
-# the auto_path directories and their immediate children looking for
-# pkgIndex.tcl files and sources any such files that are found to setup
-# the package database.  (On the Macintosh we also search for pkgIndex
-# TEXT resources in all files.)
-#
-# Arguments:
-# name -		Name of desired package.  Not used.
-# version -		Version of desired package.  Not used.
-# exact -		Either "-exact" or omitted.  Not used.
-
-proc tclPkgUnknown {name version {exact {}}} {
-    global auto_path tcl_platform env
-
-    if {![info exists auto_path]} {
-	return
-    }
-    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
-	# we can't use glob in safe interps, so enclose the following
-	# in a catch statement
-	catch {
-	    foreach file [glob -nocomplain [file join [lindex $auto_path $i] \
-		    * pkgIndex.tcl]] {
-		set dir [file dirname $file]
-		if {[catch {source $file} msg]} {
-		    tclLog "error reading package index file $file: $msg"
-		}
-	    }
-        }
-	set dir [lindex $auto_path $i]
-	set file [file join $dir pkgIndex.tcl]
-	# safe interps usually don't have "file readable", nor stderr channel
-	if {[interp issafe] || [file readable $file]} {
-	    if {[catch {source $file} msg] && ![interp issafe]}  {
-		tclLog "error reading package index file $file: $msg"
-	    }
-	}
-	# On the Macintosh we also look in the resource fork 
-	# of shared libraries
-	# We can't use tclMacPkgSearch in safe interps because it uses glob
-	if {(![interp issafe]) && ($tcl_platform(platform) == "macintosh")} {
-	    set dir [lindex $auto_path $i]
-	    tclMacPkgSearch $dir
-	    foreach x [glob -nocomplain [file join $dir *]] {
-		if {[file isdirectory $x]} {
-		    set dir $x
-		    tclMacPkgSearch $dir
-		}
-	    }
-	}
-    }
-}