Merge commit '1741f1b6324ead16eb1eeaa16e1f18cf0a2abb4f' as 'tk8.6'

1 files changed, 964 insertions, 0 deletions

diff --git a/tk8.6/generic/tkConsole.c b/tk8.6/generic/tkConsole.c
new file mode 100644
index 0000000..8bfbe9b
--- /dev/null
+++ b/tk8.6/generic/tkConsole.c
@@ -0,0 +1,964 @@
+/*
+ * 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.
+ */
+
+#include "tkInt.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(ClientData instanceData, Tcl_Interp *interp);
+static void	ConsoleDeleteProc(ClientData clientData);
+static void	ConsoleEventProc(ClientData clientData, XEvent *eventPtr);
+static int	ConsoleHandle(ClientData instanceData, int direction,
+		    ClientData *handlePtr);
+static int	ConsoleInput(ClientData instanceData, char *buf, int toRead,
+		    int *errorCode);
+static int	ConsoleObjCmd(ClientData clientData, Tcl_Interp *interp,
+		    int objc, Tcl_Obj *const objv[]);
+static int	ConsoleOutput(ClientData instanceData, const char *buf,
+		    int toWrite, int *errorCode);
+static void	ConsoleWatch(ClientData instanceData, int mask);
+static void	DeleteConsoleInterp(ClientData clientData);
+static void	InterpDeleteProc(ClientData clientData, Tcl_Interp *interp);
+static int	InterpreterObjCmd(ClientData clientData, Tcl_Interp *interp,
+		    int objc, Tcl_Obj *const objv[]);
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static const 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 */
+    NULL
+};
+
+#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(
+    int type)
+{
+    DWORD handleId;		/* Standard handle to retrieve. */
+    DCB dcb;
+    DWORD consoleParams;
+    DWORD fileType;
+    HANDLE handle;
+
+    switch (type) {
+    case TCL_STDIN:
+	handleId = STD_INPUT_HANDLE;
+	break;
+    case TCL_STDOUT:
+	handleId = STD_OUTPUT_HANDLE;
+	break;
+    case TCL_STDERR:
+	handleId = STD_ERROR_HANDLE;
+	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(
+    Tcl_Interp *interp)
+{
+    static Tcl_ThreadDataKey consoleInitKey;
+    int *consoleInitPtr, doIn, doOut, doErr;
+    ConsoleInfo *info;
+    Tcl_Channel consoleChannel;
+
+    /*
+     * Ensure that we are getting a compatible version of Tcl.
+     */
+
+    if (Tcl_InitStubs(interp, "8.6", 0) == 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 = ckalloc(sizeof(ConsoleInfo));
+    info->consoleInterp = NULL;
+    info->interp = NULL;
+    info->refCount = 0;
+
+    if (doIn) {
+	ChannelData *data = ckalloc(sizeof(ChannelData));
+
+	data->info = info;
+	data->info->refCount++;
+	data->type = TCL_STDIN;
+	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
+		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 = ckalloc(sizeof(ChannelData));
+
+	data->info = info;
+	data->info->refCount++;
+	data->type = TCL_STDOUT;
+	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
+		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 = ckalloc(sizeof(ChannelData));
+
+	data->info = info;
+	data->info->refCount++;
+	data->type = TCL_STDERR;
+	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
+		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(
+    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;
+
+    /* 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 = 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 = ckalloc(sizeof(ConsoleInfo));
+	info->refCount = 0;
+    }
+
+    info->consoleInterp = consoleInterp;
+    info->interp = interp;
+
+    Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
+    info->refCount++;
+    Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
+
+    /*
+     * Add console commands to the interp
+     */
+
+    token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, 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,
+	    info, NULL);
+
+    mainWindow = Tk_MainWindow(interp);
+    if (mainWindow) {
+	Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
+		ConsoleEventProc, info);
+	info->refCount++;
+    }
+
+    Tcl_Preserve(consoleInterp);
+    result = Tcl_EvalEx(consoleInterp, "source $tk_library/console.tcl",
+	    -1, TCL_EVAL_GLOBAL);
+    if (result == TCL_ERROR) {
+	Tcl_SetReturnOptions(interp,
+		Tcl_GetReturnOptions(consoleInterp, result));
+	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
+    }
+    Tcl_Release(consoleInterp);
+    if (result == TCL_ERROR) {
+	Tcl_DeleteCommandFromToken(interp, token);
+	mainWindow = Tk_MainWindow(interp);
+	if (mainWindow) {
+	    Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
+		    ConsoleEventProc, info);
+	    if (--info->refCount <= 0) {
+		ckfree(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(
+    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_DString ds;
+	    Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8");
+
+	    /*
+	     * Not checking for utf8 == NULL.  Did not check for TCL_ERROR
+	     * from Tcl_SetChannelOption() in Tk_InitConsoleChannels() either.
+	     * Assumption is utf-8 Tcl_Encoding is reliably present.
+	     */
+
+	    const char *bytes
+		    = Tcl_ExternalToUtfDString(utf8, buf, toWrite, &ds);
+	    int numBytes = Tcl_DStringLength(&ds);
+	    Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);
+
+	    Tcl_FreeEncoding(utf8);
+
+	    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(bytes, numBytes));
+
+	    Tcl_DStringFree(&ds);
+	    Tcl_IncrRefCount(cmd);
+	    Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
+	    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(
+    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(
+    ClientData instanceData,	/* Unused. */
+    Tcl_Interp *interp)		/* Unused. */
+{
+    ChannelData *data = instanceData;
+    ConsoleInfo *info = data->info;
+
+    if (info) {
+	if (--info->refCount <= 0) {
+	    /*
+	     * Assuming the Tcl_Interp * fields must already be NULL.
+	     */
+
+	    ckfree(info);
+	}
+    }
+    ckfree(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(
+    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(
+    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 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 = clientData;
+    Tcl_Interp *consoleInterp = info->consoleInterp;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+	    sizeof(char *), "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;
+    default:
+	CLANG_ASSERT(0);
+    }
+
+    Tcl_IncrRefCount(cmd);
+    if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
+	Tcl_Preserve(consoleInterp);
+	result = Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
+	Tcl_SetReturnOptions(interp,
+		Tcl_GetReturnOptions(consoleInterp, result));
+	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
+	Tcl_Release(consoleInterp);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"no active console interp", -1));
+	Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NONE", 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 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_GetIndexFromObjStruct(interp, objv[1], options,
+	    sizeof(char *), "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_SetObjResult(interp, Tcl_NewStringObj(
+		"no active master interp", -1));
+	Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL);
+	return TCL_ERROR;
+    }
+
+    Tcl_Preserve(otherInterp);
+    switch ((enum option) index) {
+    case OTHER_EVAL:
+   	result = Tcl_EvalObjEx(otherInterp, objv[2], TCL_EVAL_GLOBAL);
+
+	/*
+	 * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteConsoleInterp --
+ *
+ *	Thread exit handler to destroy a console interp when the thread it
+ *	lives in gets torn down.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteConsoleInterp(
+    ClientData clientData)
+{
+    Tcl_Interp *interp = clientData;
+
+    Tcl_DeleteInterp(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpDeleteProc --
+ *
+ *	React when the interp in which the console is displayed is deleted for
+ *	any reason.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InterpDeleteProc(
+    ClientData clientData,
+    Tcl_Interp *interp)
+{
+    ConsoleInfo *info = clientData;
+
+    if (info->consoleInterp == interp) {
+	Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, info->consoleInterp);
+	info->consoleInterp = NULL;
+    }
+    if (--info->refCount <= 0) {
+	ckfree(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 it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleDeleteProc(
+    ClientData clientData)
+{
+    ConsoleInfo *info = clientData;
+
+    if (info->consoleInterp) {
+	Tcl_DeleteInterp(info->consoleInterp);
+    }
+    if (--info->refCount <= 0) {
+	ckfree(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 clientData,
+    XEvent *eventPtr)
+{
+    if (eventPtr->type == DestroyNotify) {
+	ConsoleInfo *info = clientData;
+	Tcl_Interp *consoleInterp = info->consoleInterp;
+
+	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
+	    Tcl_EvalEx(consoleInterp, "tk::ConsoleExit", -1, TCL_EVAL_GLOBAL);
+	}
+
+	if (--info->refCount <= 0) {
+	    ckfree(info);
+	}
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */