summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorwelch <welch>1998-06-28 21:38:48 (GMT)
committerwelch <welch>1998-06-28 21:38:48 (GMT)
commit7d1f7120682cc4d944681bad0c1c5c38cf5bac4b (patch)
treed54b2e00fc2230746663084f08afdb06dd5b83ff /generic
parent5660a1b99f47947543a5c227dd01243409577753 (diff)
downloadtcl-7d1f7120682cc4d944681bad0c1c5c38cf5bac4b.zip
tcl-7d1f7120682cc4d944681bad0c1c5c38cf5bac4b.tar.gz
tcl-7d1f7120682cc4d944681bad0c1c5c38cf5bac4b.tar.bz2
incr tcl updtaes
Diffstat (limited to 'generic')
-rw-r--r--generic/tclNamesp.c113
-rw-r--r--generic/tclVar.c46
2 files changed, 150 insertions, 9 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;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 6725568..d86ca06 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -141,7 +141,8 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
* parens around the index. Otherwise they
* are NULL. These are needed to restore
* the parens after parsing the name. */
- Namespace *varNsPtr, *dummy1Ptr, *dummy2Ptr;
+ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
+ ResolverScheme *resPtr;
Tcl_HashEntry *hPtr;
register char *p;
int new, i, result;
@@ -183,6 +184,46 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
}
/*
+ * 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 || iPtr->varFramePtr == NULL) {
+ cxtNsPtr = iPtr->globalNsPtr;
+ }
+ else {
+ cxtNsPtr = iPtr->varFramePtr->nsPtr;
+ }
+
+ if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+ resPtr = iPtr->resolverPtr;
+
+ if (cxtNsPtr->varResProc) {
+ result = (*cxtNsPtr->varResProc)(interp, part1,
+ (Tcl_Namespace *) cxtNsPtr, flags, &var);
+ } else {
+ result = TCL_CONTINUE;
+ }
+
+ while (result == TCL_CONTINUE && resPtr) {
+ if (resPtr->varResProc) {
+ result = (*resPtr->varResProc)(interp, part1,
+ (Tcl_Namespace *) cxtNsPtr, flags, &var);
+ }
+ resPtr = resPtr->nextPtr;
+ }
+
+ if (result == TCL_OK) {
+ varPtr = (Var *) var;
+ goto lookupVarPart2;
+ }
+ else if (result != TCL_CONTINUE) {
+ return (Var *) NULL;
+ }
+ }
+
+ /*
* Look up part1. Look it up as either a namespace variable or as a
* local variable in a procedure call frame (varFramePtr).
* Interpret part1 as a namespace variable if:
@@ -310,6 +351,8 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
}
}
}
+
+lookupVarPart2:
if (openParen != NULL) {
*openParen = '(';
openParen = NULL;
@@ -4273,6 +4316,7 @@ TclDeleteVars(iPtr, tablePtr)
if (TclIsVarArray(varPtr)) {
DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
flags);
+ varPtr->value.tablePtr = NULL;
}
if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
objPtr = varPtr->value.objPtr;