Removed changed from version 1.9

1 files changed, 52 insertions, 319 deletions

diff --git a/library/init.tcl b/library/init.tcl
index 6c1aff9..7da05a5 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.
 #
-# SCCS: %Z% $Id: init.tcl,v 1.9 1998/07/24 13:50:06 surles Exp $ 
+# SCCS: @(#) init.tcl 1.8 98/07/20 16:24:45
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -97,6 +97,11 @@ if {[info commands tclLog] == ""} {
     }
 }
 
+# The procs defined in this file that have a leading space
+# are 'hidden' from auto_mkindex because they are not
+# auto-loadable.
+
+
 # unknown --
 # This procedure is called when a Tcl command is invoked that doesn't
 # exist in the interpreter.  It takes the following steps to make the
@@ -119,7 +124,7 @@ if {[info commands tclLog] == ""} {
 # args -	A list whose elements are the words of the original
 #		command, including the command name.
 
-proc unknown args {
+ proc unknown args {
     global auto_noexec auto_noload env unknown_pending tcl_interactive
     global errorCode errorInfo
 
@@ -246,9 +251,9 @@ proc unknown args {
 #                       a canonical namespace as returned [namespace current]
 #                       for instance. If not given, namespace current is used.
 
-proc auto_load {cmd {namespace {}}} {
-    global auto_index auto_oldpath auto_path
-    
+ proc auto_load {cmd {namespace {}}} {
+    global auto_index auto_oldpath auto_path env errorInfo errorCode
+
     if {[string length $namespace] == 0} {
 	set namespace [uplevel {namespace current}]
     }
@@ -265,34 +270,6 @@ proc auto_load {cmd {namespace {}}} {
     if {![info exists auto_path]} {
 	return 0
     }
-    
-    if {![auto_load_index]} {
- 	return 0
-    }
-    
-    foreach name $nameList {
- 	if {[info exists auto_index($name)]} {
- 	    uplevel #0 $auto_index($name)
- 	    if {[info commands $name] != ""} {
- 		return 1
- 	    }
- 	}
-    }
-    return 0
-}
-
-# 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]} {
 	if {$auto_oldpath == $auto_path} {
 	    return 0
@@ -340,7 +317,15 @@ proc auto_load_index {} {
 	    }
 	}
     }
-    return 1
+    foreach name $nameList {
+	if {[info exists auto_index($name)]} {
+	    uplevel #0 $auto_index($name)
+	    if {[info commands $name] != ""} {
+		return 1
+	    }
+	}
+    }
+    return 0
 }
 
 # auto_qualify --
@@ -357,8 +342,8 @@ proc auto_load_index {} {
 #               a canonical namespace as returned by [namespace current]
 #               for instance.
 
-proc auto_qualify {cmd namespace} {
-    
+ proc auto_qualify {cmd namespace} {
+
     # count separators and clean them up
     # (making sure that foo:::::bar will be treated as foo::bar)
     set n [regsub -all {::+} $cmd :: cmd]
@@ -402,33 +387,6 @@ proc auto_qualify {cmd namespace} {
     }
 }
 
-# auto_import --
-# 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.
-#
-# Arguments -
-# pattern	The pattern of commands being imported (like "foo::*")
-#               a canonical namespace as returned by [namespace current]
-
-proc auto_import {pattern} {
-    global auto_index
-    
-    set ns [uplevel namespace current]
-    set patternList [auto_qualify $pattern $ns]
-    
-    auto_load_index
-    
-    foreach pattern $patternList {
-	foreach name [array names auto_index] {
-	    if {[string match $pattern $name] && "" == [info commands $name]} {
-		uplevel #0 $auto_index($name)
-	    }
-	}
-    }
-}
-
 if {[string compare $tcl_platform(platform) windows] == 0} {
 
 # auto_execok --
@@ -565,31 +523,13 @@ proc auto_reset {} {
     catch {unset auto_oldpath}
 }
 
-# ----------------------------------------------------------------------
-# 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]} {
-    proc auto_mkindex {dir args} {
-	error "can't generate index within safe interpreter"
-    }
-    proc tcl_nonsafe {args} {}
-} else {
-    proc tcl_nonsafe {args} {eval $args}
-}
-
 # 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.
+# locate all of the relevant files. It does not parse or source the file
+# so the generated index will not contain the appropriate namespace qualifiers
+# if you don't explicitly specify it.
 #
 # Arguments: 
 # dir -			Name of the directory in which to create an index.
@@ -597,17 +537,11 @@ if {[interp issafe]} {
 #			names of files within dir.  If no additional
 #			are given auto_mkindex will look for *.tcl.
 
-tcl_nonsafe proc auto_mkindex {dir args} {
+proc auto_mkindex {dir args} {
     global errorCode errorInfo
-    
-    if {[interp issafe]} {
-	error "can't generate index within safe interpreter"
-    }
-    
     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"
@@ -619,243 +553,42 @@ tcl_nonsafe proc auto_mkindex {dir args} {
 	set args *.tcl
     }
     foreach file [eval glob $args] {
-	if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
-	    append index $msg
-	} else {
+	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 fid [open "tclIndex" w]
-    puts $fid $index nonewline
-    close $fid
-    cd $oldDir
-}
-
-#
-# 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.
-#
-tcl_nonsafe 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
-    
-    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
-    }
-}
-
-# 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.
-#
-tcl_nonsafe 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::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.
-#
-tcl_nonsafe proc auto_mkindex_parser::command {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]
-	$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.
-#
-tcl_nonsafe proc auto_mkindex_parser::fullname {name} {
-    variable contextStack
-    
-    if {![string match ::* $name]} {
-	foreach ns $contextStack {
-	    set name "${ns}::$name"
-	    if {[string match ::* $name]} {
-		break
-	    }
-	}
+    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
     }
-    
-    if {[namespace qualifiers $name] == ""} {
-	return [namespace tail $name]
-    } elseif {![string match ::* $name]} {
-	return "::$name"
-    }
-    return $name
 }
 
-#
-# Now define 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.
-#
-tcl_nonsafe auto_mkindex_parser::command proc {name args} {
-    variable index
-    variable scriptFile
-    append index "set [list auto_index([fullname $name])]"
-    append index " \[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.
-#
-tcl_nonsafe 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]
-	    if {[llength $args] == 1} {
-		$parser eval [lindex $args 0]
-	    } else {
-		eval $parser eval $args
-	    }
-	    set contextStack [lrange $contextStack 1 end]
-	}
-	import {
-	    variable parser
-	    variable imports
-	    foreach pattern $args {
-		if {$pattern != "-force"} {
-		    lappend imports $pattern
-		}
-	    }
-	    catch {$parser eval "_%@namespace import $args"}
-	}
-    }
-}
-
-rename tcl_nonsafe ""
-
 # pkg_mkIndex --
 # This procedure creates a package index in a given directory.  The
 # package index consists of a "pkgIndex.tcl" file whose contents are