diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-02-03 12:27:37 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-02-03 12:27:37 (GMT) |
commit | 89f0948b6924bdb698cb27e93364f06b24fa3976 (patch) | |
tree | 2cdfb937a678c6faaf7a6ca7ed5030b33ead4f2a /generic | |
parent | e2779b6b41c0ecc07005f1da41c7b6aa5895ed36 (diff) | |
parent | 000147c3a5bd1e6c44efc6e8f56f8e61c86fc0d4 (diff) | |
download | tcl-89f0948b6924bdb698cb27e93364f06b24fa3976.zip tcl-89f0948b6924bdb698cb27e93364f06b24fa3976.tar.gz tcl-89f0948b6924bdb698cb27e93364f06b24fa3976.tar.bz2 |
TIP #459 remaining part of implementation. Makes "package require Tk" give the right (... at least ... the expected ...) answer.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCmdMZ.c | 30 |
1 files changed, 27 insertions, 3 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; } /* |