diff options
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 113 |
1 files changed, 105 insertions, 8 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d4ace43..d399426 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -546,7 +546,11 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc) nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; - nsPtr->cmdRefEpoch = 0; + nsPtr->cmdRefEpoch = 0; + nsPtr->resolverEpoch = 0; + nsPtr->cmdResProc = NULL; + nsPtr->varResProc = NULL; + nsPtr->compiledVarResProc = NULL; if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName, @@ -884,6 +888,7 @@ NamespaceFree(nsPtr) ckfree((char *) nsPtr); } + /* *---------------------------------------------------------------------- @@ -1212,8 +1217,8 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite) Tcl_DString ds; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, currNsPtr->fullName, -1); - if (currNsPtr != iPtr->globalNsPtr) { + Tcl_DStringAppend(&ds, nsPtr->fullName, -1); + if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, "::", 2); } Tcl_DStringAppend(&ds, cmdName, -1); @@ -1794,7 +1799,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, && (nsPtr != globalNsPtr)) { nsPtr = NULL; } - + *nsPtrPtr = nsPtr; *altNsPtrPtr = altNsPtr; Tcl_DStringFree(&buffer); @@ -1905,12 +1910,59 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) * are given, TCL_GLOBAL_ONLY is * ignored. */ { + Interp *iPtr = (Interp*)interp; + + ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; char *simpleName; register Tcl_HashEntry *entryPtr; register Command *cmdPtr; register int search; int result; + Tcl_Command cmd; + + /* + * If this namespace has a command resolver, then give it first + * crack at the command resolution. If the interpreter has any + * command resolvers, consult them next. The command resolver + * procedures may return a Tcl_Command value, they may signal + * to continue onward, or they may signal an error. + */ + if ((flags & TCL_GLOBAL_ONLY) != 0) { + cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + } + else if (contextNsPtr != NULL) { + cxtNsPtr = (Namespace *) contextNsPtr; + } + else { + cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + } + + if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) { + resPtr = iPtr->resolverPtr; + + if (cxtNsPtr->cmdResProc) { + result = (*cxtNsPtr->cmdResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &cmd); + } else { + result = TCL_CONTINUE; + } + + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->cmdResProc) { + result = (*resPtr->cmdResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &cmd); + } + resPtr = resPtr->nextPtr; + } + + if (result == TCL_OK) { + return cmd; + } + else if (result != TCL_CONTINUE) { + return (Tcl_Command) NULL; + } + } /* * Find the namespace(s) that contain the command. @@ -1946,6 +1998,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags) Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown command \"", name, "\"", (char *) NULL); } + return (Tcl_Command) NULL; } @@ -1993,12 +2046,57 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags) * are given, TCL_GLOBAL_ONLY is * ignored. */ { + Interp *iPtr = (Interp*)interp; + ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; char *simpleName; Tcl_HashEntry *entryPtr; Var *varPtr; register int search; int result; + Tcl_Var var; + + /* + * If this namespace has a variable resolver, then give it first + * crack at the variable resolution. It may return a Tcl_Var + * value, it may signal to continue onward, or it may signal + * an error. + */ + if ((flags & TCL_GLOBAL_ONLY) != 0) { + cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + } + else if (contextNsPtr != NULL) { + cxtNsPtr = (Namespace *) contextNsPtr; + } + else { + cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + } + + if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + resPtr = iPtr->resolverPtr; + + if (cxtNsPtr->varResProc) { + result = (*cxtNsPtr->varResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &var); + } else { + result = TCL_CONTINUE; + } + + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->varResProc) { + result = (*resPtr->varResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &var); + } + resPtr = resPtr->nextPtr; + } + + if (result == TCL_OK) { + return var; + } + else if (result != TCL_CONTINUE) { + return (Tcl_Var) NULL; + } + } /* * Find the namespace(s) that contain the variable. @@ -2710,11 +2808,10 @@ NamespaceDeleteCmd(dummy, interp, objc, objv) for (i = 2; i < objc; i++) { name = Tcl_GetStringFromObj(objv[i], (int *) NULL); namespacePtr = Tcl_FindNamespace(interp, name, - (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG); - if (namespacePtr == NULL) { - return TCL_ERROR; + (Tcl_Namespace *) NULL, /* flags */ 0); + if (namespacePtr) { + Tcl_DeleteNamespace(namespacePtr); } - Tcl_DeleteNamespace(namespacePtr); } return TCL_OK; } |