static int InterpreterObjCmd( ClientData clientData, /* */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { int index, result = TCL_OK; static const char *const options[] = {"eval", "record", NULL}; enum option {OTHER_EVAL, OTHER_RECORD}; ConsoleInfo *info = clientData; Tcl_Interp *otherInterp = info->interp; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option arg"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) { Tcl_AppendResult(interp, "no active master interp", NULL); return TCL_ERROR; } Tcl_Preserve(otherInterp); switch ((enum option) index) { case OTHER_EVAL: result = Tcl_GlobalEvalObj(otherInterp, objv[2]); /* * TODO: Should exceptions be filtered here? */ Tcl_SetReturnOptions(interp, Tcl_GetReturnOptions(otherInterp, result)); Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp)); break; case OTHER_RECORD: Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL); /* * By not setting result, we discard any exceptions or errors here and * always return TCL_OK. All the caller wants is the interp result to * display, whether that's result or error message. */ Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp)); break; } Tcl_Release(otherInterp); return result; }
static int ConsoleOutput( ClientData instanceData, /* Indicates which device to use. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { ChannelData *data = instanceData; ConsoleInfo *info = data->info; *errorCode = 0; Tcl_SetErrno(0); if (info) { Tcl_Interp *consoleInterp = info->consoleInterp; if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1); if (data->type == TCL_STDERR) { Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("stderr", -1)); } else { Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("stdout", -1)); } Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj(buf, toWrite)); Tcl_IncrRefCount(cmd); Tcl_GlobalEvalObj(consoleInterp, cmd); Tcl_DecrRefCount(cmd); } } return toWrite; }
int ComObject::eval (TclObject script, TclObject *pResult) { int completionCode = #if TCL_MINOR_VERSION >= 1 Tcl_EvalObjEx(m_interp, script, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); #else Tcl_GlobalEvalObj(m_interp, script); #endif if (pResult != 0) { *pResult = Tcl_GetObjResult(m_interp); } return completionCode; }
static int ConsoleObjCmd( ClientData clientData, /* Access to the console interp */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { int index, result; static const char *const options[] = {"eval", "hide", "show", "title", NULL}; enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE}; Tcl_Obj *cmd = NULL; ConsoleInfo *info = (ConsoleInfo *) clientData; Tcl_Interp *consoleInterp = info->consoleInterp; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum option) index) { case CON_EVAL: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } cmd = objv[2]; break; case CON_HIDE: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } cmd = Tcl_NewStringObj("wm withdraw .", -1); break; case CON_SHOW: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } cmd = Tcl_NewStringObj("wm deiconify .", -1); break; case CON_TITLE: if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?title?"); return TCL_ERROR; } cmd = Tcl_NewStringObj("wm title .", -1); if (objc == 3) { Tcl_ListObjAppendElement(NULL, cmd, objv[2]); } break; } Tcl_IncrRefCount(cmd); if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { Tcl_Preserve(consoleInterp); result = Tcl_GlobalEvalObj(consoleInterp, cmd); Tcl_SetReturnOptions(interp, Tcl_GetReturnOptions(consoleInterp, result)); Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); Tcl_Release(consoleInterp); } else { Tcl_AppendResult(interp, "no active console interp", NULL); result = TCL_ERROR; } Tcl_DecrRefCount(cmd); return result; }