diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-02-20 14:51:48 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-02-20 14:51:48 (GMT) |
commit | 16b7bdd558d83c490e2e91bcce0c89dee115fd19 (patch) | |
tree | 28ab1d5bd5339f11e9c6511aba48aa31559359e0 /generic | |
parent | 9279b3aad8ae6175e5238ffd10a05652a2f56c93 (diff) | |
parent | 1dd6a945f9e3a815d98802769aba7da38fbc2ae5 (diff) | |
download | tcl-16b7bdd558d83c490e2e91bcce0c89dee115fd19.zip tcl-16b7bdd558d83c490e2e91bcce0c89dee115fd19.tar.gz tcl-16b7bdd558d83c490e2e91bcce0c89dee115fd19.tar.bz2 |
Merge trunk.
Convert Tcl_SetVar/Tcl_UnsetVar/Tcl_GetVar/Tcl_TraceVar to macros, calling the *2 variants of the function. No change of functionality.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 34 | ||||
-rw-r--r-- | generic/tclDecls.h | 45 | ||||
-rw-r--r-- | generic/tclStubInit.c | 8 | ||||
-rw-r--r-- | generic/tclTrace.c | 38 | ||||
-rw-r--r-- | generic/tclVar.c | 138 |
5 files changed, 43 insertions, 220 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 8a1fde2..68c67af 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -637,10 +637,11 @@ declare 173 { declare 174 { const char *Tcl_GetStringResult(Tcl_Interp *interp) } -declare 175 { - const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags) -} +# Removed in 9.0 +#declare 175 { +# const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, +# int flags) +#} declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) @@ -850,10 +851,11 @@ declare 235 { declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } -declare 237 { - const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, - const char *newValue, int flags) -} +# Removed in 9.0: +#declare 237 { +# const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, +# const char *newValue, int flags) +#} declare 238 { const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) @@ -886,10 +888,11 @@ declare 245 { #declare 246 { # int Tcl_TellOld(Tcl_Channel chan) #} -declare 247 { - int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, ClientData clientData) -} +# Removed in Tcl 9 +#declare 247 { +# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, ClientData clientData) +#} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) @@ -907,9 +910,10 @@ declare 251 { declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } -declare 253 { - int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) -} +# Removed in 9.0: +#declare 253 { +# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) +#} declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index a386a76..5a50ba2 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -499,9 +499,7 @@ TCLAPI Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, TCLAPI Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ TCLAPI const char * Tcl_GetStringResult(Tcl_Interp *interp); -/* 175 */ -TCLAPI const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags); +/* Slot 175 is reserved */ /* 176 */ TCLAPI const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); @@ -656,9 +654,7 @@ TCLAPI void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ TCLAPI void Tcl_SetStdChannel(Tcl_Channel channel, int type); -/* 237 */ -TCLAPI const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, - const char *newValue, int flags); +/* Slot 237 is reserved */ /* 238 */ TCLAPI const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, @@ -684,10 +680,7 @@ TCLAPI void Tcl_StaticPackage(Tcl_Interp *interp, /* 245 */ TCLAPI int Tcl_StringMatch(const char *str, const char *pattern); /* Slot 246 is reserved */ -/* 247 */ -TCLAPI int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *proc, - ClientData clientData); +/* Slot 247 is reserved */ /* 248 */ TCLAPI int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, @@ -705,9 +698,7 @@ TCLAPI void Tcl_UnlinkVar(Tcl_Interp *interp, /* 252 */ TCLAPI int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); -/* 253 */ -TCLAPI int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, - int flags); +/* Slot 253 is reserved */ /* 254 */ TCLAPI int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); @@ -1952,7 +1943,7 @@ typedef struct TclStubs { Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ - const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ + void (*reserved175)(void); const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ void (*reserved177)(void); void (*reserved178)(void); @@ -2014,7 +2005,7 @@ typedef struct TclStubs { void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ + void (*reserved237)(void); const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ @@ -2024,13 +2015,13 @@ typedef struct TclStubs { void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ void (*reserved246)(void); - int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ + void (*reserved247)(void); int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ - int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ + void (*reserved253)(void); int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */ void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ @@ -2778,8 +2769,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ -#define Tcl_GetVar \ - (tclStubsPtr->tcl_GetVar) /* 175 */ +/* Slot 175 is reserved */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ /* Slot 177 is reserved */ @@ -2898,8 +2888,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ -#define Tcl_SetVar \ - (tclStubsPtr->tcl_SetVar) /* 237 */ +/* Slot 237 is reserved */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ @@ -2917,8 +2906,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ /* Slot 246 is reserved */ -#define Tcl_TraceVar \ - (tclStubsPtr->tcl_TraceVar) /* 247 */ +/* Slot 247 is reserved */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ @@ -2929,8 +2917,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ -#define Tcl_UnsetVar \ - (tclStubsPtr->tcl_UnsetVar) /* 253 */ +/* Slot 253 is reserved */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ #define Tcl_UntraceVar \ @@ -3740,6 +3727,14 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, } while(0) #define Tcl_DiscardResult(statePtr) \ Tcl_DecrRefCount(*(statePtr)) +#define Tcl_SetVar(interp, varName, newValue, flags) \ + Tcl_SetVar2(interp, varName, NULL, newValue, flags) +#define Tcl_UnsetVar(interp, varName, flags) \ + Tcl_UnsetVar2(interp, varName, NULL, flags) +#define Tcl_GetVar(interp, varName, flags) \ + Tcl_GetVar2(interp, varName, NULL, flags) +#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ + Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) /* * Deprecated Tcl procedures: diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d45bde3..53a1ee6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -835,7 +835,7 @@ const TclStubs tclStubs = { Tcl_GetSlave, /* 172 */ Tcl_GetStdChannel, /* 173 */ Tcl_GetStringResult, /* 174 */ - Tcl_GetVar, /* 175 */ + 0, /* 175 */ Tcl_GetVar2, /* 176 */ 0, /* 177 */ 0, /* 178 */ @@ -897,7 +897,7 @@ const TclStubs tclStubs = { Tcl_SetObjErrorCode, /* 234 */ Tcl_SetObjResult, /* 235 */ Tcl_SetStdChannel, /* 236 */ - Tcl_SetVar, /* 237 */ + 0, /* 237 */ Tcl_SetVar2, /* 238 */ Tcl_SignalId, /* 239 */ Tcl_SignalMsg, /* 240 */ @@ -907,13 +907,13 @@ const TclStubs tclStubs = { Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ 0, /* 246 */ - Tcl_TraceVar, /* 247 */ + 0, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ Tcl_Ungets, /* 250 */ Tcl_UnlinkVar, /* 251 */ Tcl_UnregisterChannel, /* 252 */ - Tcl_UnsetVar, /* 253 */ + 0, /* 253 */ Tcl_UnsetVar2, /* 254 */ Tcl_UntraceVar, /* 255 */ Tcl_UntraceVar2, /* 256 */ diff --git a/generic/tclTrace.c b/generic/tclTrace.c index faa0444..6fa6c7d 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -3073,44 +3073,6 @@ Tcl_VarTraceInfo2( /* *---------------------------------------------------------------------- * - * Tcl_TraceVar -- - * - * Arrange for reads and/or writes to a variable to cause a function to - * be invoked, which can monitor the operations and/or change their - * actions. - * - * Results: - * A standard Tcl return value. - * - * Side effects: - * A trace is set up on the variable given by varName, such that future - * references to the variable will be intermediated by proc. See the - * manual entry for complete details on the calling sequence for proc. - * The variable's flags are updated. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_TraceVar( - Tcl_Interp *interp, /* Interpreter in which variable is to be - * traced. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits, including any of - * TCL_TRACE_READS, TCL_TRACE_WRITES, - * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and - * TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function to call when specified ops are - * invoked upon varName. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_TraceVar2 -- * * Arrange for reads and/or writes to a variable to cause a function to diff --git a/generic/tclVar.c b/generic/tclVar.c index 997e912..44d32e0 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -1201,48 +1201,6 @@ TclLookupArrayElement( /* *---------------------------------------------------------------------- * - * Tcl_GetVar -- - * - * Return the value of a Tcl variable as a string. - * - * Results: - * The return value points to the current value of varName as a string. - * If the variable is not defined or can't be read because of a clash in - * array usage then a NULL pointer is returned and an error message is - * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. - * Note: the return value is only valid up until the next change to the - * variable; if you depend on the value lasting longer than that, then - * make yourself a private copy. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -const char * -Tcl_GetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG - * bits. */ -{ - Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); - - TclDecrRefCount(varNamePtr); - - if (resultPtr == NULL) { - return NULL; - } - return TclGetString(resultPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GetVar2 -- * * Return the value of a Tcl variable as a string, given a two-part name @@ -1541,54 +1499,6 @@ Tcl_SetObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_SetVar -- - * - * Change the value of a variable. - * - * Results: - * Returns a pointer to the malloc'ed string which is the character - * representation of the variable's new value. The caller must not modify - * this string. If the write operation was disallowed then NULL is - * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory - * message will be left in the interp's result. Note that the returned - * string may not be the same as newValue; this is because variable - * traces may modify the variable's value. - * - * Side effects: - * If varName is defined as a local or global variable in interp, its - * value is changed to newValue. If varName isn't currently defined, then - * a new global variable by that name is created. - * - *---------------------------------------------------------------------- - */ - -const char * -Tcl_SetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - const char *newValue, /* New value for varName. */ - int flags) /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1); - - Tcl_IncrRefCount(varNamePtr); - varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, - Tcl_NewStringObj(newValue, -1), flags); - Tcl_DecrRefCount(varNamePtr); - - if (varValuePtr == NULL) { - return NULL; - } - return TclGetString(varValuePtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetVar2 -- * * Given a two-part variable name, which may refer either to a scalar @@ -2147,54 +2057,6 @@ TclPtrIncrObjVar( /* *---------------------------------------------------------------------- * - * Tcl_UnsetVar -- - * - * Delete a variable, so that it may not be accessed anymore. - * - * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if - * the variable can't be unset. In the event of an error, if the - * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the - * interp's result. - * - * Side effects: - * If varName is defined as a local or global variable in interp, it is - * deleted. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_UnsetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. May be either - * a scalar name or an array name or an - * element in an array. */ - int flags) /* OR-ed combination of any of - * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or - * TCL_LEAVE_ERR_MSG. */ -{ - int result; - Tcl_Obj *varNamePtr; - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - - /* - * Filter to pass through only the flags this interface supports. - */ - - flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags); - - Tcl_DecrRefCount(varNamePtr); - return result; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_UnsetVar2 -- * * Delete a variable, given a 2-part name. |