diff options
Diffstat (limited to 'generic/tclLoad.c')
| -rw-r--r-- | generic/tclLoad.c | 23 |
1 files changed, 21 insertions, 2 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index be296b3..2d8ed5f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -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. */ @@ -1034,10 +1034,13 @@ int TclGetLoadedPackages( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ - const char *targetName) /* Name of target interpreter or NULL. If + 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 + * all packages. + */ { Tcl_Interp *target; LoadedPackage *pkgPtr; @@ -1048,6 +1051,22 @@ TclGetLoadedPackages( /* * Return information about all of the available packages. */ + if (packageName) { + resultObj = NULL; + Tcl_MutexLock(&packageMutex); + for (pkgPtr = firstPackagePtr; pkgPtr != NULL; + pkgPtr = pkgPtr->nextPtr) { + if (!strcmp(packageName, pkgPtr->packageName)) { + resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1); + break; + } + } + Tcl_MutexUnlock(&packageMutex); + if (resultObj) { + Tcl_SetObjResult(interp, resultObj); + } + return TCL_OK; + } resultObj = Tcl_NewObj(); Tcl_MutexLock(&packageMutex); |