merged auto_mkindex fix into the 8.0.5 release branchscriptics_tclpro_1_2_b2

1 files changed, 39 insertions, 11 deletions

diff --git a/library/init.tcl b/library/init.tcl
index 99afd97..89237ca 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.25 1999/02/02 22:28:10 stanton Exp $
+# RCS: @(#) $Id: init.tcl,v 1.25.2.1 1999/02/11 03:06:23 stanton Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -721,6 +721,7 @@ if {! [interp issafe]} {
 	if {$args == ""} {
 	    set args *.tcl
 	}
+
 	auto_mkindex_parser::init
 	foreach file [eval glob $args] {
 	    if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
@@ -807,9 +808,11 @@ if {! [interp issafe]} {
 	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
@@ -905,7 +908,7 @@ if {! [interp issafe]} {
     proc auto_mkindex_parser::slavehook {cmd} {
 	variable initCommands
 
-	lappend initCommands "\$parser eval [list $cmd]"
+	lappend initCommands [list \$parser eval $cmd]
     }
 
     # auto_mkindex_parser::command --
@@ -956,7 +959,7 @@ if {! [interp issafe]} {
 	    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 invokehidden proc $name {args} [list _%@eval $alias \$args]
 	    $parser alias $alias $fakeName
 	} else {
 	    $parser alias $name $fakeName
@@ -1007,8 +1010,37 @@ if {! [interp issafe]} {
     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"
+	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...?
@@ -1033,11 +1065,7 @@ if {! [interp issafe]} {
 		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
-		}
+		$parser eval [list _%@namespace eval $name] $args
 		set contextStack [lrange $contextStack 1 end]
 	    }
 	    import {
@@ -1048,7 +1076,7 @@ if {! [interp issafe]} {
 			lappend imports $pattern
 		    }
 		}
-		catch {$parser eval "_%@namespace import $args"}
+		catch {$parser eval [list _%@namespace import] $args}
 	    }
 	}
     }