Tcl Source Code

2011-05-07  Donal K. Fellows  <[email protected]>

	* generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API
	for result generation.

2011-05-07  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: fix USE_TCLALLOC so that it can be enabled
	* unix/Makefile.in: without editing the Makefile

2011-05-05  Don Porter  <[email protected]>

2011-05-02  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Revised TclFindElement() interface.  The
	* generic/tclDictObj.c:	final argument had been bracePtr, the address
	* generic/tclListObj.c:	of a boolean var, where the caller can be told
	* generic/tclParse.c:	whether or not the parsed list element was
	* generic/tclUtil.c:	enclosed in braces.  In practice, no callers
	really care about that.  What the callers really want to know is
	whether the list element value exists as a literal substring of the
	string being parsed, or whether a call to TclCopyAndCollpase() is
	needed to produce the list element value.  Now the final argument
	is changed to do what callers actually need.  This is a better fit
	for the calls in tclParse.c, where now a good deal of post-processing
	checking for "naked backslashes" is no longer necessary.
	***POTENTIAL INCOMPATIBILITY***

	* generic/tclUtil.c:	TclCountSpaceRuns()

	* generic/tclCmdMZ.c:	Use new routines to replace calls to
	* generic/tclListObj.c:	isspace() and their /* INTL */ risk.
	* generic/tclStrToD.c:
	* generic/tclUtf.c:
	* unix/tclUnixFile.c:

	* generic/tclStringObj.c:	Improved reaction to out of memory.

2011-04-27  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	TclFreeIntRep() correction & cleanup.
	* generic/tclExecute.c:
	* generic/tclIndexObj.c:

	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->initProc(target);
    }

    /*
     * Test for whether the initialization failed. If so, transfer the error
     * from the target interpreter to the originating one.
     */

    if (code != TCL_OK) {
	Tcl_TransferResult(target, code, interp);
	goto done;
    }

    /*
     * Record the fact that the package has been loaded in the target
     * interpreter.
     *
     * Update the proper reference count.
     */

    Tcl_MutexLock(&packageMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount++;
    } else {
	pkgPtr->interpRefCount++;
    }
    Tcl_MutexUnlock(&packageMutex);

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     */

    ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = ckalloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);




  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
    Tcl_DStringFree(&safeInitName);
    Tcl_DStringFree(&unloadName);
    Tcl_DStringFree(&safeUnloadName);

    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. */
{

    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;
		pkgPtr = pkgPtr->nextPtr) {

	    pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
	    pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
	    Tcl_ListObjAppendElement(NULL, resultObj,

		    Tcl_NewListObj(2, pkgDesc));
	}
	Tcl_MutexUnlock(&packageMutex);
	Tcl_SetObjResult(interp, resultObj);
	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);
    resultObj = Tcl_NewObj();
    for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	pkgPtr = ipPtr->pkgPtr;

	pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
	pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
	Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));

    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LoadCleanupProc --