int TclTextInterp::evalString(const char *s) {
#if defined(VMD_NANOHUB)
if (Tcl_Eval(interp, s) != TCL_OK) {
#else
if (Tcl_RecordAndEval(interp, s, 0) != TCL_OK) {
#endif
// Don't print error message if there's nothing to show.
if (strlen(Tcl_GetStringResult(interp)))
msgErr << Tcl_GetStringResult(interp) << sendmsg;
return FALSE;
}
return TRUE;
}
void TclTextInterp::setString(const char *name, const char *val) {
if (interp)
Tcl_SetVar(interp, name, val,
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
}
void TclTextInterp::setMap(const char *name, const char *key,
const char *val) {
if (interp)
Tcl_SetVar2(interp, name, key, val,
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
}
// There's a fair amount of code duplication between doEvent and evalFile,
// maybe these could be combined somehow, say by having TclTextInterp keep
// track of its Tcl_Channel objects.
//
// Side note: Reading line-by-line gives different Tcl semantics than
// just calling Tcl_EvalFile. Shell commands (e.g., stty) are properly
// parsed when read line-by-line and passed to Tcl_RecordAndEval, but are
// unrecognized when contained in a file read by Tcl_EvalFile. I would
// consider this a bug.
int TclTextInterp::evalFile(const char *fname) {
Tcl_Channel inchannel = Tcl_OpenFileChannel(interp, fname, "r", 0644);
Tcl_Channel outchannel = Tcl_GetStdChannel(TCL_STDOUT);
if (inchannel == NULL) {
msgErr << "Error opening file " << fname << sendmsg;
msgErr << Tcl_GetStringResult(interp) << sendmsg;
return 1;
}
Tcl_Obj *cmdPtr = Tcl_NewObj();
Tcl_IncrRefCount(cmdPtr);
int length = 0;
while ((length = Tcl_GetsObj(inchannel, cmdPtr)) >= 0) {
Tcl_AppendToObj(cmdPtr, "\n", 1);
char *stringrep = Tcl_GetStringFromObj(cmdPtr, NULL);
if (!Tcl_CommandComplete(stringrep)) {
continue;
}
// check if "exit" was called
if (app->exitFlag) break;
#if defined(VMD_NANOHUB)
Tcl_EvalObjEx(interp, cmdPtr, 0);
#else
Tcl_RecordAndEvalObj(interp, cmdPtr, 0);
#endif
#if TCL_MINOR_VERSION >= 4
Tcl_DecrRefCount(cmdPtr);
cmdPtr = Tcl_NewObj();
Tcl_IncrRefCount(cmdPtr);
#else
// XXX this crashes Tcl 8.5.[46] with an internal panic
Tcl_SetObjLength(cmdPtr, 0);
#endif
// XXX this makes sure the display is updated
// after each line read from the file or pipe
// So, this is also where we'd optimise reading multiple
// lines at once
//
// In VR modes (CAVE, FreeVR, VR Juggler) the draw method will
// not be called from app->display_update(), so multiple lines
// of input could be combined in one frame, if possible
app->display_update();
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
if (length > 0) {
vmdcon_append(VMDCON_ALWAYS, bytes,length);
vmdcon_append(VMDCON_ALWAYS, "\n", 1);
}
vmdcon_purge();
#else
if (length > 0) {
#if TCL_MINOR_VERSION >= 4
Tcl_WriteChars(outchannel, bytes, length);
Tcl_WriteChars(outchannel, "\n", 1);
#else
Tcl_Write(outchannel, bytes, length);
Tcl_Write(outchannel, "\n", 1);
#endif
}
Tcl_Flush(outchannel);
#endif
}
Tcl_Close(interp, inchannel);
Tcl_DecrRefCount(cmdPtr);
return 0;
}
void TclTextInterp::doEvent() {
if (!done_waiting())
return;
// no recursive calls to TclEvalObj; this prevents
// display update ui from messing up Tcl.
if (callLevel)
return;
Tcl_Channel inChannel = Tcl_GetStdChannel(TCL_STDIN);
Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (needPrompt && consoleisatty) {
#if TCL_MINOR_VERSION >= 4
if (gotPartial) {
Tcl_WriteChars(outChannel, "? ", -1);
} else {
Tcl_WriteChars(outChannel, VMD_CMD_PROMPT, -1);
}
#else
if (gotPartial) {
Tcl_Write(outChannel, "? ", -1);
} else {
Tcl_Write(outChannel, VMD_CMD_PROMPT, -1);
}
#endif
#if defined(VMDTKCON)
vmdcon_purge();
#endif
Tcl_Flush(outChannel);
needPrompt = 0;
}
#if defined(VMD_NANOHUB)
return;
#endif
//
// MPI builds of VMD cannot try to read any command input from the
// console because it creates shutdown problems, at least with MPICH.
// File-based command input is fine however.
//
// For the time being, the Android builds won't attempt to get any
// console input. Any input we're going to get is going to come via
// some means other than stdin, such as a network socket, text box, etc.
//
if (ignorestdin)
return;
if (!vmd_check_stdin())
return;
//
// event loop based on tclMain.c
//
// According to the Tcl docs, GetsObj returns -1 on error or EOF.
int length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
if (Tcl_Eof(inChannel)) {
// exit if we're not a tty, or if eofexit is set
if ((!consoleisatty) || app->get_eofexit())
app->VMDexit("", 0, 0);
} else {
msgErr << "Error reading Tcl input: " << Tcl_ErrnoMsg(Tcl_GetErrno())
<< sendmsg;
}
return;
}
needPrompt = 1;
// add the newline removed by Tcl_GetsObj
Tcl_AppendToObj(commandPtr, "\n", 1);
char *stringrep = Tcl_GetStringFromObj(commandPtr, NULL);
if (!Tcl_CommandComplete(stringrep)) {
gotPartial = 1;
return;
}
gotPartial = 0;
callLevel++;
#if defined(VMD_NANOHUB)
Tcl_EvalObjEx(interp, commandPtr, 0);
#else
Tcl_RecordAndEvalObj(interp, commandPtr, 0);
#endif
callLevel--;
#if TCL_MINOR_VERSION >= 4
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
#else
// XXX this crashes Tcl 8.5.[46] with an internal panic
Tcl_SetObjLength(commandPtr, 0);
#endif
// if ok, send to stdout; if not, send to stderr
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
if (length > 0) {
vmdcon_append(VMDCON_ALWAYS, bytes,length);
vmdcon_append(VMDCON_ALWAYS, "\n", 1);
}
vmdcon_purge();
#else
if (length > 0) {
#if TCL_MINOR_VERSION >= 4
Tcl_WriteChars(outChannel, bytes, length);
Tcl_WriteChars(outChannel, "\n", 1);
#else
Tcl_Write(outChannel, bytes, length);
Tcl_Write(outChannel, "\n", 1);
#endif
}
Tcl_Flush(outChannel);
#endif
}
int Execute_TclFile( Tcl_Interp *interp,
char *filename)
{
FILE *infile;
int gotPartial = 0;
int result = 0;
EM_RetVal em_result = EM_OK;
char *cmd;
Tcl_DString cmdbuf;
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_START, LOC, _proc_Execute_TclFile, NULL);
#endif
/**
** If there isn't a line buffer allocated so far, do it now
**/
if( line == NULL) {
if( NULL == (line = (char*) module_malloc(LINELENGTH * sizeof(char)))) {
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
}
/**
** If we're supposed to be interpreting from stdin, set infile
** equal to stdin, otherwise, open the file and interpret
**/
if( !strcmp( filename, _fil_stdin)) {
infile = stdin;
} else {
if( NULL == (infile = fopen( filename, "r"))) {
if( OK != ErrorLogger( ERR_OPEN, LOC, filename, "reading", NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
}
/**
** Allow access to which file is being loaded.
**/
linenum = 0;
Tcl_SetVar( interp, "ModulesCurrentModulefile", filename, 0);
Tcl_DStringInit( &cmdbuf);
while( 1) {
linenum++;
if( fgets(line, LINELENGTH, infile) == NULL) {
if( !gotPartial) {
break; /** while **/
}
line[0] = '\0';
}
/**
** Put the whole command on the command buffer
**/
cmd = Tcl_DStringAppend( &cmdbuf, line, (-1));
if( line[0] != 0 && !Tcl_CommandComplete(cmd)) {
gotPartial++;
continue;
}
/**
** Now evaluate the command and react on its result
** Reinitialize the command buffer
**/
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_DEBUG, LOC, " Evaluating '", cmd, "'", NULL);
#endif
result = Tcl_Eval( interp, cmd);
if( EM_ERROR == (em_result = ReturnValue(interp, result))) {
ErrorLogger( ERR_EXEC, LOC, cmd, NULL);
}
Tcl_DStringTrunc( &cmdbuf, 0);
#if WITH_DEBUGGING_UTIL_1
{
char buffer[ 80];
switch( result) {
case TCL_OK: strcpy( buffer, "TCL_OK");
break;
case TCL_ERROR: strcpy( buffer, "TCL_ERROR");
break;
case TCL_LEVEL0_RETURN:
strcpy( buffer, "TCL_LEVEL0_RETURN");
break;
}
ErrorLogger( NO_ERR_DEBUG, LOC, " Result: '", buffer, "'", NULL);
}
#endif
switch( result) {
case TCL_OK: gotPartial = 0;
continue; /** while **/
case TCL_ERROR: interp->errorLine = ((linenum-1)-gotPartial) +
interp->errorLine;
/* FALLTHROUGH */
case TCL_LEVEL0_RETURN:
break; /** switch **/
}
/**
** If the while loop hasn't been continued so far, it is to be broken
** now
**/
break; /** while **/
} /** while **/
/**
** Free up what has been used, close the input file and return the result
** of the last command to the caller
**/
Tcl_DStringFree( &cmdbuf);
if( EOF == fclose( infile))
if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_END, LOC, _proc_Execute_TclFile, NULL);
#endif
return( result);
} /** End of 'Execute_TclFile' **/
/* ARGSUSED */
static void
StdinProc(
ClientData clientData, /* The state of interactive cmd line */
int mask) /* Not used. */
{
char *cmd;
int code, count;
InteractiveState *isPtr = clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Interp *interp = isPtr->interp;
count = Tcl_Gets(chan, &isPtr->line);
if (count < 0 && !isPtr->gotPartial) {
if (isPtr->tty) {
Tcl_Exit(0);
} else {
Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
}
return;
}
Tcl_DStringAppend(&isPtr->command, Tcl_DStringValue(&isPtr->line), -1);
cmd = Tcl_DStringAppend(&isPtr->command, "\n", -1);
Tcl_DStringFree(&isPtr->line);
if (!Tcl_CommandComplete(cmd)) {
isPtr->gotPartial = 1;
goto prompt;
}
isPtr->gotPartial = 0;
/*
* Disable the stdin channel handler while evaluating the command;
* otherwise if the command re-enters the event loop we might process
* commands from stdin before the current command is finished. Among other
* things, this will trash the text of the command being evaluated.
*/
Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr);
code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
if (isPtr->input) {
Tcl_CreateChannelHandler(isPtr->input, TCL_READABLE, StdinProc, isPtr);
}
Tcl_DStringFree(&isPtr->command);
if (Tcl_GetStringResult(interp)[0] != '\0') {
if ((code != TCL_OK) || (isPtr->tty)) {
chan = Tcl_GetStdChannel((code != TCL_OK) ? TCL_STDERR : TCL_STDOUT);
if (chan) {
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
Tcl_WriteChars(chan, "\n", 1);
}
}
}
/*
* If a tty stdin is still around, output a prompt.
*/
prompt:
if (isPtr->tty && (isPtr->input != NULL)) {
Prompt(interp, isPtr);
}
Tcl_ResetResult(interp);
}
/* ARGSUSED */
static void
StdinProc(ClientData clientData, int mask)
{
static int gotPartial = 0;
char *cmd;
int code, count;
Tcl_Channel chan = (Tcl_Channel) clientData;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_Interp *interp = tsdPtr->interp;
count = Tcl_Gets(chan, &tsdPtr->line);
if (count < 0) {
if (!gotPartial) {
if (tsdPtr->tty) {
Tcl_Exit(0);
} else {
Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
}
return;
}
}
(void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
&tsdPtr->line), -1);
cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
Tcl_DStringFree(&tsdPtr->line);
if (!Tcl_CommandComplete(cmd)) {
gotPartial = 1;
goto prompt;
}
gotPartial = 0;
/*
* Disable the stdin channel handler while evaluating the command;
* otherwise if the command re-enters the event loop we might
* process commands from stdin before the current command is
* finished. Among other things, this will trash the text of the
* command being evaluated.
*/
Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
chan = Tcl_GetStdChannel(TCL_STDIN);
if (chan) {
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
(ClientData) chan);
}
Tcl_DStringFree(&tsdPtr->command);
if (Tcl_GetStringResult(interp)[0] != '\0') {
if ((code != TCL_OK) || (tsdPtr->tty)) {
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan) {
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
Tcl_WriteChars(chan, "\n", 1);
}
}
}
/*
* Output a prompt.
*/
prompt:
if (tsdPtr->tty) {
Prompt(interp, gotPartial);
}
Tcl_ResetResult(interp);
}
