summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c213
1 files changed, 131 insertions, 82 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index cf39f90..a0a651b 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.164 2008/05/22 15:22:07 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.165 2008/07/13 09:03:35 msofer Exp $
*/
#include "tclInt.h"
@@ -169,6 +169,8 @@ static int GetNamespaceFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int InvokeImportedCmd(ClientData clientData,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int InvokeImportedNRCmd(ClientData clientData,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceChildrenCmd(ClientData dummy,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
@@ -212,6 +214,8 @@ static int NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int NsEnsembleImplementationCmd(ClientData clientData,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int NsEnsembleImplementationCmdNR(ClientData clientData,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int NsEnsembleStringOrder(const void *strPtr1,
const void *strPtr2);
@@ -224,6 +228,8 @@ static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
static void UnlinkNsPath(Namespace *nsPtr);
+static TclNR_PostProc NsEval_Callback;
+
/*
* This structure defines a Tcl object type that contains a namespace
* reference. It is used in commands that take the name of a namespace as an
@@ -1638,8 +1644,8 @@ DoImport(
}
dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
- importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
- InvokeImportedCmd, dataPtr, DeleteImportedCmd);
+ importedCmd = TclNR_CreateCommand(interp, Tcl_DStringValue(&ds),
+ InvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
@@ -1876,6 +1882,25 @@ TclGetOriginalCommand(
*/
static int
+InvokeImportedNRCmd(
+ ClientData clientData, /* Points to the imported command's
+ * ImportedCmdData structure. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ register ImportedCmdData *dataPtr = clientData;
+ register Command *realCmdPtr = dataPtr->realCmdPtr;
+
+ if (!realCmdPtr->nreProc) {
+ return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+ objc, objv);
+ }
+ return (*realCmdPtr->nreProc)(realCmdPtr->objClientData, interp,
+ objc, objv);
+}
+
+static int
InvokeImportedCmd(
ClientData clientData, /* Points to the imported command's
* ImportedCmdData structure. */
@@ -2772,6 +2797,16 @@ Tcl_NamespaceObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ return TclNR_CallObjProc(interp, TclNRNamespaceObjCmd, clientData, objc, objv);
+}
+
+int
+TclNRNamespaceObjCmd(
+ ClientData clientData, /* Arbitrary value passed to cmd. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
static const char *subCmds[] = {
"children", "code", "current", "delete", "ensemble",
"eval", "exists", "export", "forget", "import",
@@ -3225,12 +3260,42 @@ NamespaceDeleteCmd(
*/
static int
+NsEval_Callback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Namespace *namespacePtr = data[0];
+
+ if (result == TCL_ERROR) {
+ int length = strlen(namespacePtr->fullName);
+ int limit = 200;
+ int overflow = (length > limit);
+ char *cmd = data[1];
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in namespace %s \"%.*s%s\" script line %d)",
+ cmd,
+ (overflow ? limit : length), namespacePtr->fullName,
+ (overflow ? "..." : ""), interp->errorLine));
+ }
+
+ /*
+ * Restore the previous "current" namespace.
+ */
+
+ TclPopStackFrame(interp);
+ return result;
+}
+
+static int
NamespaceEvalCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Interp *iPtr = (Interp *) interp;
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
Tcl_Obj *objPtr;
@@ -3278,13 +3343,7 @@ NamespaceEvalCmd(
framePtr->objv = objv;
if (objc == 4) {
- /*
- * TIP #280: Make invoker available to eval'd script.
- */
-
- Interp *iPtr = (Interp *) interp;
-
- result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3);
+ objPtr = objv[3];
} else {
/*
* More than one argument: concatenate them together with spaces
@@ -3293,31 +3352,14 @@ NamespaceEvalCmd(
*/
objPtr = Tcl_ConcatObj(objc-3, objv+3);
-
- /*
- * TIP #280: Make invoking context available to eval'd script.
- */
-
- result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
}
-
- if (result == TCL_ERROR) {
- int length = strlen(namespacePtr->fullName);
- int limit = 200;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in namespace eval \"%.*s%s\" script line %d)",
- (overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine));
- }
-
+
/*
- * Restore the previous "current" namespace.
+ * TIP #280: Make invoking context available to eval'd script.
*/
-
- TclPopStackFrame(interp);
- return result;
+
+ TclNR_AddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL);
+ return TclNREvalObjEx(interp, objPtr, 0, iPtr->cmdFramePtr, 3);
}
/*
@@ -3675,6 +3717,7 @@ NamespaceInscopeCmd(
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
int i, result;
+ Tcl_Obj *cmdObjPtr;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
@@ -3712,10 +3755,10 @@ NamespaceInscopeCmd(
*/
if (objc == 4) {
- result = Tcl_EvalObjEx(interp, objv[3], 0);
+ cmdObjPtr = objv[3];
} else {
Tcl_Obj *concatObjv[2];
- register Tcl_Obj *listPtr, *cmdObjPtr;
+ register Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
for (i = 4; i < objc; i++) {
@@ -3728,27 +3771,11 @@ NamespaceInscopeCmd(
concatObjv[0] = objv[3];
concatObjv[1] = listPtr;
cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
- result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
Tcl_DecrRefCount(listPtr); /* We're done with the list object. */
}
- if (result == TCL_ERROR) {
- int length = strlen(namespacePtr->fullName);
- int limit = 200;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in namespace inscope \"%.*s%s\" script line %d)",
- (overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine));
- }
-
- /*
- * Restore the previous "current" namespace.
- */
-
- TclPopStackFrame(interp);
- return result;
+ TclNR_AddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL);
+ return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
}
/*
@@ -5293,8 +5320,9 @@ Tcl_CreateEnsemble(
ensemblePtr->subcommandDict = NULL;
ensemblePtr->flags = flags;
ensemblePtr->unknownHandler = NULL;
- ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
- NsEnsembleImplementationCmd, ensemblePtr, DeleteEnsembleConfig);
+ ensemblePtr->token = TclNR_CreateCommand(interp, name,
+ NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
+ ensemblePtr, DeleteEnsembleConfig);
ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
@@ -6013,6 +6041,32 @@ NsEnsembleImplementationCmd(
int objc,
Tcl_Obj *const objv[])
{
+ return TclNR_CallObjProc(interp, NsEnsembleImplementationCmdNR,
+ clientData, objc, objv);
+}
+
+int
+TclClearRootEnsemble(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+
+ return result;
+}
+
+static int
+NsEnsembleImplementationCmdNR(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
EnsembleConfig *ensemblePtr = clientData;
/* The ensemble itself. */
Tcl_Obj **tempObjv; /* Space used to construct the list of
@@ -6179,8 +6233,9 @@ NsEnsembleImplementationCmd(
{
Interp *iPtr = (Interp *) interp;
- int isRootEnsemble;
- Tcl_Obj *copyObj;
+ int isRootEnsemble, i, tempObjc;
+ Tcl_Obj *copyPtr;
+ List *listRepPtr;
/*
* Get the prefix that we're rewriting to. To do this we need to
@@ -6189,8 +6244,23 @@ NsEnsembleImplementationCmd(
* elements in the list.
*/
- copyObj = TclListObjCopy(NULL, prefixObj);
- TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+ TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
+
+ tempObjc = objc - 2 + prefixObjc;
+ copyPtr = Tcl_NewListObj(tempObjc, NULL);
+ if (tempObjc > 0) {
+ listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr->elemCount = tempObjc;
+ tempObjv = &listRepPtr->elements;
+
+ memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
+ memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+
+ for (i=0; i < tempObjc; i++) {
+ Tcl_IncrRefCount(tempObjv[i]);
+ }
+ }
+ Tcl_DecrRefCount(prefixObj);
/*
* Record what arguments the script sent in so that things like
@@ -6214,36 +6284,15 @@ NsEnsembleImplementationCmd(
}
/*
- * Allocate a workspace and build the list of arguments to pass to the
- * target command in it.
- */
-
- tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
- (int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
- memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
-
- /*
* Hand off to the target command.
*/
- result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
- TCL_EVAL_INVOKE);
-
- /*
- * Clean up.
- */
-
- TclStackFree(interp, tempObjv);
- Tcl_DecrRefCount(copyObj);
if (isRootEnsemble) {
- iPtr->ensembleRewrite.sourceObjs = NULL;
- iPtr->ensembleRewrite.numRemovedObjs = 0;
- iPtr->ensembleRewrite.numInsertedObjs = 0;
+ TclNR_AddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
+
+ return TclNREvalCmd(interp, copyPtr, TCL_EVAL_INVOKE);
}
- Tcl_DecrRefCount(prefixObj);
- return result;
unknownOrAmbiguousSubcommand:
/*