tclnamesp.c

linux系统下的音频通信

    nsPtr->parentPtr = NULL;

    /*
     * Delete all the child namespaces.
     *
     * BE CAREFUL: When each child is deleted, it will divorce
     *    itself from its parent. You can't traverse a hash table
     *    properly if its elements are being deleted. We use only
     *    the Tcl_FirstHashEntry function to be safe.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
            entryPtr != NULL;
            entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
        childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
        Tcl_DeleteNamespace(childNsPtr);
    }

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
            entryPtr != NULL;
            entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
        cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
        Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
    }
    Tcl_DeleteHashTable(&nsPtr->cmdTable);
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    ckfree(nsPtr->exportArrayPtr[i]);
	}
        ckfree((char *) nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.
     */

    if (nsPtr->deleteProc != NULL) {
        (*nsPtr->deleteProc)(nsPtr->clientData);
    }
    nsPtr->deleteProc = NULL;
    nsPtr->clientData = NULL;

    /*
     * Reset the namespace's id field to ensure that this namespace won't
     * be interpreted as valid by, e.g., the cache validation code for
     * cached command references in Tcl_GetCommandFromObj.
     */

    nsPtr->nsId = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceFree --
 *
 *	Called after a namespace has been deleted, when its
 *	reference count reaches 0.  Frees the data structure
 *	representing the namespace.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
NamespaceFree(nsPtr)
    register Namespace *nsPtr;	/* Points to the namespace to free. */
{
    /*
     * Most of the namespace's contents are freed when the namespace is
     * deleted by Tcl_DeleteNamespace. All that remains is to free its names
     * (for error messages), and the structure itself.
     */

    ckfree(nsPtr->name);
    ckfree(nsPtr->fullName);

    ckfree((char *) nsPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Export --
 *
 *	Makes all the commands matching a pattern available to later be
 *	imported from the namespace specified by contextNsPtr (or the
 *	current namespace if contextNsPtr is NULL). The specified pattern is
 *	appended onto the namespace's export pattern list, which is
 *	optionally cleared beforehand.
 *
 * Results:
 *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
 *	message in the interpreter's result) if something goes wrong.
 *
 * Side effects:
 *	Appends the export pattern onto the namespace's export list.
 *	Optionally reset the namespace's export pattern list.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
    Tcl_Interp *interp;		 /* Current interpreter. */
    Tcl_Namespace *namespacePtr; /* Points to the namespace from which 
				  * commands are to be exported. NULL for
                                  * the current namespace. */
    char *pattern;               /* String pattern indicating which commands
                                  * to export. This pattern may not include
				  * any namespace qualifiers; only commands
				  * in the specified namespace may be
				  * exported. */
    int resetListFirst;		 /* If nonzero, resets the namespace's
				  * export list before appending 
				  * be overwritten by imported commands.
				  * If 0, return an error if an imported
				  * cmd conflicts with an existing one. */
{
#define INIT_EXPORT_PATTERNS 5    
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    char *simplePattern, *patternCpy;
    int neededElems, len, i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
        nsPtr = (Namespace *) currNsPtr;
    } else {
        nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * If resetListFirst is true (nonzero), clear the namespace's export
     * pattern list.
     */

    if (resetListFirst) {
	if (nsPtr->exportArrayPtr != NULL) {
	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
		ckfree(nsPtr->exportArrayPtr[i]);
	    }
	    ckfree((char *) nsPtr->exportArrayPtr);
	    nsPtr->exportArrayPtr = NULL;
	    nsPtr->numExportPatterns = 0;
	    nsPtr->maxExportPatterns = 0;
	}
    }

    /*
     * Check that the pattern doesn't have namespace qualifiers.
     */

    result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
	    /*flags*/ TCL_LEAVE_ERR_MSG, &exportNsPtr, &dummyPtr,
	    &dummyPtr, &simplePattern);
    if (result != TCL_OK) {
	return result;
    }
    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	        "invalid export pattern \"", pattern,
		"\": pattern can't specify a namespace",
		(char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Make sure there is room in the namespace's pattern array for the
     * new pattern.
     */

    neededElems = nsPtr->numExportPatterns + 1;
    if (nsPtr->exportArrayPtr == NULL) {
	nsPtr->exportArrayPtr = (char **)
	        ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
    } else if (neededElems > nsPtr->maxExportPatterns) {
	int numNewElems = 2 * nsPtr->maxExportPatterns;
	size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);
	size_t newBytes  = numNewElems * sizeof(char *);
	char **newPtr = (char **) ckalloc((unsigned) newBytes);

	memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,
	        currBytes);
	ckfree((char *) nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = (char **) newPtr;
	nsPtr->maxExportPatterns = numNewElems;
    }

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = (char *) ckalloc((unsigned) (len + 1));
    strcpy(patternCpy, pattern);
    
    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;
    return TCL_OK;
#undef INIT_EXPORT_PATTERNS
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendExportList --
 *
 *	Appends onto the argument object the list of export patterns for the
 *	specified namespace.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case the object
 *	referenced by objPtr has each export pattern appended to it. If an
 *	error occurs, TCL_ERROR is returned and the interpreter's result
 *	holds an error message.
 *
 * Side effects:
 *	If necessary, the object referenced by objPtr is converted into
 *	a list object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppendExportList(interp, namespacePtr, objPtr)
    Tcl_Interp *interp;		 /* Interpreter used for error reporting. */
    Tcl_Namespace *namespacePtr; /* Points to the namespace whose export
				  * pattern list is appended onto objPtr.
				  * NULL for the current namespace. */
    Tcl_Obj *objPtr;		 /* Points to the Tcl object onto which the
				  * export pattern list is appended. */
{
    Namespace *nsPtr;
    int i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
        nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
    } else {
        nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * Append the export pattern list onto objPtr.
     */

    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	result = Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1));
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Import --
 *
 *	Imports all of the commands matching a pattern into the namespace
 *	specified by contextNsPtr (or the current namespace if contextNsPtr
 *	is NULL). This is done by creating a new command (the "imported
 *	command") that points to the real command in its original namespace.
 *
 *      If matching commands are on the autoload path but haven't been
 *	loaded yet, this command forces them to be loaded, then creates
 *	the links to them.
 *
 * Results:
 *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
 *	message in the interpreter's result) if something goes wrong.
 *
 * Side effects:
 *	Creates new commands in the importing namespace. These indirect
 *	calls back to the real command and are deleted if the real commands
 *	are deleted.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
    Tcl_Interp *interp;		 /* Current interpreter. */
    Tcl_Namespace *namespacePtr; /* Points to the namespace into which the
				  * commands are to be imported. NULL for
                                  * the current namespace. */
    char *pattern;               /* String pattern indicating which commands
                                  * to import. This pattern should be
				  * qualified by the name of the namespace
				  * from which to import the command(s). */
    int allowOverwrite;		 /* If nonzero, allow existing commands to
				  * be overwritten by imported commands.
				  * If 0, return an error if an imported
				  * cmd conflicts with an existing one. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr, *importNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    char *simplePattern, *cmdName;
    register Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Command *cmdPtr;
    ImportRef *refPtr;
    Tcl_Command autoCmd, importedCmd;
    ImportedCmdData *dataPtr;
    int wasExported, i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
        nsPtr = (Namespace *) currNsPtr;
    } else {
        nsPtr = (Namespace *) namespacePtr;
    }
 
    /*
     * First, invoke the "auto_import" command with the pattern
     * being imported.  This command is part of the Tcl library.
     * It looks for imported commands in autoloaded libraries and
     * loads them in.  That way, they will be found when we try
     * to create links below.
     */
    
    autoCmd = Tcl_FindCommand(interp, "auto_import",
 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
 
    if (autoCmd != NULL) {
	Tcl_Obj *objv[2];
 
	objv[0] = Tcl_NewStringObj("auto_import", -1);
	Tcl_IncrRefCount(objv[0]);
	objv[1] = Tcl_NewStringObj(pattern, -1);
	Tcl_IncrRefCount(objv[1]);
 
	cmdPtr = (Command *) autoCmd;
	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
		2, objv);
 
	Tcl_DecrRefCount(objv[0]);
	Tcl_DecrRefCount(objv[1]);
 
	if (result != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }

    /*
     * From the pattern, find the namespace from which we are importing
     * and get the simple pattern (no namespace qualifiers or ::'s) at
     * the end.
     */

    if (strlen(pattern) == 0) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
	        "empty import pattern", -1);
        return TCL_ERROR;
    }