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;
}
