static PyObject * Tkapp_Record(PyObject *self, PyObject *args) { char *script; PyObject *res = NULL; int err; if (!PyArg_ParseTuple(args, "s", &script)) return NULL; ENTER_TCL err = Tcl_RecordAndEval(Tkapp_Interp(self), script, TCL_NO_EVAL); ENTER_OVERLAP if (err == TCL_ERROR) res = Tkinter_Error(self); else res = PyString_FromString(Tkapp_Result(self)); LEAVE_OVERLAP_TCL return res; }
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; }
/* 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); }