summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-08-23 10:34:43 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-08-23 10:34:43 (GMT)
commit8d919c0d03dbc5bdd562607697b0aed8be34c600 (patch)
tree17e43a02d2875e243afc977324215c4dd0ea2c97
parentfc14df8b55728fe31296e3135cb46e8b9a9c94fe (diff)
parent7fd9e2f5fdd413114e252c3c3db7546551e309a9 (diff)
downloadtcl-8d919c0d03dbc5bdd562607697b0aed8be34c600.zip
tcl-8d919c0d03dbc5bdd562607697b0aed8be34c600.tar.gz
tcl-8d919c0d03dbc5bdd562607697b0aed8be34c600.tar.bz2
TIP #627 implementation
-rw-r--r--doc/CrtObjCmd.319
-rw-r--r--doc/CrtTrace.310
-rw-r--r--doc/NRE.319
-rw-r--r--generic/tcl.decls21
-rw-r--r--generic/tcl.h7
-rw-r--r--generic/tclBasic.c147
-rw-r--r--generic/tclConfig.c2
-rw-r--r--generic/tclDecls.h37
-rw-r--r--generic/tclStubInit.c6
-rw-r--r--generic/tclTrace.c50
10 files changed, 307 insertions, 11 deletions
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 8d10418..0490bd7 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
+Tcl_CreateObjCommand, Tcl_CreateObjCommand2, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -16,6 +16,9 @@ Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetComm
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp
+Tcl_Command
+\fBTcl_CreateObjCommand2\fR(\fIinterp, cmdName, proc2, clientData, deleteProc\fR)
+.sp
int
\fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR)
.sp
@@ -52,6 +55,9 @@ Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
+.AP Tcl_ObjCmdProc2 *proc2 in
+Implementation of the new command: \fIproc2\fR will be called whenever
+\fIcmdName\fR is invoked as a command.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
@@ -174,6 +180,17 @@ typedef void \fBTcl_CmdDeleteProc\fR(
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.
.PP
+\fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR,
+except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR.
+.PP
+.CS
+typedef int \fBTcl_ObjCmdProc2\fR(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ size_t \fIobjc\fR,
+ Tcl_Obj *const \fIobjv\fR[]);
+.CE
+.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3
index 620c081..417c892 100644
--- a/doc/CrtTrace.3
+++ b/doc/CrtTrace.3
@@ -10,7 +10,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
+Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_CreateObjTrace2, Tcl_DeleteTrace \- arrange for command execution to be traced
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,6 +21,9 @@ Tcl_Trace
Tcl_Trace
\fBTcl_CreateObjTrace\fR(\fIinterp, level, flags, objProc, clientData, deleteProc\fR)
.sp
+Tcl_Trace
+\fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR)
+.sp
\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
.SH ARGUMENTS
.AS Tcl_CmdObjTraceDeleteProc *deleteProc
@@ -38,11 +41,14 @@ Flags governing the trace execution. See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
Procedure to call for each command that is executed. See below for
details of the calling sequence.
+.AP Tcl_CmdObjTraceProc2 *objProc2 in
+Procedure to call for each command that is executed. See below for
+details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that is executed. See below for
details on the calling sequence.
.AP ClientData clientData in
-Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
+Arbitrary one-word value to pass to \fIobjProc\fR, \fIobjProc2\fR or \fIproc\fR.
.AP Tcl_CmdObjTraceDeleteProc *deleteProc in
Procedure to call when the trace is deleted. See below for details of
the calling sequence. A NULL pointer is permissible and results in no
diff --git a/doc/NRE.3 b/doc/NRE.3
index 72bb370..f76938a 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
+Tcl_NRCreateCommand, Tcl_NRCreateCommand2, Tcl_NRCallObjProc, Tcl_NRCallObjProc2, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -18,10 +18,17 @@ Tcl_Command
\fBTcl_NRCreateCommand\fR(\fIinterp, cmdName, proc, nreProc, clientData,
deleteProc\fR)
.sp
+Tcl_Command
+\fBTcl_NRCreateCommand2\fR(\fIinterp, cmdName, proc2, nreProc2, clientData,
+ deleteProc\fR)
+.sp
int
\fBTcl_NRCallObjProc\fR(\fIinterp, nreProc, clientData, objc, objv\fR)
.sp
int
+\fBTcl_NRCallObjProc2\fR(\fIinterp, nreProc2, clientData, objc, objv\fR)
+.sp
+int
\fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR)
.sp
int
@@ -47,8 +54,15 @@ Called in order to evaluate a command. Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
+.AP Tcl_ObjCmdProc2 *proc2 in
+Called in order to evaluate a command. Is often just a small wrapper that uses
+\fBTcl_NRCallObjProc2\fR to call \fInreProc2\fR using a new trampoline. Behaves
+in the same way as the \fIproc2\fR argument to \fBTcl_CreateObjCommand2\fR(3)
+(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Called instead of \fIproc\fR when a trampoline is already in use.
+.AP Tcl_ObjCmdProc2 *nreProc2 in
+Called instead of \fIproc2\fR when a trampoline is already in use.
.AP ClientData clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
@@ -104,6 +118,9 @@ first deleted. If \fIinterp\fR is in the process of being deleted
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
command, and returns NULL.
.PP
+\fBTcl_NRCreateCommand2\fR, is an alternative to \fBTcl_NRCreateCommand\fR
+in the same way as \fBTcl_CreateObjCommand2\fR.
+.PP
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
consumes no space on the C stack.
.PP
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 99c0e25..d08ba0a 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2502,6 +2502,27 @@ declare 673 {
int TclGetUniChar(Tcl_Obj *objPtr, int index)
}
+declare 676 {
+ Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
+ const char *cmdName,
+ Tcl_ObjCmdProc2 *proc2, void *clientData,
+ Tcl_CmdDeleteProc *deleteProc)
+}
+declare 677 {
+ Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, int level, int flags,
+ Tcl_CmdObjTraceProc2 *objProc2, void *clientData,
+ Tcl_CmdObjTraceDeleteProc *delProc)
+}
+declare 678 {
+ Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp,
+ const char *cmdName, Tcl_ObjCmdProc2 *proc,
+ Tcl_ObjCmdProc2 *nreProc2, void *clientData,
+ Tcl_CmdDeleteProc *deleteProc)
+}
+declare 679 {
+ int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2,
+ void *clientData, size_t objc, Tcl_Obj *const objv[])
+}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
diff --git a/generic/tcl.h b/generic/tcl.h
index ca68eaa..101ae0b 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -678,6 +678,9 @@ typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
int level, const char *command, Tcl_Command commandInfo, int objc,
struct Tcl_Obj *const *objv);
+typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
+ int level, const char *command, Tcl_Command commandInfo, size_t objc,
+ struct Tcl_Obj *const objv[]);
typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
struct Tcl_Obj *dupPtr);
@@ -702,6 +705,8 @@ typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
int objc, struct Tcl_Obj *const *objv);
+typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
+ size_t objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
@@ -921,6 +926,8 @@ typedef struct Tcl_CmdInfo {
* change a command's namespace; use
* TclRenameCommand or Tcl_Eval (of 'rename')
* to do that. */
+ Tcl_ObjCmdProc2 *objProc2; /* Not used in Tcl 8.7. */
+ void *objClientData2; /* Not used in Tcl 8.7. */
} Tcl_CmdInfo;
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a0c5a91..645a581 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2689,6 +2689,61 @@ Tcl_CreateCommand(
*----------------------------------------------------------------------
*/
+typedef struct {
+ void *clientData; /* Arbitrary value to pass to object function. */
+ Tcl_ObjCmdProc2 *proc;
+ Tcl_ObjCmdProc2 *nreProc;
+ Tcl_CmdDeleteProc *deleteProc;
+} CmdWrapperInfo;
+
+
+static int cmdWrapperProc(void *clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj * const *objv)
+{
+ CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
+ return info->proc(info->clientData, interp, objc, objv);
+}
+
+static void cmdWrapperDeleteProc(void *clientData) {
+ CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
+
+ clientData = info->clientData;
+ Tcl_CmdDeleteProc *deleteProc = info->deleteProc;
+ ckfree(info);
+ if (deleteProc != NULL) {
+ deleteProc(clientData);
+ }
+}
+
+Tcl_Command
+Tcl_CreateObjCommand2(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
+ * previous call to Tcl_CreateInterp). */
+ const char *cmdName, /* Name of command. If it contains namespace
+ * qualifiers, the new command is put in the
+ * specified namespace; otherwise it is put in
+ * the global namespace. */
+ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with
+ * name. */
+ void *clientData, /* Arbitrary value to pass to object
+ * function. */
+ Tcl_CmdDeleteProc *deleteProc
+ /* If not NULL, gives a function to call when
+ * this command is deleted. */
+)
+{
+ CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo));
+ info->proc = proc;
+ info->deleteProc = deleteProc;
+ info->clientData = clientData;
+
+ return Tcl_CreateObjCommand(interp, cmdName,
+ (proc ? cmdWrapperProc : NULL),
+ info, cmdWrapperDeleteProc);
+}
+
Tcl_Command
Tcl_CreateObjCommand(
Tcl_Interp *interp, /* Token for command interpreter (returned by
@@ -3322,8 +3377,14 @@ Tcl_SetCommandInfoFromToken(
}
cmdPtr->objClientData = infoPtr->objClientData;
}
- cmdPtr->deleteProc = infoPtr->deleteProc;
- cmdPtr->deleteData = infoPtr->deleteData;
+ if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
+ CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
+ info->deleteProc = infoPtr->deleteProc;
+ info->clientData = infoPtr->deleteData;
+ } else {
+ cmdPtr->deleteProc = infoPtr->deleteProc;
+ cmdPtr->deleteData = infoPtr->deleteData;
+ }
return 1;
}
@@ -3400,10 +3461,15 @@ Tcl_GetCommandInfoFromToken(
infoPtr->objClientData = cmdPtr->objClientData;
infoPtr->proc = cmdPtr->proc;
infoPtr->clientData = cmdPtr->clientData;
- infoPtr->deleteProc = cmdPtr->deleteProc;
- infoPtr->deleteData = cmdPtr->deleteData;
+ if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
+ CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
+ infoPtr->deleteProc = info->deleteProc;
+ infoPtr->deleteData = info->clientData;
+ } else {
+ infoPtr->deleteProc = cmdPtr->deleteProc;
+ infoPtr->deleteData = cmdPtr->deleteData;
+ }
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
-
return 1;
}
@@ -9100,6 +9166,37 @@ Tcl_NRCallObjProc(
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
+int wrapperNRObjProc(
+ void *clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
+ clientData = info->clientData;
+ Tcl_ObjCmdProc2 *proc = info->proc;
+ ckfree(info);
+ return proc(clientData, interp, objc, objv);
+}
+
+int
+Tcl_NRCallObjProc2(
+ Tcl_Interp *interp,
+ Tcl_ObjCmdProc2 *objProc,
+ void *clientData,
+ size_t objc,
+ Tcl_Obj *const objv[])
+{
+ NRE_callback *rootPtr = TOP_CB(interp);
+ CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo));
+ info->clientData = clientData;
+ info->proc = objProc;
+
+ TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info,
+ INT2PTR(objc), objv);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+}
+
/*
*----------------------------------------------------------------------
*
@@ -9128,6 +9225,46 @@ Tcl_NRCallObjProc(
*----------------------------------------------------------------------
*/
+static int cmdWrapperNreProc(
+ void *clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
+ return info->nreProc(info->clientData, interp, objc, objv);
+}
+
+Tcl_Command
+Tcl_NRCreateCommand2(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
+ * previous call to Tcl_CreateInterp). */
+ const char *cmdName, /* Name of command. If it contains namespace
+ * qualifiers, the new command is put in the
+ * specified namespace; otherwise it is put in
+ * the global namespace. */
+ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with
+ * name, provides direct access for direct
+ * calls. */
+ Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with
+ * name, provides NR implementation */
+ void *clientData, /* Arbitrary value to pass to object
+ * function. */
+ Tcl_CmdDeleteProc *deleteProc)
+ /* If not NULL, gives a function to call when
+ * this command is deleted. */
+{
+ CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo));
+ info->proc = proc;
+ info->nreProc = nreProc;
+ info->deleteProc = deleteProc;
+ info->clientData = clientData;
+ return Tcl_NRCreateCommand(interp, cmdName,
+ (proc ? cmdWrapperProc : NULL),
+ (nreProc ? cmdWrapperNreProc : NULL),
+ info, cmdWrapperDeleteProc);
+}
+
Tcl_Command
Tcl_NRCreateCommand(
Tcl_Interp *interp, /* Token for command interpreter (returned by
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index a145bac..5bffbcb 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -194,7 +194,7 @@ QueryConfigObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
- struct Tcl_Obj *const *objv)
+ Tcl_Obj *const *objv)
{
QCCD *cdPtr = (QCCD *)clientData;
Tcl_Obj *pkgName = cdPtr->pkg;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b869c97..3917d0f 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1975,6 +1975,27 @@ EXTERN const char * TclUtfAtIndex(const char *src, int index);
EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, int first, int last);
/* 673 */
EXTERN int TclGetUniChar(Tcl_Obj *objPtr, int index);
+/* Slot 674 is reserved */
+/* Slot 675 is reserved */
+/* 676 */
+EXTERN Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
+ const char *cmdName, Tcl_ObjCmdProc2 *proc2,
+ void *clientData,
+ Tcl_CmdDeleteProc *deleteProc);
+/* 677 */
+EXTERN Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, int level,
+ int flags, Tcl_CmdObjTraceProc2 *objProc2,
+ void *clientData,
+ Tcl_CmdObjTraceDeleteProc *delProc);
+/* 678 */
+EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp,
+ const char *cmdName, Tcl_ObjCmdProc2 *proc,
+ Tcl_ObjCmdProc2 *nreProc2, void *clientData,
+ Tcl_CmdDeleteProc *deleteProc);
+/* 679 */
+EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp,
+ Tcl_ObjCmdProc2 *objProc2, void *clientData,
+ size_t objc, Tcl_Obj *const objv[]);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2684,6 +2705,12 @@ typedef struct TclStubs {
const char * (*tclUtfAtIndex) (const char *src, int index); /* 671 */
Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, int first, int last); /* 672 */
int (*tclGetUniChar) (Tcl_Obj *objPtr, int index); /* 673 */
+ void (*reserved674)(void);
+ void (*reserved675)(void);
+ Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */
+ Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
+ Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
+ int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -4062,6 +4089,16 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tclGetRange) /* 672 */
#define TclGetUniChar \
(tclStubsPtr->tclGetUniChar) /* 673 */
+/* Slot 674 is reserved */
+/* Slot 675 is reserved */
+#define Tcl_CreateObjCommand2 \
+ (tclStubsPtr->tcl_CreateObjCommand2) /* 676 */
+#define Tcl_CreateObjTrace2 \
+ (tclStubsPtr->tcl_CreateObjTrace2) /* 677 */
+#define Tcl_NRCreateCommand2 \
+ (tclStubsPtr->tcl_NRCreateCommand2) /* 678 */
+#define Tcl_NRCallObjProc2 \
+ (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2b7952d..4941348 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -2034,6 +2034,12 @@ const TclStubs tclStubs = {
TclUtfAtIndex, /* 671 */
TclGetRange, /* 672 */
TclGetUniChar, /* 673 */
+ 0, /* 674 */
+ 0, /* 675 */
+ Tcl_CreateObjCommand2, /* 676 */
+ Tcl_CreateObjTrace2, /* 677 */
+ Tcl_NRCreateCommand2, /* 678 */
+ Tcl_NRCallObjProc2, /* 679 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index c8f10e3..0c243a6 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1759,7 +1759,7 @@ TraceExecutionProc(
const char *command,
TCL_UNUSED(Tcl_Command),
int objc,
- struct Tcl_Obj *const objv[])
+ Tcl_Obj *const objv[])
{
int call = 0;
Interp *iPtr = (Interp *) interp;
@@ -2121,6 +2121,54 @@ TraceVarProc(
*----------------------------------------------------------------------
*/
+typedef struct {
+ Tcl_CmdObjTraceProc2 *proc;
+ Tcl_CmdObjTraceDeleteProc *delProc;
+ void *clientData;
+} TraceWrapperInfo;
+
+static int traceWrapperProc(
+ void *clientData,
+ Tcl_Interp *interp,
+ int level,
+ const char *command,
+ Tcl_Command commandInfo,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
+ return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv);
+}
+
+static void traceWrapperDelProc(void *clientData)
+{
+ TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
+ clientData = info->clientData;
+ if (info->delProc) {
+ info->delProc(clientData);
+ }
+ ckfree(info);
+}
+
+Tcl_Trace
+Tcl_CreateObjTrace2(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int level, /* Maximum nesting level */
+ int flags, /* Flags, see above */
+ Tcl_CmdObjTraceProc2 *proc, /* Trace callback */
+ void *clientData, /* Client data for the callback */
+ Tcl_CmdObjTraceDeleteProc *delProc)
+ /* Function to call when trace is deleted */
+{
+ TraceWrapperInfo *info = (TraceWrapperInfo *)ckalloc(sizeof(TraceWrapperInfo));
+ info->proc = proc;
+ info->delProc = delProc;
+ info->clientData = clientData;
+ return Tcl_CreateObjTrace(interp, level, flags,
+ (proc ? traceWrapperProc : NULL),
+ info, traceWrapperDelProc);
+}
+
Tcl_Trace
Tcl_CreateObjTrace(
Tcl_Interp *interp, /* Tcl interpreter */