* generic/tkInt.h: Thread safety for the data structures of

        * generic/tkConsole.c:  the wish [console].  [Bug 1188340].

3 files changed, 461 insertions, 321 deletions

diff --git a/ChangeLog b/ChangeLog
index 1967726..44149b1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2006-06-05  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tkInt.h:	Thread safety for the data structures of 
+	* generic/tkConsole.c:	the wish [console].  [Bug 1188340].
+
 2006-06-01  Don Porter  <dgp@users.sourceforge.net>
 
         * generic/tkConsole.c:  Added Tcl_RegisterChannel() calls to bump
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index 1aaf2c9..d0ce932 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.c
@@ -10,70 +10,62 @@
  * 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.3 2006/06/01 18:21:41 dgp Exp $
+ * RCS: @(#) $Id: tkConsole.c,v 1.18.2.4 2006/06/05 18:06:47 dgp Exp $
+ *    
  */
 
 #include "tk.h"
-#include <string.h>
-
-#include "tkInt.h"
 
 /*
- * A data structure of the following type holds information for each console
- * which a handler (i.e. a Tcl command) has been defined for a particular
- * top-level window.
+ * 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 for the console. */
-    Tcl_Interp *interp;		/* Interpreter to send console commands. */
+    Tcl_Interp *consoleInterp;        /* Interpreter displaying the console. */
+    Tcl_Interp *interp;               /* Interpreter controlled by console. */
+    int refCount;
 } ConsoleInfo;
 
 /*
- * Each interpreter with a console attached stores a reference to the
- * interpreter's ConsoleInfo in the interpreter's AssocData store. The
- * alternative is to look the values up by examining the "console"
- * command and that is fragile. [Bug 1016385]
+ * 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.
  */
 
-#define TK_CONSOLE_INFO_KEY	"tk::ConsoleInfo"
-
-typedef struct ThreadSpecificData {
-    Tcl_Interp *gStdoutInterp;
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-static int consoleInitialized = 0;
+typedef struct ChannelData {
+    ConsoleInfo *info;
+    int type;			/* TCL_STDOUT or TCL_STDERR */
+} ChannelData;
 
 /* 
- * The Mutex below is used to lock access to the consoleIntialized flag
+ * Prototypes for local procedures defined in this file:
  */
 
-TCL_DECLARE_MUTEX(consoleMutex)
-
-/*
- * Forward declarations for procedures defined later in this file:
- *
- * The first three will be used in the tk app shells...
- */
- 
-static int	ConsoleCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, CONST char **argv));
+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	InterpreterCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, CONST char **argv));
-
+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 int	ConsoleClose _ANSI_ARGS_((ClientData instanceData,
-		    Tcl_Interp *interp));
 static void	ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
 		    int mask));
-static int	ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
-		    int direction, ClientData *handlePtr));
+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:
@@ -221,8 +213,8 @@ static int ShouldUseConsoleChannel(type)
  * Tk_InitConsoleChannels --
  *
  * 	Create the console channels and install them as the standard
- * 	channels.  All I/O will be discarded until TkConsoleInit is
- * 	called to attach the console to a text widget.
+ * 	channels.  All I/O will be discarded until Tk_CreateConsoleWindow
+ *	is called to attach the console to a text widget.
  *
  * Results:
  *	None.
@@ -238,6 +230,9 @@ void
 Tk_InitConsoleChannels(interp)
     Tcl_Interp *interp;
 {
+    static Tcl_ThreadDataKey consoleInitKey;
+    int *consoleInitPtr, doIn, doOut, doErr;
+    ConsoleInfo *info;
     Tcl_Channel consoleChannel;
 
     /*
@@ -249,78 +244,91 @@ Tk_InitConsoleChannels(interp)
         return;
     }
 
-    Tcl_MutexLock(&consoleMutex);
-    if (!consoleInitialized) {
+    consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
+    if (*consoleInitPtr) {
+	/* We've already initialized console channels in this thread. */
+	return;
+    }
+    *consoleInitPtr = 1;
 
-	consoleInitialized = 1;
-	
+    doIn = ShouldUseConsoleChannel(TCL_STDIN);
+    doOut = ShouldUseConsoleChannel(TCL_STDOUT);
+    doErr = ShouldUseConsoleChannel(TCL_STDERR);
+
+    if (!(doIn || doOut || doErr)) {
 	/*
-	 * check for STDIN, otherwise create it
-	 *
-	 * Don't do this check on the Mac, because it is hard to prevent
-	 * callbacks from the SIOUX layer from opening stdout & stdin, but
-	 * we don't want to use the SIOUX console.  Since the console is not
-	 * actually created till something is written to the channel, it is
-	 * okay to just ignore it here.
-	 *
-	 * This is still a bit of a hack, however, and should be cleaned up
-	 * when we have a better abstraction for the console.
+	 * No std channels should be tied to the console;
+	 * Thus, no need to create the console
 	 */
+	return;
+    }
 
-	if (ShouldUseConsoleChannel(TCL_STDIN)) {
-	    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
-		    (ClientData) TCL_STDIN, 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);
+    /*
+     * 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);
+    }
 
-	/*
-	 * check for STDOUT, otherwise create it
-	 */
-	
-	if (ShouldUseConsoleChannel(TCL_STDOUT)) {
-	    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
-		    (ClientData) TCL_STDOUT, 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 (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");
 	}
-	
-	/*
-	 * check for STDERR, otherwise create it
-	 */
-	
-	if (ShouldUseConsoleChannel(TCL_STDERR)) {
-	    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
-		    (ClientData) TCL_STDERR, 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);
+	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);
     }
-    Tcl_MutexUnlock(&consoleMutex);
 }
 
 /*
@@ -345,60 +353,148 @@ int
 Tk_CreateConsoleWindow(interp)
     Tcl_Interp *interp;			/* Interpreter to use for prompting. */
 {
-    Tcl_Interp *consoleInterp;
+    Tcl_Channel chan;
     ConsoleInfo *info;
-    Tk_Window mainWindow = Tk_MainWindow(interp);
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
-            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+    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
 
-    consoleInterp = Tcl_CreateInterp();
-    if (consoleInterp == NULL) {
+    /* 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;
     }
     
     /*
-     * Initialized Tcl and Tk.
+     * Fetch the instance data from whatever std channel is a
+     * console channel.  If none, create fresh instance data.
      */
 
-    if (Tcl_Init(consoleInterp) != TCL_OK) {
-	goto error;
+    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 (Tk_Init(consoleInterp) != TCL_OK) {
-	goto error;
+
+    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;
     }
-    tsdPtr->gStdoutInterp = interp;
+
+    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 
      */
-    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
-    info->interp = interp;
-    info->consoleInterp = consoleInterp;
-    Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
-	    (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
-    Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
-	    (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_SetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL, (ClientData) info);
 
-    Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
-	    (ClientData) info);
+    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);
-    if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
-	/* goto error; -- no problem for now... */
-	printf("Eval error: %s", consoleInterp->result);
+    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:
-    if (consoleInterp != NULL) {
-    	Tcl_DeleteInterp(consoleInterp);
+    Tcl_AddErrorInfo(interp, "\n    (creating console window)");
+    if (!Tcl_InterpDeleted(consoleInterp)) {
+	Tcl_DeleteInterp(consoleInterp);
     }
     return TCL_ERROR;
 }
@@ -428,17 +524,30 @@ ConsoleOutput(instanceData, buf, toWrite, errorCode)
     int toWrite;			/* How many bytes to write? */
     int *errorCode;			/* Where to store error code. */
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
-            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+    ChannelData *data = (ChannelData *)instanceData;
+    ConsoleInfo *info = data->info;
 
     *errorCode = 0;
     Tcl_SetErrno(0);
 
-    if (tsdPtr->gStdoutInterp != NULL) {
-	TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, 
-                toWrite);
+    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;
 }
 
@@ -492,9 +601,16 @@ ConsoleClose(instanceData, interp)
     ClientData instanceData;	/* Unused. */
     Tcl_Interp *interp;		/* Unused. */
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
-            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-    tsdPtr->gStdoutInterp = NULL;
+    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;
 }
 
@@ -560,282 +676,304 @@ ConsoleHandle(instanceData, direction, handlePtr)
 /*
  *----------------------------------------------------------------------
  *
- * ConsoleCmd --
+ * ConsoleObjCmd --
  *
  *	The console command implements a Tcl interface to the various console
  *	options.
  *
  * Results:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-ConsoleCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+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;
-    char c;
-    size_t length;
-    int result;
-    Tcl_Interp *consoleInterp;
-
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg ...?\"", (char *) NULL);
+    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;
     }
-    
-    c = argv[1][0];
-    length = strlen(argv[1]);
-    result = TCL_OK;
-    consoleInterp = info->consoleInterp;
-    Tcl_Preserve((ClientData) consoleInterp);
-
-    if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
-	Tcl_DString dString;
 
-	Tcl_DStringInit(&dString);
-	Tcl_DStringAppend(&dString, "wm title . ", -1);
-	if (argc == 3) {
-	    Tcl_DStringAppendElement(&dString, argv[2]);
+    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;
 	}
-	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
-	Tcl_DStringFree(&dString);
-    } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
-	Tcl_Eval(consoleInterp, "wm withdraw .");
-    } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
-	Tcl_Eval(consoleInterp, "wm deiconify .");
-    } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
-	if (argc == 3) {
-	    result = Tcl_Eval(consoleInterp, argv[2]);
-	    Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
-		    (char *) NULL);
-	} else {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " eval command\"", (char *) NULL);
-	    result = 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, "bad option \"", argv[1],
-		"\": should be hide, show, or title",
-		(char *) NULL);
-        result = TCL_ERROR;
+	Tcl_AppendResult(interp, "no active console interp", NULL);
+	result = TCL_ERROR;
     }
-    Tcl_Release((ClientData) consoleInterp);
+    Tcl_DecrRefCount(cmd);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * InterpreterCmd --
+ * InterpreterObjCmd --
  *
  *	This command allows the console interp to communicate with the
  *	main interpreter.
  *
  * Results:
- *	None.
- *
- * Side effects:
- *	None.
+ *	A standard Tcl result.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InterpreterCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+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;
-    char c;
-    size_t length;
-    int result;
-    Tcl_Interp *consoleInterp;
-    Tcl_Interp *otherInterp;
-
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg ...?\"", (char *) NULL);
+    Tcl_Interp *otherInterp = info->interp;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg");
 	return TCL_ERROR;
     }
-    
-    c = argv[1][0];
-    length = strlen(argv[1]);
-    consoleInterp = info->consoleInterp;
-    Tcl_Preserve((ClientData) consoleInterp);
-    otherInterp = info->interp;
+    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);
-    if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
-   	result = Tcl_GlobalEval(otherInterp, argv[2]);
-    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
-    } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
-   	Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
-	result = TCL_OK;
-	Tcl_ResetResult(interp);
-    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": should be eval or record",
-		(char *) NULL);
-	result = TCL_ERROR;
+    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);
-    Tcl_Release((ClientData) consoleInterp);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ConsoleDeleteProc --
+ * DeleteConsoleInterp --
  *
- *	If the console command is deleted we destroy the console window
- *	and all associated data structures.
+ *	Thread exit handler to destroy a console interp when the
+ *	thread it lives in gets torn down.
  *
- * Results:
- *	None.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteConsoleInterp(clientData)
+    ClientData clientData;
+{
+    Tcl_Interp *interp = (Tcl_Interp *)clientData;
+    Tcl_DeleteInterp(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
  *
- * Side effects:
- *	A new console it created.
+ * InterpDeleteProc --
  *
- *----------------------------------------------------------------------
+ *    React when the interp in which the console is displayed is deleted
+ *    for any reason.
+ *
+ * Results:
+ *	None.
  */
 
 static void
-ConsoleDeleteProc(clientData) 
+InterpDeleteProc(clientData, interp)
     ClientData clientData;
+    Tcl_Interp *interp;
 {
     ConsoleInfo *info = (ConsoleInfo *) clientData;
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 
-    /*
-     * Also need to null this out to prevent any further use.
-     *
-     * Fix [Bug #756840]
-     */
-    if (tsdPtr != NULL) {
-        tsdPtr->gStdoutInterp = NULL;
+    if(info->consoleInterp == interp) {
+	Tcl_DeleteThreadExitHandler(DeleteConsoleInterp,
+		(ClientData) info-> consoleInterp);
+	info->consoleInterp = NULL;
+    }
+    if (--info->refCount <= 0) {
+	ckfree((char *) info);
     }
-
-    Tcl_DeleteInterp(info->consoleInterp);
-    info->consoleInterp = NULL;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ConsoleEventProc --
- *
- *	This event procedure 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".
+ * ConsoleDeleteProc --
  *
+ *	If the console command is deleted we destroy the console window and
+ * 	all associated data structures.
+
  * Results:
  *	None.
  *
  * Side effects:
- *	Invokes the "::tk::ConsoleExit" procedure in the console interp.
+ *	A new console is created.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-ConsoleEventProc(clientData, eventPtr)
+ConsoleDeleteProc(clientData)
     ClientData clientData;
-    XEvent *eventPtr;
 {
     ConsoleInfo *info = (ConsoleInfo *) clientData;
-    Tcl_Interp *consoleInterp;
-    
-    if (eventPtr->type == DestroyNotify) {
 
- 	consoleInterp = info->consoleInterp;
-
-        /*
-         * It is possible that the console interpreter itself has
-         * already been deleted. In that case the consoleInterp
-         * field will be set to NULL. If the interpreter is already
-         * gone, we do not have to do any work here.
-         */
-        
-        if (consoleInterp == (Tcl_Interp *) NULL) {
-            return;
-        } else {
-	    Tcl_Preserve((ClientData) consoleInterp);
-	    Tcl_Eval(consoleInterp, "::tk::ConsoleExit");
-	    Tcl_Release((ClientData) consoleInterp);
-	}
+    if (info->consoleInterp) {
+	Tcl_DeleteInterp(info->consoleInterp);
+    }
+    if (--info->refCount <= 0) {
+	ckfree((char *) info);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TkConsolePrint --
- *
- *	Prints to the give text to the console.  Given the main interp
- *	this functions find the appropiate console interp and forwards
- *	the text to be added to that console.
+ * 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:
- *	None.
+ *	Invokes the "::tk::ConsoleExit" command in the console interp.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TkConsolePrint(interp, devId, buffer, size)
-    Tcl_Interp *interp;		/* Main interpreter. */
-    int devId;			/* TCL_STDOUT for stdout, TCL_STDERR for
-                                 * stderr. */
-    CONST char *buffer;		/* Text buffer. */
-    long size;			/* Size of text buffer. */
+static void
+ConsoleEventProc(clientData, eventPtr)
+    ClientData clientData;
+    XEvent *eventPtr;
 {
-    Tcl_DString command, output;
-    ConsoleInfo *info;
-    Tcl_Interp *consoleInterp;
-
-    if (interp == NULL) {
-	return;
-    }
+    if (eventPtr->type == DestroyNotify) {
+	ConsoleInfo *info = (ConsoleInfo *) clientData;
+	Tcl_Interp *consoleInterp = info->consoleInterp;
 
-    info = (ConsoleInfo *) Tcl_GetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL);
-    if (info == NULL || info->consoleInterp == NULL) {
-	return;
-    }
+	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
+	    Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
+	}
 
-    Tcl_DStringInit(&command);
-    if (devId == TCL_STDERR) {
-	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stderr ", -1);
-    } else {
-	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stdout ", -1);
+	if (--info->refCount <= 0) {
+	    ckfree((char *) info);
+	}
     }
-
-    Tcl_DStringInit(&output);
-    Tcl_DStringAppend(&output, buffer, size);
-    Tcl_DStringAppendElement(&command, Tcl_DStringValue(&output));
-    Tcl_DStringFree(&output);
-
-    consoleInterp = info->consoleInterp;
-    Tcl_Preserve((ClientData) consoleInterp);
-    Tcl_Eval(consoleInterp, Tcl_DStringValue(&command));
-    Tcl_Release((ClientData) consoleInterp);
-
-    Tcl_DStringFree(&command);
 }
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 1d779b4..848a8e9 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: $Id: tkInt.h,v 1.56.2.7 2005/11/27 02:44:25 das Exp $ 
+ * RCS: $Id: tkInt.h,v 1.56.2.8 2006/06/05 18:06:47 dgp Exp $ 
  */
 
 #ifndef _TKINT
@@ -1128,9 +1128,6 @@ EXTERN int		Tk_WmObjCmd _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
 
-EXTERN void		TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
-			    int devId, CONST char *buffer, long size));
-
 EXTERN void		TkEventInit _ANSI_ARGS_((void));
 
 EXTERN void		TkRegisterObjTypes _ANSI_ARGS_((void));