Diff
Not logged in

Differences From Artifact [43bd069df1]:

To Artifact [153f8776ac]:


132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
static int		StringTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(ClientData clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, register VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {







|







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
static int		StringTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(ClientData clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    register CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return NULL;
    }








|







1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return NULL;
    }

1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    register CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,







|







1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
 *
 *----------------------------------------------------------------------
 */

static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    register Trace *tracePtr,	/* Describes the trace function to call. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    const char *command,	/* Points to the first character of the
				 * command's source before substitutions. */
    int numChars,		/* The number of characters in the command's
				 * source. */
    register int objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    char *commandCopy;
    int traceCode;

    /*







|





|







1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
 *
 *----------------------------------------------------------------------
 */

static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    Trace *tracePtr,	/* Describes the trace function to call. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    const char *command,	/* Points to the first character of the
				 * command's source before substitutions. */
    int numChars,		/* The number of characters in the command's
				 * source. */
    int objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    char *commandCopy;
    int traceCode;

    /*
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
	 * string in startLevel and startCmd so that we can delete this
	 * interpreter trace when it reaches the end of this proc.
	 */

	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    register unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,







|







1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
	 * string in startLevel and startCmd so that we can delete this
	 * interpreter trace when it reaches the end of this proc.
	 */

	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
		Tcl_IncrRefCount(errMsgObj);
		result = (char *) errMsgObj;
	    }
	    Tcl_DStringFree(&cmd);
	}
    }
    if (destroy && result != NULL) {
	register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;

	Tcl_DecrRefCount(errMsgObj);
	result = NULL;
    }
    return result;
}








|







2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
		Tcl_IncrRefCount(errMsgObj);
		result = (char *) errMsgObj;
	    }
	    Tcl_DStringFree(&cmd);
	}
    }
    if (destroy && result != NULL) {
	Tcl_Obj *errMsgObj = (Tcl_Obj *) result;

	Tcl_DecrRefCount(errMsgObj);
	result = NULL;
    }
    return result;
}

2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    ClientData clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    register Trace *tracePtr;
    register Interp *iPtr = (Interp *) interp;

    /*
     * Test if this trace allows inline compilation of commands.
     */

    if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
	if (iPtr->tracesForbiddingInline == 0) {







|
|







2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    ClientData clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;

    /*
     * Test if this trace allows inline compilation of commands.
     */

    if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
	if (iPtr->tracesForbiddingInline == 0) {
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
Tcl_DeleteTrace(
    Tcl_Interp *interp,		/* Interpreter that contains trace. */
    Tcl_Trace trace)		/* Token for trace (returned previously by
				 * Tcl_CreateTrace). */
{
    Interp *iPtr = (Interp *) interp;
    Trace *prevPtr, *tracePtr = (Trace *) trace;
    register Trace **tracePtr2 = &iPtr->tracePtr;
    ActiveInterpTrace *activePtr;

    /*
     * Locate the trace entry in the interpreter's trace list, and remove it
     * from the list.
     */








|







2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
Tcl_DeleteTrace(
    Tcl_Interp *interp,		/* Interpreter that contains trace. */
    Tcl_Trace trace)		/* Token for trace (returned previously by
				 * Tcl_CreateTrace). */
{
    Interp *iPtr = (Interp *) interp;
    Trace *prevPtr, *tracePtr = (Trace *) trace;
    Trace **tracePtr2 = &iPtr->tracePtr;
    ActiveInterpTrace *activePtr;

    /*
     * Locate the trace entry in the interpreter's trace list, and remove it
     * from the list.
     */

2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
 *
 *----------------------------------------------------------------------
 */

int
TclObjCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    register Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    Tcl_Obj *part1Ptr,
    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe







|







2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
 *
 *----------------------------------------------------------------------
 */

int
TclObjCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    Tcl_Obj *part1Ptr,
    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}

int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    register Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    const char *part1,
    const char *part2,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe







|







2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}

int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    const char *part1,
    const char *part2,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
TraceVarEx(
    Tcl_Interp *interp,		/* Interpreter in which variable is to be
				 * traced. */
    const char *part1,		/* Name of scalar variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    register VarTrace *tracePtr)/* Structure containing flags, traceProc and
				 * clientData fields. Others should be left
				 * blank. Will be ckfree()d (eventually) if
				 * this function returns TCL_OK, and up to
				 * caller to free if this function returns
				 * TCL_ERROR. */
{
    Interp *iPtr = (Interp *) interp;







|







3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
TraceVarEx(
    Tcl_Interp *interp,		/* Interpreter in which variable is to be
				 * traced. */
    const char *part1,		/* Name of scalar variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    VarTrace *tracePtr)/* Structure containing flags, traceProc and
				 * clientData fields. Others should be left
				 * blank. Will be ckfree()d (eventually) if
				 * this function returns TCL_OK, and up to
				 * caller to free if this function returns
				 * TCL_ERROR. */
{
    Interp *iPtr = (Interp *) interp;