summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--library/init.tcl50
1 files changed, 39 insertions, 11 deletions
diff --git a/library/init.tcl b/library/init.tcl
index 99afd97..500993f 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.26 1999/02/11 03:04:46 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}
}
}
}