void
Tcl_ResetResult(
Tcl_Interp *interp /* Interpreter for which to clear result. */
)
{
register Interp *iPtr = (Interp *) interp;
Tcl_FreeResult ((Tcl_Interp*) iPtr);
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
iPtr->flags &=
~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
}
static void
SetupAppendBuffer(
register Interp *iPtr /* Interpreter whose result is being set up. */
, int newSpace /* Make sure that at least this many bytes
* of new information may be added. */
)
{
int totalSpace;
/*
* Make the append buffer larger, if that's necessary, then
* copy the current result into the append buffer and make the
* append buffer the official Tcl result.
*/
if (iPtr->result != iPtr->appendResult) {
/*
* If an oversized buffer was used recently, then free it up
* so we go back to a smaller buffer. This avoids tying up
* memory forever after a large operation.
*/
if (iPtr->appendAvl > 500) {
mem_free(iPtr->appendResult);
iPtr->appendResult = 0;
iPtr->appendAvl = 0;
}
iPtr->appendUsed = strlen(iPtr->result);
}
totalSpace = newSpace + iPtr->appendUsed;
if (totalSpace >= iPtr->appendAvl) {
unsigned char *newbuf;
if (totalSpace < 100) {
totalSpace = 200;
} else {
totalSpace *= 2;
}
newbuf = (unsigned char *)mem_alloc (iPtr->pool, totalSpace);
strcpy(newbuf, iPtr->result);
if (iPtr->appendResult != 0) {
mem_free(iPtr->appendResult);
}
iPtr->appendResult = newbuf;
iPtr->appendAvl = totalSpace;
} else if (iPtr->result != iPtr->appendResult) {
strcpy(iPtr->appendResult, iPtr->result);
}
Tcl_FreeResult ((Tcl_Interp*) iPtr);
iPtr->result = iPtr->appendResult;
}
static char * setFullButtons(ClientData data, Tcl_Interp * interp,
char * name1, char * name2, int flags) {
char * val = Tcl_GetVar(interp, "whiptcl_fullbuttons", TCL_GLOBAL_ONLY);
int rc;
int state;
if ((rc = Tcl_ExprBoolean(interp, val, &state))) {
Tcl_FreeResult(interp);
return "whiptcl_fullbuttons may only contain a boolean value";
}
useFullButtons(state);
return NULL;
}
int
Tcl_Eval(
Tcl_Interp *interp /* Token for command interpreter (returned
* by a previous call to Tcl_CreateInterp). */
, unsigned char *cmd /* Pointer to TCL command to interpret. */
, int flags /* OR-ed combination of flags like
* TCL_BRACKET_TERM and TCL_RECORD_BOUNDS. */
, unsigned char **termPtr /* If non-NULL, fill in the address it points
* to with the address of the char. just after
* the last one that was part of cmd. See
* the man page for details on this. */
)
{
/*
* The storage immediately below is used to generate a copy
* of the command, after all argument substitutions. Pv will
* contain the argv values passed to the command procedure.
*/
# define NUM_CHARS 200
unsigned char copyStorage[NUM_CHARS];
ParseValue pv;
unsigned char *oldBuffer;
/*
* This procedure generates an (argv, argc) array for the command,
* It starts out with stack-allocated space but uses dynamically-
* allocated storage to increase it if needed.
*/
# define NUM_ARGS 10
unsigned char *(argStorage[NUM_ARGS]);
unsigned char **argv = argStorage;
int argc;
int argSize = NUM_ARGS;
register unsigned char *src; /* Points to current character
* in cmd. */
char termChar; /* Return when this character is found
* (either ']' or '\0'). Zero means
* that newlines terminate commands. */
int result; /* Return value. */
register Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *he;
Command *c;
unsigned char *dummy; /* Make termPtr point here if it was
* originally NULL. */
unsigned char *cmdStart; /* Points to first non-blank char. in
* command (used in calling trace
* procedures). */
unsigned char *ellipsis = (unsigned char*) "";
/* Used in setting errorInfo variable;
* set to "..." to indicate that not
* all of offending command is included
* in errorInfo. "" means that the
* command is all there. */
register Trace *tracePtr;
/*
* Initialize the result to an empty string and clear out any
* error information. This makes sure that we return an empty
* result if there are no commands in the command string.
*/
Tcl_FreeResult((Tcl_Interp *) iPtr);
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
result = TCL_OK;
/*
* Check depth of nested calls to Tcl_Eval: if this gets too large,
* it's probably because of an infinite loop somewhere.
*/
iPtr->numLevels++;
if (iPtr->numLevels > MAX_NESTING_DEPTH) {
iPtr->numLevels--;
iPtr->result = (unsigned char*) "too many nested calls to Tcl_Eval (infinite loop?)";
return TCL_ERROR;
}
/*
* Initialize the area in which command copies will be assembled.
*/
pv.buffer = copyStorage;
pv.end = copyStorage + NUM_CHARS - 1;
pv.expandProc = TclExpandParseValue;
pv.clientData = (void*) 0;
src = cmd;
if (flags & TCL_BRACKET_TERM) {
termChar = ']';
} else {
termChar = 0;
}
if (termPtr == 0) {
termPtr = &dummy;
}
*termPtr = src;
cmdStart = src;
/*
* There can be many sub-commands (separated by semi-colons or
* newlines) in one command string. This outer loop iterates over
* individual commands.
*/
while (*src != termChar) {
iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET);
/*
* Skim off leading white space and semi-colons, and skip
* comments.
*/
while (1) {
switch (*src) {
case '\t':
case '\v':
case '\f':
case '\r':
case '\n':
case ' ':
case ':':
++src;
continue;
}
break;
}
if (*src == '#') {
for (src++; *src != 0; src++) {
if ((*src == '\n') && (src[-1] != '\\')) {
src++;
break;
}
}
continue;
}
cmdStart = src;
/*
* Parse the words of the command, generating the argc and
* argv for the command procedure. May have to call
* TclParseWords several times, expanding the argv array
* between calls.
*/
pv.next = oldBuffer = pv.buffer;
argc = 0;
while (1) {
int newArgs, maxArgs;
unsigned char **newArgv;
int i;
/*
* Note: the "- 2" below guarantees that we won't use the
* last two argv slots here. One is for a NULL pointer to
* mark the end of the list, and the other is to leave room
* for inserting the command name "unknown" as the first
* argument (see below).
*/
maxArgs = argSize - argc - 2;
result = TclParseWords((Tcl_Interp *) iPtr, src, flags,
maxArgs, termPtr, &newArgs, &argv[argc], &pv);
src = *termPtr;
if (result != TCL_OK) {
ellipsis = (unsigned char*) "...";
goto done;
}
/*
* Careful! Buffer space may have gotten reallocated while
* parsing words. If this happened, be sure to update all
* of the older argv pointers to refer to the new space.
*/
if (oldBuffer != pv.buffer) {
int i;
for (i = 0; i < argc; i++) {
argv[i] = pv.buffer + (argv[i] - oldBuffer);
}
oldBuffer = pv.buffer;
}
argc += newArgs;
if (newArgs < maxArgs) {
argv[argc] = 0;
break;
}
/*
* Args didn't all fit in the current array. Make it bigger.
*/
argSize *= 2;
newArgv = (unsigned char**) mem_alloc (iPtr->pool,
(unsigned) argSize * sizeof(char *));
for (i = 0; i < argc; i++) {
newArgv[i] = argv[i];
}
if (argv != argStorage) {
mem_free (argv);
}
argv = newArgv;
}
/*
* If this is an empty command (or if we're just parsing
* commands without evaluating them), then just skip to the
* next command.
*/
if ((argc == 0) || iPtr->noEval) {
continue;
}
argv[argc] = 0;
/*
* Save information for the history module, if needed.
*/
if (flags & TCL_RECORD_BOUNDS) {
iPtr->evalFirst = cmdStart;
iPtr->evalLast = src-1;
}
/*
* Find the procedure to execute this command. If there isn't
* one, then see if there is a command "unknown". If so,
* invoke it instead, passing it the words of the original
* command as arguments.
*/
he = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]);
if (he == 0) {
int i;
he = Tcl_FindHashEntry(&iPtr->commandTable, (unsigned char*) "unknown");
if (he == 0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "invalid command name: \"",
argv[0], "\"", 0);
result = TCL_ERROR;
goto done;
}
for (i = argc; i >= 0; i--) {
argv[i+1] = argv[i];
}
argv[0] = (unsigned char*) "unknown";
argc++;
}
c = (Command *) Tcl_GetHashValue(he);
/*
* Call trace procedures, if any.
*/
for (tracePtr = iPtr->tracePtr; tracePtr != 0;
tracePtr = tracePtr->nextPtr) {
char saved;
if (tracePtr->level < iPtr->numLevels) {
continue;
}
saved = *src;
*src = 0;
(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
cmdStart, c->proc, c->clientData, argc, argv);
*src = saved;
}
/*
* At long last, invoke the command procedure. Reset the
* result to its default empty value first (it could have
* gotten changed by earlier commands in the same command
* string).
*/
iPtr->cmdCount++;
Tcl_FreeResult ((Tcl_Interp*) iPtr);
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
result = (*c->proc)(c->clientData, interp, argc, argv);
if (result != TCL_OK) {
break;
}
}
/*
* Free up any extra resources that were allocated.
*/
done:
if (pv.buffer != copyStorage) {
mem_free (pv.buffer);
}
if (argv != argStorage) {
mem_free (argv);
}
iPtr->numLevels--;
if (iPtr->numLevels == 0) {
if (result == TCL_RETURN) {
result = TCL_OK;
}
if ((result != TCL_OK) && (result != TCL_ERROR)) {
Tcl_ResetResult(interp);
if (result == TCL_BREAK) {
iPtr->result = (unsigned char*) "invoked \"break\" outside of a loop";
} else if (result == TCL_CONTINUE) {
iPtr->result = (unsigned char*) "invoked \"continue\" outside of a loop";
} else {
iPtr->result = iPtr->resultSpace;
snprintf(iPtr->resultSpace, TCL_RESULT_SIZE, "command returned bad code: %d",
result);
}
result = TCL_ERROR;
}
if (iPtr->flags & DELETED) {
Tcl_DeleteInterp(interp);
}
}
/*
* If an error occurred, record information about what was being
* executed when the error occurred.
*/
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
int numChars;
register unsigned char *p;
/*
* Compute the line number where the error occurred.
*/
iPtr->errorLine = 1;
for (p = cmd; p != cmdStart; p++) {
if (*p == '\n') {
iPtr->errorLine++;
}
}
for ( ; isspace(*p) || (*p == ';'); p++) {
if (*p == '\n') {
iPtr->errorLine++;
}
}
/*
* Figure out how much of the command to print in the error
* message (up to a certain number of characters, or up to
* the first new-line).
*/
numChars = src - cmdStart;
if (numChars > (NUM_CHARS-50)) {
numChars = NUM_CHARS-50;
ellipsis = (unsigned char*) " ...";
}
if (!(iPtr->flags & ERR_IN_PROGRESS)) {
snprintf(copyStorage, sizeof (copyStorage),
"\n while executing\n\"%.*s%s\"",
numChars, cmdStart, ellipsis);
} else {
snprintf(copyStorage, sizeof (copyStorage),
"\n invoked from within\n\"%.*s%s\"",
numChars, cmdStart, ellipsis);
}
Tcl_AddErrorInfo(interp, copyStorage);
iPtr->flags &= ~ERR_ALREADY_LOGGED;
} else {
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
return result;
}
