/*
* tkConsole.c --
*
* This file implements a Tcl console for systems that may not
* otherwise have access to a console. It uses the Text widget
* and provides special access via a console command.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tkConsole.c,v 1.18.2.6 2006/09/25 17:28:20 andreas_kupries Exp $
*
*/
#include "tk.h"
/*
* Each console is associated with an instance of the ConsoleInfo struct.
* It keeps track of what interp holds the Tk application that displays
* the console, and what interp is controlled by the interactions in that
* console. A refCount permits the struct to be shared as instance data
* by commands and by channels.
*/
typedef struct ConsoleInfo {
Tcl_Interp *consoleInterp; /* Interpreter displaying the console. */
Tcl_Interp *interp; /* Interpreter controlled by console. */
int refCount;
} ConsoleInfo;
/*
* Each console channel holds an instance of the ChannelData struct as
* its instance data. It contains ConsoleInfo, so the channel can work
* with the appropriate console window, and a type value to distinguish
* the stdout channel from the stderr channel.
*/
typedef struct ChannelData {
ConsoleInfo *info;
int type; /* TCL_STDOUT or TCL_STDERR */
} ChannelData;
/*
* Prototypes for local procedures defined in this file:
*/
static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
static int ConsoleHandle _ANSI_ARGS_((ClientData instandeData,
int direction, ClientData *handlePtr));
static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int ConsoleObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
CONST char *buf, int toWrite, int *errorCode));
static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
int mask));
static void DeleteConsoleInterp _ANSI_ARGS_((ClientData clientData));
static void InterpDeleteProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp));
static int InterpreterObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
/*
* This structure describes the channel type structure for file based IO:
*/
static Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
TCL_CHANNEL_VERSION_4, /* v4 channel */
ConsoleClose, /* Close proc. */
ConsoleInput, /* Input proc. */
ConsoleOutput, /* Output proc. */
NULL, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
ConsoleWatch, /* Watch for events on console. */
ConsoleHandle, /* Get a handle from the device. */
NULL, /* close2proc. */
NULL, /* Always non-blocking.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
NULL, /* wide seek proc */
NULL, /* thread action proc */
};
#ifdef __WIN32__
#include <windows.h>
/*
*----------------------------------------------------------------------
*
* ShouldUseConsoleChannel
*
* Check to see if console window should be used for a given
* standard channel
*
* Results:
* None.
*
* Side effects:
* Creates the console channel and installs it as the standard
* channels.
*
*----------------------------------------------------------------------
*/
static int ShouldUseConsoleChannel(type)
int type;
{
DWORD handleId; /* Standard handle to retrieve. */
DCB dcb;
DWORD consoleParams;
DWORD fileType;
int mode;
char *bufMode;
HANDLE handle;
switch (type) {
case TCL_STDIN:
handleId = STD_INPUT_HANDLE;
mode = TCL_READABLE;
bufMode = "line";
break;
case TCL_STDOUT:
handleId = STD_OUTPUT_HANDLE;
mode = TCL_WRITABLE;
bufMode = "line";
break;
case TCL_STDERR:
handleId = STD_ERROR_HANDLE;
mode = TCL_WRITABLE;
bufMode = "none";
break;
default:
return 0;
break;
}
handle = GetStdHandle(handleId);
/*
* Note that we need to check for 0 because Windows will return 0 if this
* is not a console mode application, even though this is not a valid
* handle.
*/
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
return 1;
}
/*
* Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
* to be a valid handle. See TclpGetDefaultStdChannel() for this change
* implemented. We didn't change it here because GetFileType() [below]
* will catch this with FILE_TYPE_UNKNOWN and appropriately return a
* value of 1, anyways.
*
* char dummyBuff[1];
* DWORD dummyWritten;
*
* if ((type == TCL_STDOUT)
* && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
* return 1;
* }
*/
fileType = GetFileType(handle);
/*
* If the file is a character device, we need to try to figure out
* whether it is a serial port, a console, or something else. We
* test for the console case first because this is more common.
*/
if (fileType == FILE_TYPE_CHAR) {
dcb.DCBlength = sizeof( DCB ) ;
if (!GetConsoleMode(handle, &consoleParams) &&
!GetCommState(handle, &dcb)) {
/*
* Don't use a CHAR type channel for stdio, otherwise Tk
* runs into trouble with the MS DevStudio debugger.
*/
return 1;
}
} else if (fileType == FILE_TYPE_UNKNOWN) {
return 1;
} else if (Tcl_GetStdChannel(type) == NULL) {
return 1;
}
return 0;
}
#else
/*
* Mac should always use a console channel, Unix should if it's trying to
*/
#define ShouldUseConsoleChannel(chan) (1)
#endif
/*
*----------------------------------------------------------------------
*
* Tk_InitConsoleChannels --
*
* Create the console channels and install them as the standard
* channels. All I/O will be discarded until Tk_CreateConsoleWindow
* is called to attach the console to a text widget.
*
* Results:
* None.
*
* Side effects:
* Creates the console channel and installs it as the standard
* channels.
*
*----------------------------------------------------------------------
*/
void
Tk_InitConsoleChannels(interp)
Tcl_Interp *interp;
{
static Tcl_ThreadDataKey consoleInitKey;
int *consoleInitPtr, doIn, doOut, doErr;
ConsoleInfo *info;
Tcl_Channel consoleChannel;
/*
* Ensure that we are getting the matching version of Tcl. This is
* really only an issue when Tk is loaded dynamically.
*/
if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
return;
}
consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
if (*consoleInitPtr) {
/* We've already initialized console channels in this thread. */
return;
}
*consoleInitPtr = 1;
doIn = ShouldUseConsoleChannel(TCL_STDIN);
doOut = ShouldUseConsoleChannel(TCL_STDOUT);
doErr = ShouldUseConsoleChannel(TCL_STDERR);
if (!(doIn || doOut || doErr)) {
/*
* No std channels should be tied to the console;
* Thus, no need to create the console
*/
return;
}
/*
* At least one std channel wants to be tied to the console,
* so create the interp for it to live in.
*/
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->consoleInterp = NULL;
info->interp = NULL;
info->refCount = 0;
if (doIn) {
ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
data->info = info;
data->info->refCount++;
data->type = TCL_STDIN;
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
(ClientData) data, TCL_READABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel,
"-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel,
"-buffering", "none");
Tcl_SetChannelOption(NULL, consoleChannel,
"-encoding", "utf-8");
}
Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
Tcl_RegisterChannel(NULL, consoleChannel);
}
if (doOut) {
ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
data->info = info;
data->info->refCount++;
data->type = TCL_STDOUT;
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
(ClientData) data, TCL_WRITABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel,
"-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel,
"-buffering", "none");
Tcl_SetChannelOption(NULL, consoleChannel,
"-encoding", "utf-8");
}
Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
Tcl_RegisterChannel(NULL, consoleChannel);
}
if (doErr) {
ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
data->info = info;
data->info->refCount++;
data->type = TCL_STDERR;
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
(ClientData) data, TCL_WRITABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel,
"-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel,
"-buffering", "none");
Tcl_SetChannelOption(NULL, consoleChannel,
"-encoding", "utf-8");
}
Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
Tcl_RegisterChannel(NULL, consoleChannel);
}
}
/*
*----------------------------------------------------------------------
*
* Tk_CreateConsoleWindow --
*
* Initialize the console. This code actually creates a new
* application and associated interpreter. This effectivly hides
* the implementation from the main application.
*
* Results:
* None.
*
* Side effects:
* A new console it created.
*
*----------------------------------------------------------------------
*/
int
Tk_CreateConsoleWindow(interp)
Tcl_Interp *interp; /* Interpreter to use for prompting. */
{
Tcl_Channel chan;
ConsoleInfo *info;
Tk_Window mainWindow;
Tcl_Command token;
int result = TCL_OK;
int haveConsoleChannel = 1;
#ifdef MAC_TCL
static const char *initCmd = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
#else
static const char *initCmd = "source $tk_library/console.tcl";
#endif
/* Init an interp with Tcl and Tk */
Tcl_Interp *consoleInterp = Tcl_CreateInterp();
if (Tcl_Init(consoleInterp) != TCL_OK) {
goto error;
}
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
/*
* Fetch the instance data from whatever std channel is a
* console channel. If none, create fresh instance data.
*/
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
} else {
haveConsoleChannel = 0;
}
if (haveConsoleChannel) {
ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
info = data->info;
if (info->consoleInterp) {
/* New ConsoleInfo for a new console window */
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
/* Update any console channels to make use of the new console */
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
}
} else {
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
}
info->consoleInterp = consoleInterp;
info->interp = interp;
Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info);
info->refCount++;
Tcl_CreateThreadExitHandler(DeleteConsoleInterp,
(ClientData) consoleInterp);
/*
* Add console commands to the interp
*/
token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd,
(ClientData) info, ConsoleDeleteProc);
info->refCount++;
/*
* We don't have to count the ref held by the [consoleinterp] command
* in the consoleInterp. The ref held by the consoleInterp delete
* handler takes care of us.
*/
Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
(ClientData) info, NULL);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, (ClientData) info);
info->refCount++;
}
Tcl_Preserve((ClientData) consoleInterp);
result = Tcl_GlobalEval(consoleInterp, initCmd);
if (result == TCL_ERROR) {
Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
Tcl_ResetResult(interp);
if (objPtr) {
Tcl_SetObjErrorCode(interp, objPtr);
}
objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
if (objPtr) {
int numBytes;
CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_AddObjErrorInfo(interp, message, numBytes);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
}
Tcl_Release((ClientData) consoleInterp);
if (result == TCL_ERROR) {
Tcl_DeleteCommandFromToken(interp, token);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, (ClientData) info);
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
goto error;
}
return TCL_OK;
error:
Tcl_AddErrorInfo(interp, "\n (creating console window)");
if (!Tcl_InterpDeleted(consoleInterp)) {
Tcl_DeleteInterp(consoleInterp);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* ConsoleOutput--
*
* Writes the given output on the IO channel. Returns count of how
* many characters were actually written, and an error indication.
*
* Results:
* A count of how many characters were written is returned and an
* error indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
*
*----------------------------------------------------------------------
*/
static int
ConsoleOutput(instanceData, buf, toWrite, errorCode)
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 = (ChannelData *)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;
}
/*
*----------------------------------------------------------------------
*
* ConsoleInput --
*
* Read input from the console. Not currently implemented.
*
* Results:
* Always returns EOF.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
ConsoleInput(instanceData, buf, bufSize, errorCode)
ClientData instanceData; /* Unused. */
char *buf; /* Where to store data read. */
int bufSize; /* How much space is available
* in the buffer? */
int *errorCode; /* Where to store error code. */
{
return 0; /* Always return EOF. */
}
/*
*----------------------------------------------------------------------
*
* ConsoleClose --
*
* Closes the IO channel.
*
* Results:
* Always returns 0 (success).
*
* Side effects:
* Frees the dummy file associated with the channel.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
ConsoleClose(instanceData, interp)
ClientData instanceData; /* Unused. */
Tcl_Interp *interp; /* Unused. */
{
ChannelData *data = (ChannelData *)instanceData;
ConsoleInfo *info = data->info;
if (info) {
if (--info->refCount <= 0) {
/* Assuming the Tcl_Interp * fields must already be NULL */
ckfree((char *) info);
}
}
ckfree((char *) data);
return 0;
}
/*
*----------------------------------------------------------------------
*
* ConsoleWatch --
*
* Called by the notifier to set up the console device so that
* events will be noticed. Since there are no events on the
* console, this routine just returns without doing anything.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static void
ConsoleWatch(instanceData, mask)
ClientData instanceData; /* Device ID for the channel. */
int mask; /* OR-ed combination of
* TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION, for the events
* we are interested in. */
{
}
/*
*----------------------------------------------------------------------
*
* ConsoleHandle --
*
* Invoked by the generic IO layer to get a handle from a channel.
* Because console channels are not devices, this function always
* fails.
*
* Results:
* Always returns TCL_ERROR.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
ConsoleHandle(instanceData, direction, handlePtr)
ClientData instanceData; /* Device ID for the channel. */
int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
* which direction of the channel is being
* requested. */
ClientData *handlePtr; /* Where to store handle */
{
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* ConsoleObjCmd --
*
* The console command implements a Tcl interface to the various console
* options.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ConsoleObjCmd(clientData, interp, objc, objv)
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 *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((ClientData) consoleInterp);
result = Tcl_GlobalEvalObj(consoleInterp, cmd);
if (result == TCL_ERROR) {
Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode",
NULL, TCL_GLOBAL_ONLY);
Tcl_ResetResult(interp);
if (objPtr) {
Tcl_SetObjErrorCode(interp, objPtr);
}
objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo",
NULL, TCL_GLOBAL_ONLY);
if (objPtr) {
int numBytes;
CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_AddObjErrorInfo(interp, message, numBytes);
}
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
Tcl_Release((ClientData) consoleInterp);
} else {
Tcl_AppendResult(interp, "no active console interp", NULL);
result = TCL_ERROR;
}
Tcl_DecrRefCount(cmd);
return result;
}
/*
*----------------------------------------------------------------------
*
* InterpreterObjCmd --
*
* This command allows the console interp to communicate with the
* main interpreter.
*
* Results:
* A standard Tcl result.
*
*----------------------------------------------------------------------
*/
static int
InterpreterObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used */
Tcl_Interp *interp; /* Current interpreter */
int objc; /* Number of arguments */
Tcl_Obj *CONST objv[]; /* Argument objects */
{
int index, result = TCL_OK;
static CONST char *options[] = {"eval", "record", NULL};
enum option {OTHER_EVAL, OTHER_RECORD};
ConsoleInfo *info = (ConsoleInfo *) 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((ClientData) otherInterp);
switch ((enum option) index) {
case OTHER_EVAL:
result = Tcl_GlobalEvalObj(otherInterp, objv[2]);
/*
* TODO: Should exceptions be filtered here?
*/
if (result == TCL_ERROR) {
Tcl_Obj *objPtr = Tcl_GetVar2Ex(otherInterp, "errorCode",
NULL, TCL_GLOBAL_ONLY);
Tcl_ResetResult(interp);
if (objPtr) {
Tcl_SetObjErrorCode(interp, objPtr);
}
objPtr = Tcl_GetVar2Ex(otherInterp, "errorInfo",
NULL, TCL_GLOBAL_ONLY);
if (objPtr) {
int numBytes;
CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_AddObjErrorInfo(interp, message, numBytes);
}
}
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((ClientData) otherInterp);
return result;
}
/*
*----------------------------------------------------------------------
*
* DeleteConsoleInterp --
*
* Thread exit handler to destroy a console interp when the
* thread it lives in gets torn down.
*
*----------------------------------------------------------------------
*/
static void
DeleteConsoleInterp(clientData)
ClientData clientData;
{
Tcl_Interp *interp = (Tcl_Interp *)clientData;
Tcl_DeleteInterp(interp);
}
/*
*----------------------------------------------------------------------
*
* InterpDeleteProc --
*
* React when the interp in which the console is displayed is deleted
* for any reason.
*
* Results:
* None.
*/
static void
InterpDeleteProc(clientData, interp)
ClientData clientData;
Tcl_Interp *interp;
{
ConsoleInfo *info = (ConsoleInfo *) clientData;
if(info->consoleInterp == interp) {
Tcl_DeleteThreadExitHandler(DeleteConsoleInterp,
(ClientData) info-> consoleInterp);
info->consoleInterp = NULL;
}
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
/*
*----------------------------------------------------------------------
*
* ConsoleDeleteProc --
*
* If the console command is deleted we destroy the console window and
* all associated data structures.
* Results:
* None.
*
* Side effects:
* A new console is created.
*
*----------------------------------------------------------------------
*/
static void
ConsoleDeleteProc(clientData)
ClientData clientData;
{
ConsoleInfo *info = (ConsoleInfo *) clientData;
if (info->consoleInterp) {
Tcl_DeleteInterp(info->consoleInterp);
}
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
/*
*----------------------------------------------------------------------
*
* ConsoleEventProc --
*
* This event function is registered on the main window of the slave
* interpreter. If the user or a running script causes the main window to
* be destroyed, then we need to inform the console interpreter by
* invoking "::tk::ConsoleExit".
* Results:
* None.
*
* Side effects:
* Invokes the "::tk::ConsoleExit" command in the console interp.
*
*----------------------------------------------------------------------
*/
static void
ConsoleEventProc(clientData, eventPtr)
ClientData clientData;
XEvent *eventPtr;
{
if (eventPtr->type == DestroyNotify) {
ConsoleInfo *info = (ConsoleInfo *) clientData;
Tcl_Interp *consoleInterp = info->consoleInterp;
if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
}
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
}