/* ARGSUSED */
static char *
EnvTraceProc(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Interpreter whose "env" variable is being
* modified. */
const char *name1, /* Better be "env". */
const char *name2, /* Name of variable being modified, or NULL if
* whole array is being deleted (UTF-8). */
int flags) /* Indicates what's happening. */
{
/*
* For array traces, let TclSetupEnv do all the work.
*/
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
return NULL;
}
/*
* If name2 is NULL, then return and do nothing.
*/
if (name2 == NULL) {
return NULL;
}
/*
* If a value is being set, call TclSetEnv to do all of the work.
*/
if (flags & TCL_TRACE_WRITES) {
const char *value;
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
}
/*
* If a value is being read, call TclGetEnv to do all of the work.
*/
if (flags & TCL_TRACE_READS) {
Tcl_DString valueString;
const char *value = TclGetEnv(name2, &valueString);
if (value == NULL) {
return "no such variable";
}
Tcl_SetVar2(interp, name1, name2, value, 0);
Tcl_DStringFree(&valueString);
}
/*
* For unset traces, let TclUnsetEnv do all the work.
*/
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
}
return NULL;
}
Tcl_Interp *
Tcl_CreateInterp (mem_pool_t *pool)
{
Interp *iPtr;
Command *c;
CmdInfo *ci;
int i;
iPtr = (Interp*) mem_alloc (pool, sizeof(Interp));
iPtr->pool = pool;
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = 0;
iPtr->errorLine = 0;
Tcl_InitHashTable (&iPtr->commandTable, pool, TCL_STRING_KEYS);
Tcl_InitHashTable (&iPtr->globalTable, pool, TCL_STRING_KEYS);
iPtr->numLevels = 0;
iPtr->framePtr = 0;
iPtr->varFramePtr = 0;
iPtr->activeTracePtr = 0;
iPtr->numEvents = 0;
iPtr->events = 0;
iPtr->curEvent = 0;
iPtr->curEventNum = 0;
iPtr->revPtr = 0;
iPtr->historyFirst = 0;
iPtr->revDisables = 1;
iPtr->evalFirst = iPtr->evalLast = 0;
iPtr->appendResult = 0;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
iPtr->numFiles = 0;
iPtr->filePtrArray = 0;
for (i = 0; i < NUM_REGEXPS; i++) {
iPtr->patterns[i] = 0;
iPtr->patLengths[i] = -1;
iPtr->regexps[i] = 0;
}
iPtr->cmdCount = 0;
iPtr->noEval = 0;
iPtr->scriptFile = 0;
iPtr->flags = 0;
iPtr->tracePtr = 0;
iPtr->resultSpace[0] = 0;
/*
* Create the built-in commands. Do it here, rather than calling
* Tcl_CreateCommand, because it's faster (there's no need to
* check for a pre-existing command by the same name).
*/
for (ci = builtin_cmds; ci->name != 0; ci++) {
int isnew;
Tcl_HashEntry *he;
he = Tcl_CreateHashEntry (&iPtr->commandTable, ci->name, &isnew);
if (isnew) {
c = (Command*) mem_alloc (pool, sizeof(Command));
c->proc = ci->proc;
c->clientData = (void*) 0;
c->deleteProc = 0;
Tcl_SetHashValue (he, c);
}
}
#ifdef TCL_ENV_CMDS
TclSetupEnv ((Tcl_Interp *) iPtr);
#endif
return (Tcl_Interp *) iPtr;
}
