tclnamesp.c

来自「tcl是工具命令语言」· C语言 代码 · 共 1,958 行 · 第 1/5 页

 *	If "flags" contains CREATE_NS_IF_UNKNOWN, all namespace
 *	components of the qualified name that cannot be found are
 *	automatically created within their specified parent. This makes sure
 *	that functions like Tcl_CreateCommand always succeed. There is no
 *	alternate search path, so *altNsPtrPtr is set NULL.
 *
 *	If "flags" contains FIND_ONLY_NS, the qualified name is treated as a
 *	reference to a namespace, and the entire qualified name is
 *	followed. If the name is relative, the namespace is looked up only
 *	in the current namespace. A pointer to the namespace is stored in
 *	*nsPtrPtr and NULL is stored in *simpleNamePtr. Otherwise, if
 *	FIND_ONLY_NS is not specified, only the leading components are
 *	treated as namespace names, and a pointer to the simple name of the
 *	final component is stored in *simpleNamePtr.
 *
 * Results:
 *	It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible
 *	namespaces which represent the last (containing) namespace in the
 *	qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr
 *	to NULL, then the search along that path failed.  The procedure also
 *	stores a pointer to the simple name of the final component in
 *	*simpleNamePtr. If the qualified name is "::" or was treated as a
 *	namespace reference (FIND_ONLY_NS), the procedure stores a pointer
 *	to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets
 *	*simpleNamePtr to point to an empty string.
 *
 *	If there is an error, this procedure returns TCL_ERROR. If "flags"
 *	contains TCL_LEAVE_ERR_MSG, an error message is returned in the
 *	interpreter's result object. Otherwise, the interpreter's result
 *	object is left unchanged.
 *
 *	*actualCxtPtrPtr is set to the actual context namespace. It is
 *	set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
 *	is NULL, it is set to the current namespace context.
 *
 *	For backwards compatibility with the TclPro byte code loader,
 *	this function always returns TCL_OK.
 *
 * Side effects:
 *	If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
 *	created.
 *
 *----------------------------------------------------------------------
 */

int
TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
	nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
    Tcl_Interp *interp;		 /* Interpreter in which to find the
				  * namespace containing qualName. */
    CONST char *qualName;	 /* A namespace-qualified name of an
				  * command, variable, or namespace. */
    Namespace *cxtNsPtr;	 /* The namespace in which to start the
				  * search for qualName's namespace. If NULL
				  * start from the current namespace.
				  * Ignored if TCL_GLOBAL_ONLY or
				  * TCL_NAMESPACE_ONLY are set. */
    int flags;			 /* Flags controlling the search: an OR'd
				  * combination of TCL_GLOBAL_ONLY,
				  * TCL_NAMESPACE_ONLY,
				  * CREATE_NS_IF_UNKNOWN, and
				  * FIND_ONLY_NS. */
    Namespace **nsPtrPtr;	 /* Address where procedure stores a pointer
				  * to containing namespace if qualName is
				  * found starting from *cxtNsPtr or, if
				  * TCL_GLOBAL_ONLY is set, if qualName is
				  * found in the global :: namespace. NULL
				  * is stored otherwise. */
    Namespace **altNsPtrPtr;	 /* Address where procedure stores a pointer
				  * to containing namespace if qualName is
				  * found starting from the global ::
				  * namespace. NULL is stored if qualName
				  * isn't found starting from :: or if the
				  * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				  * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag
				  * is set. */
    Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer
				  * to the actual namespace from which the
				  * search started. This is either cxtNsPtr,
				  * the :: namespace if TCL_GLOBAL_ONLY was
				  * specified, or the current namespace if
				  * cxtNsPtr was NULL. */
    CONST char **simpleNamePtr;	 /* Address where procedure stores the
				  * simple name at end of the qualName, or
				  * NULL if qualName is "::" or the flag
				  * FIND_ONLY_NS was specified. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr = cxtNsPtr;
    Namespace *altNsPtr;
    Namespace *globalNsPtr = iPtr->globalNsPtr;
    CONST char *start, *end;
    CONST char *nsName;
    Tcl_HashEntry *entryPtr;
    Tcl_DString buffer;
    int len;

    /*
     * Determine the context namespace nsPtr in which to start the primary
     * search. If TCL_NAMESPACE_ONLY or FIND_ONLY_NS was specified, search
     * from the current namespace. If the qualName name starts with a "::"
     * or TCL_GLOBAL_ONLY was specified, search from the global
     * namespace. Otherwise, use the given namespace given in cxtNsPtr, or
     * if that is NULL, use the current namespace context. Note that we
     * always treat two or more adjacent ":"s as a namespace separator.
     */

    if (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS)) {
	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    } else if (flags & TCL_GLOBAL_ONLY) {
	nsPtr = globalNsPtr;
    } else if (nsPtr == NULL) {
	if (iPtr->varFramePtr != NULL) {
	    nsPtr = iPtr->varFramePtr->nsPtr;
	} else {
	    nsPtr = iPtr->globalNsPtr;
	}
    }

    start = qualName;		/* pts to start of qualifying namespace */
    if ((*qualName == ':') && (*(qualName+1) == ':')) {
	start = qualName+2;	/* skip over the initial :: */
	while (*start == ':') {
            start++;		/* skip over a subsequent : */
	}
        nsPtr = globalNsPtr;
        if (*start == '\0') {	/* qualName is just two or more ":"s */
            *nsPtrPtr        = globalNsPtr;
            *altNsPtrPtr     = NULL;
	    *actualCxtPtrPtr = globalNsPtr;
            *simpleNamePtr   = start; /* points to empty string */
            return TCL_OK;
        }
    }
    *actualCxtPtrPtr = nsPtr;

    /*
     * Start an alternate search path starting with the global namespace.
     * However, if the starting context is the global namespace, or if the
     * flag is set to search only the namespace *cxtNsPtr, ignore the
     * alternate search path.
     */

    altNsPtr = globalNsPtr;
    if ((nsPtr == globalNsPtr)
	    || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {
        altNsPtr = NULL;
    }

    /*
     * Loop to resolve each namespace qualifier in qualName.
     */

    Tcl_DStringInit(&buffer);
    end = start;
    while (*start != '\0') {
        /*
         * Find the next namespace qualifier (i.e., a name ending in "::")
	 * or the end of the qualified name  (i.e., a name ending in "\0").
	 * Set len to the number of characters, starting from start,
	 * in the name; set end to point after the "::"s or at the "\0".
         */

	len = 0;
        for (end = start;  *end != '\0';  end++) {
	    if ((*end == ':') && (*(end+1) == ':')) {
		end += 2;	/* skip over the initial :: */
		while (*end == ':') {
		    end++;	/* skip over the subsequent : */
		}
		break;		/* exit for loop; end is after ::'s */
	    }
            len++;
	}

	if ((*end == '\0')
	        && !((end-start >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) {
	    /*
	     * qualName ended with a simple name at start. If FIND_ONLY_NS
	     * was specified, look this up as a namespace. Otherwise,
	     * start is the name of a cmd or var and we are done.
	     */
	    
	    if (flags & FIND_ONLY_NS) {
		nsName = start;
	    } else {
		*nsPtrPtr      = nsPtr;
		*altNsPtrPtr   = altNsPtr;
		*simpleNamePtr = start;
		Tcl_DStringFree(&buffer);
		return TCL_OK;
	    }
	} else {
	    /*
	     * start points to the beginning of a namespace qualifier ending
	     * in "::". end points to the start of a name in that namespace
	     * that might be empty. Copy the namespace qualifier to a
	     * buffer so it can be null terminated. We can't modify the
	     * incoming qualName since it may be a string constant.
	     */

	    Tcl_DStringSetLength(&buffer, 0);
            Tcl_DStringAppend(&buffer, start, len);
            nsName = Tcl_DStringValue(&buffer);
        }

        /*
	 * Look up the namespace qualifier nsName in the current namespace
         * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set,
         * create that qualifying namespace. This is needed for procedures
         * like Tcl_CreateCommand that cannot fail.
	 */

        if (nsPtr != NULL) {
            entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
            if (entryPtr != NULL) {
                nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
            } else if (flags & CREATE_NS_IF_UNKNOWN) {
		Tcl_CallFrame frame;
		
		(void) Tcl_PushCallFrame(interp, &frame,
		        (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);

                nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
		        (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
                Tcl_PopCallFrame(interp);

                if (nsPtr == NULL) {
                    panic("Could not create namespace '%s'", nsName);
                }
            } else {		/* namespace not found and wasn't created */
                nsPtr = NULL;
            }
        }

        /*
         * Look up the namespace qualifier in the alternate search path too.
         */

        if (altNsPtr != NULL) {
            entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
            if (entryPtr != NULL) {
                altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
            } else {
                altNsPtr = NULL;
            }
        }

        /*
         * If both search paths have failed, return NULL results.
         */

        if ((nsPtr == NULL) && (altNsPtr == NULL)) {
            *nsPtrPtr      = NULL;
            *altNsPtrPtr   = NULL;
            *simpleNamePtr = NULL;
            Tcl_DStringFree(&buffer);
            return TCL_OK;
        }

	start = end;
    }

    /*
     * We ignore trailing "::"s in a namespace name, but in a command or
     * variable name, trailing "::"s refer to the cmd or var named {}.
     */

    if ((flags & FIND_ONLY_NS)
	    || ((end > start ) && (*(end-1) != ':'))) {
	*simpleNamePtr = NULL; /* found namespace name */
    } else {
	*simpleNamePtr = end;  /* found cmd/var: points to empty string */
    }

    /*
     * As a special case, if we are looking for a namespace and qualName
     * is "" and the current active namespace (nsPtr) is not the global
     * namespace, return NULL (no namespace was found). This is because
     * namespaces can not have empty names except for the global namespace.
     */

    if ((flags & FIND_ONLY_NS) && (*qualName == '\0')
	    && (nsPtr != globalNsPtr)) {
	nsPtr = NULL;
    }

    *nsPtrPtr    = nsPtr;
    *altNsPtrPtr = altNsPtr;
    Tcl_DStringFree(&buffer);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespace --
 *
 *	Searches for a namespace.
 *
 * Results:
 *	Returns a pointer to the namespace if it is found. Otherwise,
 *	returns NULL and leaves an error message in the interpreter's
 *	result object if "flags" contains TCL_LEAVE_ERR_MSG.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Namespace *
Tcl_FindNamespace(interp, name, contextNsPtr, flags)
    Tcl_Interp *interp;		 /* The interpreter in which to find the
				  * namespace. */
    CONST char *name;		 /* Namespace name. If it starts with "::",
				  * will be looked up in global namespace.
				  * Else, looked up first in contextNsPtr
				  * (current namespace if contextNsPtr is
				  * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag is set
				  * or if the name starts with "::".
				  * Otherwise, points to namespace in which
				  * to resolve name; if NULL, look up name
				  * in the current namespace. */
    register int flags;		 /* Flags controlling namespace lookup: an
				  * OR'd combination of TCL_GLOBAL_ONLY and
				  * TCL_LEAVE_ERR_MSG flags. */
{
    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
    CONST char *dummy;

    /*
     * Find the namespace(s) that contain the specified namespace name.
     * Add the FIND_ONLY_NS flag to resolve the name all the way down
     * to its last component, a namespace.
     */

    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
	    (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
    
    if (nsPtr != NULL) {
       return (Tcl_Namespace *) nsPtr;
    } else if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_ResetResult(interp);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "unknown namespace \"", name, "\"", (char *) NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindCommand --
 *
 *	Searches for a command.
 *
 * Results:
 *	Returns a token for the command if it is found. Otherwise, if it
 *	can't be found or there is an error, returns NULL and leaves an
 *	error message in the interpreter's result object if "flags"
 *	contains TCL_LEAVE_ERR_MSG.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_FindCommand(interp, name, contextNsPtr, flags)
    Tcl_Interp *interp;         /* The interpreter in which to find the
				  * command and to report errors. */
    CONST char *name;	         /* Command's name. If it starts with "::",
				  * will be looked up in global namespace.
				  * Else, looked up first in contextNsPtr
				  * (current namespace if contextNsPtr is
				  * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
				  * Otherwise, points to namespace in which
				  * to resolve name. If NULL, look up name
				  * in the current namespace. */
    int flags;                   /* An OR'd combination of flags:
				  * TCL_GLOBAL_ONLY (look up name only in
				  * global namespace), TCL_NAMESPACE_ONLY
				  * (look up only in contextNsPtr, or the
				  * current namespace if contextNsPtr is
				  * NULL), and TCL_LEAVE_ERR_MSG. If both
				  * TCL_GLOBAL_ONLY and TC