merge fork

1 files changed, 115 insertions, 20 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index eb3889d..21e5ade 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -309,8 +309,10 @@ static const CmdInfo builtInCmds[] = {
     {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
     {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lseq",            Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
     {"proc",		procObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
@@ -608,13 +610,13 @@ TclFinalizeEvaluation(void)
  */
 
 static int
-buildInfoObjCmd(
+buildInfoObjCmd2(
     void *clientData,
     Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
+    size_t objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    if (objc > 2) {
+    if (objc - 1 > 1) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
 	return TCL_ERROR;
     }
@@ -693,6 +695,16 @@ buildInfoObjCmd(
     return TCL_OK;
 }
 
+static int
+buildInfoObjCmd(
+    void *clientData,
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    return buildInfoObjCmd2(clientData, interp, (size_t)objc, objv);
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -764,6 +776,7 @@ Tcl_CreateInterp(void)
 	Tcl_MutexUnlock(&cancelLock);
     }
 
+#undef TclObjInterpProc
     if (commandTypeInit == 0) {
         TclRegisterCommandTypeName(TclObjInterpProc, "proc");
         TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
@@ -1234,9 +1247,13 @@ Tcl_CreateInterp(void)
 
     Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
     Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
-    Tcl_CreateObjCommand(interp, "::tcl::build-info",
+    Tcl_CmdInfo info2;
+    Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info",
 	    buildInfoObjCmd, (void *)version, NULL);
-
+    Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2);
+    info2.objProc2 = buildInfoObjCmd2;
+    info2.objClientData2 = (void *)version;
+    Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2);
 
     if (TclTommath_Init(interp) != TCL_OK) {
 	Tcl_Panic("%s", Tcl_GetStringResult(interp));
@@ -2631,26 +2648,30 @@ Tcl_CreateCommand(
  */
 
 typedef struct {
-    void *clientData; /* Arbitrary value to pass to object function. */
     Tcl_ObjCmdProc2 *proc;
-    Tcl_ObjCmdProc2 *nreProc;
+    void *clientData; /* Arbitrary value to pass to proc function. */
     Tcl_CmdDeleteProc *deleteProc;
+    void *deleteData; /* Arbitrary value to pass to deleteProc function. */
+    Tcl_ObjCmdProc2 *nreProc;
 } CmdWrapperInfo;
 
 
 static int cmdWrapperProc(void *clientData,
-	Tcl_Interp *interp,
-	int objc,
+    Tcl_Interp *interp,
+    int objc,
     Tcl_Obj * const *objv)
 {
     CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
-    return info->proc(info->clientData, interp, objc, objv);
+    if (objc < 0) {
+	objc = -1;
+    }
+    return info->proc(info->clientData, interp, (size_t)objc, objv);
 }
 
 static void cmdWrapperDeleteProc(void *clientData) {
     CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
 
-    clientData = info->clientData;
+    clientData = info->deleteData;
     Tcl_CmdDeleteProc *deleteProc = info->deleteProc;
     Tcl_Free(info);
     if (deleteProc != NULL) {
@@ -2677,8 +2698,9 @@ Tcl_CreateObjCommand2(
 {
     CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
     info->proc = proc;
-    info->deleteProc = deleteProc;
     info->clientData = clientData;
+    info->deleteProc = deleteProc;
+    info->deleteData = clientData;
 
     return Tcl_CreateObjCommand(interp, cmdName,
 	    (proc ? cmdWrapperProc : NULL),
@@ -3265,6 +3287,37 @@ Tcl_SetCommandInfo(
  *----------------------------------------------------------------------
  */
 
+static int
+invokeObj2Command(
+    void *clientData,	/* Points to command's Command structure. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    size_t objc,		/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int result;
+    Command *cmdPtr = (Command *) clientData;
+
+    if (objc > INT_MAX) {
+	objc = TCL_INDEX_NONE;
+    }
+    if (cmdPtr->objProc != NULL) {
+	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
+    } else {
+	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
+		cmdPtr->objClientData, objc, objv);
+    }
+    return result;
+}
+
+static int cmdWrapper2Proc(void *clientData,
+    Tcl_Interp *interp,
+    size_t objc,
+    Tcl_Obj *const objv[])
+{
+    Command *cmdPtr = (Command *)clientData;
+    return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
+}
+
 int
 Tcl_SetCommandInfoFromToken(
     Tcl_Command cmd,
@@ -3296,11 +3349,33 @@ Tcl_SetCommandInfoFromToken(
     }
     if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
 	CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
+	if (infoPtr->objProc2 == NULL) {
+	    info->proc = invokeObj2Command;
+	    info->clientData = cmdPtr;
+	    info->nreProc = NULL;
+	} else {
+	    if (infoPtr->objProc2 != info->proc) {
+		info->nreProc = NULL;
+		info->proc = infoPtr->objProc2;
+	    }
+	    info->clientData = infoPtr->objClientData2;
+	}
 	info->deleteProc = infoPtr->deleteProc;
-	info->clientData = infoPtr->deleteData;
+	info->deleteData = infoPtr->deleteData;
     } else {
-	cmdPtr->deleteProc = infoPtr->deleteProc;
-	cmdPtr->deleteData = infoPtr->deleteData;
+	if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) {
+	    CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
+	    info->proc = infoPtr->objProc2;
+	    info->clientData = infoPtr->objClientData2;
+	    info->nreProc = NULL;
+	    info->deleteProc = infoPtr->deleteProc;
+	    info->deleteData = infoPtr->deleteData;
+	    cmdPtr->deleteProc = cmdWrapperDeleteProc;
+	    cmdPtr->deleteData = info;
+	} else {
+	    cmdPtr->deleteProc = infoPtr->deleteProc;
+	    cmdPtr->deleteData = infoPtr->deleteData;
+	}
     }
     return 1;
 }
@@ -3368,7 +3443,8 @@ Tcl_GetCommandInfoFromToken(
 
     /*
      * Set isNativeObjectProc 1 if objProc was registered by a call to
-     * Tcl_CreateObjCommand. Otherwise set it to 0.
+     * Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was
+     * registered by a call to Tcl_CreateObjCommand2. Otherwise set it to 0.
      */
 
     cmdPtr = (Command *) cmd;
@@ -3381,10 +3457,17 @@ Tcl_GetCommandInfoFromToken(
     if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
 	CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
 	infoPtr->deleteProc = info->deleteProc;
-	infoPtr->deleteData = info->clientData;
+	infoPtr->deleteData = info->deleteData;
+	infoPtr->objProc2 = info->proc;
+	infoPtr->objClientData2 = info->clientData;
+	if (cmdPtr->objProc == cmdWrapperProc) {
+	    infoPtr->isNativeObjectProc = 2;
+	}
     } else {
 	infoPtr->deleteProc = cmdPtr->deleteProc;
 	infoPtr->deleteData = cmdPtr->deleteData;
+	infoPtr->objProc2 = cmdWrapper2Proc;
+	infoPtr->objClientData2 = cmdPtr;
     }
     infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
     return 1;
@@ -8411,7 +8494,10 @@ int wrapperNRObjProc(
     clientData = info->clientData;
     Tcl_ObjCmdProc2 *proc = info->proc;
     Tcl_Free(info);
-    return proc(clientData, interp, objc, objv);
+    if (objc < 0) {
+	objc = -1;
+    }
+    return proc(clientData, interp, (size_t)objc, objv);
 }
 
 int
@@ -8422,6 +8508,11 @@ Tcl_NRCallObjProc2(
     size_t objc,
     Tcl_Obj *const objv[])
 {
+    if (objc > INT_MAX) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?args?");
+	return TCL_ERROR;
+    }
+
     NRE_callback *rootPtr = TOP_CB(interp);
     CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
     info->clientData = clientData;
@@ -8467,7 +8558,10 @@ static int cmdWrapperNreProc(
     Tcl_Obj *const objv[])
 {
     CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
-    return info->nreProc(info->clientData, interp, objc, objv);
+    if (objc < 0) {
+	objc = -1;
+    }
+    return info->nreProc(info->clientData, interp, (size_t)objc, objv);
 }
 
 Tcl_Command
@@ -8491,9 +8585,10 @@ Tcl_NRCreateCommand2(
 {
     CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
     info->proc = proc;
+    info->clientData = clientData;
     info->nreProc = nreProc;
     info->deleteProc = deleteProc;
-    info->clientData = clientData;
+    info->deleteData = clientData;
     return Tcl_NRCreateCommand(interp, cmdName,
 	    (proc ? cmdWrapperProc : NULL),
 	    (nreProc ? cmdWrapperNreProc : NULL),