diff options
| -rw-r--r-- | generic/tclCmdMZ.c | 30 | ||||
| -rw-r--r-- | library/init.tcl | 21 | ||||
| -rw-r--r-- | library/package.tcl | 6 | ||||
| -rw-r--r-- | library/tclIndex | 132 |
4 files changed, 116 insertions, 73 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 23e6bd1..ba1fc41 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -989,8 +989,11 @@ TclNRSourceObjCmd( { const char *encodingName = NULL; Tcl_Obj *fileName; + int result; + void **pkgFiles = NULL; + void *names = NULL; - if (objc != 2 && objc !=4) { + if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName"); return TCL_ERROR; } @@ -1008,9 +1011,30 @@ TclNRSourceObjCmd( return TCL_ERROR; } encodingName = TclGetString(objv[2]); - } + } else if (objc == 3) { + /* Handle undocumented -nopkg option. This should only be + * used by the internal ::tcl::Pkg::source utility function. */ + static const char *const nopkgoptions[] = { + "-nopkg", NULL + }; + int index; - return TclNREvalFile(interp, fileName, encodingName); + if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions, + "option", TCL_EXACT, &index)) { + return TCL_ERROR; + } + pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + /* Make sure that during the following TclNREvalFile no filenames + * are recorded for inclusion in the "package files" command */ + names = *pkgFiles; + *pkgFiles = NULL; + } + result = TclNREvalFile(interp, fileName, encodingName); + if (pkgFiles) { + /* restore "tclPkgFiles" assocdata to how it was. */ + *pkgFiles = names; + } + return result; } /* diff --git a/library/init.tcl b/library/init.tcl index 5a9e87c..49a523c 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -45,6 +45,7 @@ if {![info exists auto_path]} { set auto_path "" } } + namespace eval tcl { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { @@ -112,6 +113,8 @@ namespace eval tcl { } } +namespace eval tcl::Pkg {} + # Windows specific end of initialization if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { @@ -457,6 +460,22 @@ proc auto_load {cmd {namespace {}}} { return 0 } +# ::tcl::Pkg::source -- +# This procedure provides an alternative "source" command, which doesn't +# register the file for the "package files" command. Safe interpreters +# don't have to do anything special. +# +# Arguments: +# filename + +proc ::tcl::Pkg::source {filename} { + if {[interp issafe]} { + uplevel 1 [list ::source $filename] + } else { + uplevel 1 [list ::source -nopkg $filename] + } +} + # 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 @@ -499,7 +518,7 @@ proc auto_load_index {} { } set name [lindex $line 0] set auto_index($name) \ - "source [file join $dir [lindex $line 1]]" + "::tcl::Pkg::source [file join $dir [lindex $line 1]]" } } else { error "[file join $dir tclIndex] isn't a proper Tcl index file" diff --git a/library/package.tcl b/library/package.tcl index 44e3b28..c72fbfb 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -488,7 +488,7 @@ proc tclPkgUnknown {name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue @@ -506,7 +506,7 @@ proc tclPkgUnknown {name args} { # safe interps usually don't have "file exists", if {([interp issafe] || [file exists $file])} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue @@ -590,7 +590,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue diff --git a/library/tclIndex b/library/tclIndex index 26603c1..87a2814 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -7,69 +7,69 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(auto_reset) [list source [file join $dir auto.tcl]] -set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]] -set auto_index(history) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] -set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] -set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] -set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::pkg::create) [list source [file join $dir package.tcl]] -set auto_index(parray) [list source [file join $dir parray.tcl]] -set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]] -set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]] -set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]] -set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Log) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] -set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] -set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] -set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] -set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] -set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] +set auto_index(auto_reset) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(tcl_findLibrary) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex_old) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::slavehook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]] +set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpSetConfig) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpFindInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpAddToAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AddSubDirs) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpDelete) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::setLogCmd) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::SyncAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::PathToken) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::TranslatePath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Log) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckFileName) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasGlob) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSource) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasLoad) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::FileInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Subset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSubset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]] |