summaryrefslogtreecommitdiffstats
path: root/generic/tclLoad.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r--generic/tclLoad.c57
1 files changed, 45 insertions, 12 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 7c70e03..bcda420 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.
*/
@@ -1012,10 +1012,10 @@ Tcl_StaticPackage(
/*
*----------------------------------------------------------------------
*
- * TclGetLoadedPackages --
+ * TclGetLoadedPackages, TclGetLoadedPackagesEx --
*
* This function returns information about all of the files that are
- * loaded (either in a particular intepreter, or for all interpreters).
+ * loaded (either in a particular interpreter, or for all interpreters).
*
* Results:
* The return value is a standard Tcl completion code. If successful, a
@@ -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;