diff options
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 57 |
1 files changed, 45 insertions, 12 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index be296b3..66637da 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -336,7 +336,7 @@ Tcl_LoadObjCmd( } #endif /* __CYGWIN__ */ for (p = pkgGuess; *p != 0; p += offset) { - offset = Tcl_UtfToUniChar(p, &ch); + offset = TclUtfToUniChar(p, &ch); if ((ch > 0x100) || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ || (UCHAR(ch) == '_'))) { @@ -998,7 +998,7 @@ Tcl_StaticPackage( } /* - * Package isn't loade in the current interp yet. Mark it as now being + * Package isn't loaded in the current interp yet. Mark it as now being * loaded. */ @@ -1012,7 +1012,7 @@ Tcl_StaticPackage( /* *---------------------------------------------------------------------- * - * TclGetLoadedPackages -- + * TclGetLoadedPackages, TclGetLoadedPackagesEx -- * * This function returns information about all of the files that are * loaded (either in a particular interpreter, or for all interpreters). @@ -1039,16 +1039,27 @@ TclGetLoadedPackages( * otherwise, just return info about this * interpreter. */ { + return TclGetLoadedPackagesEx(interp, targetName, NULL); +} + +int +TclGetLoadedPackagesEx( + Tcl_Interp *interp, /* Interpreter in which to return information + * or error message. */ + const char *targetName, /* Name of target interpreter or NULL. If + * NULL, return info about all interps; + * otherwise, just return info about this + * interpreter. */ + const char *packageName) /* Package name or NULL. If NULL, return info + * for all packages. + */ +{ Tcl_Interp *target; LoadedPackage *pkgPtr; InterpPackage *ipPtr; Tcl_Obj *resultObj, *pkgDesc[2]; if (targetName == NULL) { - /* - * Return information about all of the available packages. - */ - resultObj = Tcl_NewObj(); Tcl_MutexLock(&packageMutex); for (pkgPtr = firstPackagePtr; pkgPtr != NULL; @@ -1063,16 +1074,38 @@ TclGetLoadedPackages( return TCL_OK; } - /* - * Return information about only the packages that are loaded in a given - * interpreter. - */ - target = Tcl_GetSlave(interp, targetName); if (target == NULL) { return TCL_ERROR; } ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL); + + /* + * Return information about all of the available packages. + */ + if (packageName) { + resultObj = NULL; + + for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + pkgPtr = ipPtr->pkgPtr; + + if (!strcmp(packageName, pkgPtr->packageName)) { + resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1); + break; + } + } + + if (resultObj) { + Tcl_SetObjResult(interp, resultObj); + } + return TCL_OK; + } + + /* + * Return information about only the packages that are loaded in a given + * interpreter. + */ + resultObj = Tcl_NewObj(); for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { pkgPtr = ipPtr->pkgPtr; |