Compare commits

...
Author SHA1 Message Date
stanton e1245c0d82 merged auto_mkindex fix into the 8.0.5 release branch 1999-02-11 03:06:23 +00:00
+39 -11
View File
@@ -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}
}
}
}