diff options
author | ericm <ericm> | 2000-08-25 02:04:26 (GMT) |
---|---|---|
committer | ericm <ericm> | 2000-08-25 02:04:26 (GMT) |
commit | 5264f0bed54365470c89b67b7b18851776a0ceb1 (patch) | |
tree | a3a8e43d27bbf411eb0d9049598838a1c25f3b8b /generic/tclVar.c | |
parent | 4c6c508ce30845f9e15d7d5f1db2821a92c7a157 (diff) | |
download | tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.zip tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.tar.gz tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.tar.bz2 |
* doc/trace.n: Updated documentation for new syntax; flagged old
syntax as deprecated; added documentation for command
rename/delete traces and variable array traces.
* tests/trace.test: Updated tests for new trace syntax; new tests
for command rename/delete traces; new tests for array traces.
* generic/tclVar.c: Support for new trace syntax; support for
TCL_TRACE_ARRAY.
* generic/tclStubInit.c:
* generic/tclDecls.h:
* generic/tcl.decls: Stub functions for command rename/delete traces.
* generic/tcl.h:
* generic/tclInt.h:
* generic/tclBasic.c: Support for command traces.
* generic/tclCmdMZ.c (TclTraceVariableObjCmd): Patched to support
new [trace] syntax:
trace {add|remove|list} {variable|command} name ops command
Added support for command traces (rename, delete operations).
Added support for TCL_TRACE_ARRAY at Tcl level (array operation
for variable traces).
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r-- | generic/tclVar.c | 56 |
1 files changed, 41 insertions, 15 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 8e431c7..48fd89a 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.21 2000/08/21 01:37:51 ericm Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.22 2000/08/25 02:04:29 ericm Exp $ */ #include "tclInt.h" @@ -2309,8 +2309,17 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) { Var *varPtr, *arrayPtr; register VarTrace *tracePtr; - - varPtr = TclLookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG), + int flagMask; + + /* + * We strip 'flags' down to just the parts which are relevant to + * TclLookupVar, to avoid conflicts between trace flags and + * internal namespace flags such as 'FIND_ONLY_NS'. This can + * now occur since we have trace flags with values 0x1000 and higher. + */ + flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; + varPtr = TclLookupVar(interp, part1, part2, + (flags & flagMask) | TCL_LEAVE_ERR_MSG, "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; @@ -2320,14 +2329,17 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) * Set up trace information. */ - tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace)); - tracePtr->traceProc = proc; - tracePtr->clientData = clientData; - tracePtr->flags = - flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | + flagMask = (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY); - tracePtr->nextPtr = varPtr->tracePtr; - varPtr->tracePtr = tracePtr; +#ifndef TCL_REMOVE_OBSOLETE_TRACES + flagMask |= TCL_TRACE_OLD_STYLE; +#endif + tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace)); + tracePtr->traceProc = proc; + tracePtr->clientData = clientData; + tracePtr->flags = flags & flagMask; + tracePtr->nextPtr = varPtr->tracePtr; + varPtr->tracePtr = tracePtr; return TCL_OK; } @@ -2403,17 +2415,31 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; - - varPtr = TclLookupVar(interp, part1, part2, - flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), + int flagMask; + + /* + * Set up a mask to mask out the parts of the flags that we are not + * interested in now. + */ + flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; + varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ (char *) NULL, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return; } - flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | - TCL_TRACE_ARRAY); + + /* + * Set up a mask to mask out the parts of the flags that we are not + * interested in now. + */ + flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | + TCL_TRACE_ARRAY; +#ifndef TCL_REMOVE_OBSOLETE_TRACES + flagMask |= TCL_TRACE_OLD_STYLE; +#endif + flags &= flagMask; for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { |