Use Tcl_Set/GetAssocData to remove use of fragile Tcl_GetCommandInfo

from TkConsolePrint. [Bug 1016385]

2 files changed, 40 insertions, 35 deletions

diff --git a/ChangeLog b/ChangeLog
index 072d065..ebdf15f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2005-03-19  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tkConsole.c (Tk_CreateConsoleWindow,TkConsolePrint):
+	Rewrite so that TkConsolePrint cannot become detached from the
+	console when the [console] command is renamed. [Bug 1016385]
+
 2005-03-15  Vince Darley  <vincentdarley@users.sourceforge.net>
 
 	* generic/tkTextDisp.c: fix for [Bug 1143776] in adjusting
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index eebac0e..28430b0 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.c
@@ -10,7 +10,7 @@
  * 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.21 2004/06/26 09:04:15 mistachkin Exp $
+ * RCS: @(#) $Id: tkConsole.c,v 1.22 2005/03/19 08:02:57 dkf Exp $
  */
 
 #include "tk.h"
@@ -29,6 +29,15 @@ typedef struct ConsoleInfo {
     Tcl_Interp *interp;		/* Interpreter to send console commands. */
 } 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]
+ */
+
+#define TK_CONSOLE_INFO_KEY	"tk::ConsoleInfo"
+
 typedef struct ThreadSpecificData {
     Tcl_Interp *gStdoutInterp;
 } ThreadSpecificData;
@@ -332,8 +341,8 @@ Tk_CreateConsoleWindow(interp)
     Tk_Window mainWindow = Tk_MainWindow(interp);
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-    static char initCmd[] = "source $tk_library/console.tcl";
-    
+    static const char *initCmd = "source $tk_library/console.tcl";
+
     consoleInterp = Tcl_CreateInterp();
     if (consoleInterp == NULL) {
 	goto error;
@@ -361,6 +370,7 @@ Tk_CreateConsoleWindow(interp)
 	    (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);
@@ -563,7 +573,6 @@ ConsoleCmd(clientData, interp, argc, argv)
     size_t length;
     int result;
     Tcl_Interp *consoleInterp;
-    Tcl_DString dString;
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -576,20 +585,21 @@ ConsoleCmd(clientData, interp, argc, argv)
     result = TCL_OK;
     consoleInterp = info->consoleInterp;
     Tcl_Preserve((ClientData) consoleInterp);
-    Tcl_DStringInit(&dString);
 
     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]);
 	}
 	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+	Tcl_DStringFree(&dString);
     } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
-	Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
-	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+	Tcl_Eval(consoleInterp, "wm withdraw .");
     } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
-	Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
-	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+	Tcl_Eval(consoleInterp, "wm deiconify .");
     } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
 	if (argc == 3) {
 	    result = Tcl_Eval(consoleInterp, argv[2]);
@@ -606,7 +616,6 @@ ConsoleCmd(clientData, interp, argc, argv)
 		(char *) NULL);
         result = TCL_ERROR;
     }
-    Tcl_DStringFree(&dString);
     Tcl_Release((ClientData) consoleInterp);
     return result;
 }
@@ -752,12 +761,8 @@ ConsoleEventProc(clientData, eventPtr)
         if (consoleInterp == (Tcl_Interp *) NULL) {
             return;
         } else {
-	    Tcl_DString dString;
-	    Tcl_DStringInit(&dString);
 	    Tcl_Preserve((ClientData) consoleInterp);
-	    Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
-	    Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
-	    Tcl_DStringFree(&dString);
+	    Tcl_Eval(consoleInterp, "::tk::ConsoleExit");
 	    Tcl_Release((ClientData) consoleInterp);
 	}
     }
@@ -790,40 +795,34 @@ TkConsolePrint(interp, devId, buffer, size)
     long size;			/* Size of text buffer. */
 {
     Tcl_DString command, output;
-    Tcl_CmdInfo cmdInfo;
-    char *cmd;
     ConsoleInfo *info;
     Tcl_Interp *consoleInterp;
-    int result;
 
     if (interp == NULL) {
 	return;
     }
-    
+
+    info = (ConsoleInfo *) Tcl_GetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL);
+    if (info->consoleInterp == NULL) {
+	return;
+    }
+
+    Tcl_DStringInit(&command);
     if (devId == TCL_STDERR) {
-	cmd = "::tk::ConsoleOutput stderr ";
+	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stderr ", -1);
     } else {
-	cmd = "::tk::ConsoleOutput stdout ";
+	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stdout ", -1);
     }
-    
-    result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
-    if (result == 0) {
-	return;
-    }
-    info = (ConsoleInfo *) cmdInfo.clientData;
-    
+
     Tcl_DStringInit(&output);
     Tcl_DStringAppend(&output, buffer, size);
-
-    Tcl_DStringInit(&command);
-    Tcl_DStringAppend(&command, cmd, (int) strlen(cmd));
-    Tcl_DStringAppendElement(&command, output.string);
+    Tcl_DStringAppendElement(&command, Tcl_DStringValue(&output));
+    Tcl_DStringFree(&output);
 
     consoleInterp = info->consoleInterp;
     Tcl_Preserve((ClientData) consoleInterp);
-    Tcl_Eval(consoleInterp, command.string);
+    Tcl_Eval(consoleInterp, Tcl_DStringValue(&command));
     Tcl_Release((ClientData) consoleInterp);
-    
+
     Tcl_DStringFree(&command);
-    Tcl_DStringFree(&output);
 }