Switch from direct tcl_interp->result access to Tcl_GetStringResult() and Tcl_AppendResult()

This allows building against recent libtcl versions.

A fallback definition of Tcl_GetStringResult() is included so that building against libtcl 7 still works.

Changelog

@@ -1,5 +1,8 @@
 [Changes 1.2.2]
 
+* Update to build against modern libtcl (don't access tcl_interp->result
+  directly). (caf)
+
 * Add /FSET SEND_ENCRYPTED_PUBLIC format. (caf)
 
 * Correct order of arguments to /FSET SEND_ENCRYPTED_MSG and

include/tcl_bx.h

@@ -28,6 +28,11 @@ void tcl_load (char *, char *, char *, char *);
 
 #define USE_NON_CONST
 #include <tcl.h>
+
+#if (TCL_MAJOR_VERSION < 8)
+#define Tcl_GetStringResult(interp) ((interp)->result)
+#endif
+
 extern Tcl_Interp *tcl_interp;
 void check_tcl_tand (char *, char *, char *);
 void check_tcl_msgm (char *, char *, char *, char *, char *);

source/bot_link.c

@@ -743,9 +743,9 @@ int cmd_tcl(int idx, char *par)
 		return TCL_ERROR;
 	if ((Tcl_Eval(tcl_interp, par)) == TCL_OK)
 	{
-		dcc_printf(idx, "Tcl: %s\n", tcl_interp->result);
+		dcc_printf(idx, "Tcl: %s\n", Tcl_GetStringResult(tcl_interp));
 	} else 
-		dcc_printf(idx, "Tcl Error: %s\n", tcl_interp->result);
+		dcc_printf(idx, "Tcl Error: %s\n", Tcl_GetStringResult(tcl_interp));
 #else
 		dcc_printf(idx, "Not implemented in this client\n");
 #endif

source/commands.c

@@ -4579,8 +4579,6 @@ int BX_parse_command(char *line, int hist_flag, char *sub_args)
 			}
 			else
 			{
-				char unknown[] = "Unknown command:";
-				
 				if (hist_flag && add_to_hist && !oper_issued)
 					add_to_history(this_cmd);
 				command = find_command(cline, &cmd_cnt);
@@ -4635,25 +4633,28 @@ int BX_parse_command(char *line, int hist_flag, char *sub_args)
 				else if (tcl_interp)
 				{
 					int err;
+					const char *tcl_result;
+
 					err = Tcl_Invoke(tcl_interp, cline, rest);
+					tcl_result = Tcl_GetStringResult(tcl_interp);
+
 					if (err == TCL_OK)
 					{
-						if (tcl_interp->result && *tcl_interp->result)
+						bitchsay("%s", tcl_result);
-							bitchsay("%s %s", *tcl_interp->result?empty_string:unknown, *tcl_interp->result?tcl_interp->result:empty_string);
 					}
 					else
 					{
-						if (alias_cnt + cmd_cnt > 1)
+						if (*tcl_result)
-							bitchsay("Ambiguous command: %s", cline);
-						else if (get_int_var(DISPATCH_UNKNOWN_COMMANDS_VAR))
-							send_to_server("%s %s", cline, rest);
-						else if (tcl_interp->result && *tcl_interp->result)
 						{
 							if (check_help_bind(cline))
-								bitchsay("%s", tcl_interp->result);
+								bitchsay("%s", tcl_result);
 						}
+						else if (get_int_var(DISPATCH_UNKNOWN_COMMANDS_VAR))
+							send_to_server("%s %s", cline, rest);
+						else if (alias_cnt + cmd_cnt > 1)
+							bitchsay("Ambiguous command: %s", cline);
 						else
-							bitchsay("%s %s", unknown, cline);
+							bitchsay("Unknown command: %s", cline);
 
 					}
 				}
@@ -4663,7 +4664,7 @@ int BX_parse_command(char *line, int hist_flag, char *sub_args)
 				else if (alias_cnt + cmd_cnt > 1)
 					bitchsay("Ambiguous command: %s", cline);
 				else
-					bitchsay("%s %s", unknown, cline);
+					bitchsay("Unknown command: %s", cline);
 			}
 			if (alias)
 				new_free(&alias_name);
@@ -4803,7 +4804,7 @@ BUILT_IN_COMMAND(BX_load)
 		{
 #ifdef WANT_TCL
 			if (Tcl_EvalFile(tcl_interp, filename) != TCL_OK)
-				error("Unable to load filename %s[%s]", filename, tcl_interp->result);
+				error("Unable to load filename %s [%s]", filename, Tcl_GetStringResult(tcl_interp));
 #endif
 			continue;
 		}
@@ -5490,12 +5491,18 @@ int result = 0;
 	if ((filename = next_arg(args, &args)))
 	{
 		char *bla = NULL;
+		const char *tcl_result;
+
 		if (get_string_var(LOAD_PATH_VAR))
 			bla = path_search(filename, get_string_var(LOAD_PATH_VAR));
-		if ((result = Tcl_EvalFile(tcl_interp, bla?bla:filename)) != TCL_OK)
+
-			put_it("Tcl:  [%s]",tcl_interp->result);
+		result = Tcl_EvalFile(tcl_interp, bla ? bla : filename);
-		else if (*tcl_interp->result)
+		tcl_result = Tcl_GetStringResult(tcl_interp);
-			put_it("Tcl:  [%s]", tcl_interp->result);
+
+		if (result != TCL_OK)
+			put_it("Tcl Error: [%s]", tcl_result);
+		else if (*tcl_result)
+			put_it("Tcl: [%s]", tcl_result);
 	}
 }
 

source/tcl.c

@@ -1368,10 +1368,12 @@ int stk;
 
 int trigger_bind(char *proc, char *param, char *(*func)(char *, char *))
 {
-char *result = NULL;
+	char *result = NULL;
+	int err;
 	
 	if (internal_debug & DEBUG_TCL)
 		debugyell("Tcl exec [%s] with [%s]", proc, param);
+
 	if (func)
 	{
 		result = (*func)(proc, param);
@@ -1381,16 +1383,18 @@ char *result = NULL;
 			debugyell("Tcl return from [%s] with [%s]", proc, result);
 		return BIND_EXECUTED;
 	}
-	if (Tcl_VarEval(tcl_interp,proc,param,NULL)==TCL_ERROR) 
+
-	{
+	err = Tcl_VarEval(tcl_interp, proc, param, NULL);
+	result = Tcl_GetStringResult(tcl_interp);
+
 	if (internal_debug & DEBUG_TCL)
-			debugyell("Tcl return from [%s] with [%s]", proc, tcl_interp->result);
+		debugyell("Tcl return from [%s] with [%s]", proc, result);
-		putlog(LOG_ALL,"*","Tcl error [%s]: %s",proc,tcl_interp->result);
+	if (err == TCL_ERROR) 
+	{
+		putlog(LOG_ALL,"*","Tcl error [%s]: %s", proc, result);
 		return BIND_EXECUTED;
 	}
-	if (internal_debug & DEBUG_TCL)
+	return (atoi(result)>0)?BIND_EXEC_LOG:BIND_EXECUTED;
-		debugyell("Tcl return from [%s] with [%s]", proc, tcl_interp->result);
-	return (atoi(tcl_interp->result)>0)?BIND_EXEC_LOG:BIND_EXECUTED;
 }
 
 void init_builtins()
@@ -1954,7 +1958,7 @@ char *check_tcl_alias(char *command, char *args)
 	
 	Tcl_SetVar(tcl_interp, "_a", args?args:empty_string, TCL_GLOBAL_ONLY);
 	if (check_tcl_bind(&H_functions, command, -1, " $_a", MATCH_MASK|BIND_STACKABLE, NULL))
-		return m_strdup(tcl_interp->result?tcl_interp->result:empty_string);
+		return m_strdup(Tcl_GetStringResult(tcl_interp));
 	return NULL;
 }
 
@@ -2325,7 +2329,8 @@ BUILT_IN_COMMAND(tcl_version)
 
 BUILT_IN_COMMAND(tcl_command)
 {
-int result = 0;
+	int result = 0;
+	const char *tcl_result;
 	
 	tcl_init();
 	if (args && *args)
@@ -2338,10 +2343,12 @@ int result = 0;
 				bla = next_arg(args, &args);
 				if (get_string_var(LOAD_PATH_VAR))
 					bla = path_search(args, get_string_var(LOAD_PATH_VAR));
-				if ((result = Tcl_EvalFile(tcl_interp, bla ? bla : args)) != TCL_OK)
+
-					put_it("Tcl:  [%s]",tcl_interp->result);
+				result = Tcl_EvalFile(tcl_interp, bla ? bla : args);
-				else if (tcl_echo && *tcl_interp->result)
+				tcl_result = Tcl_GetStringResult(tcl_interp);
-					put_it("Tcl:  [%s]", tcl_interp->result);
+
+				if ((result != TCL_OK) || (tcl_echo && *tcl_result))
+					put_it("Tcl: [%s]", tcl_result);
 			} 
 			else if (!my_strnicmp(args+1, "xecho", 4)) 
 			{
@@ -2354,10 +2361,12 @@ int result = 0;
 				put_it("Tcl: unknown cmd [%s]", args);
 			return;					
 		}
-		if ((result = Tcl_Eval(tcl_interp, args)) != TCL_OK)
+
-			put_it("Tcl: %s %s", args, tcl_interp->result);
+		result = Tcl_Eval(tcl_interp, args);
-		else if (tcl_echo && *tcl_interp->result)
+		tcl_result = Tcl_GetStringResult(tcl_interp);
-			put_it("Tcl: [%s] %s", args, tcl_interp->result);
+
+		if ((result != TCL_OK) || (tcl_echo && *tcl_result))
+			put_it("Tcl: [%s] %s", args, tcl_result);
 	} 
 	else
 	{
@@ -2392,7 +2401,7 @@ char *com;
 	Tcl_ResetResult(irp);
 	lower(com);
 	if (internal_debug & DEBUG_TCL)
-		debugyell("Invoking tcl [%s] with [%s]", com, rest);
+		debugyell("Invoking Tcl [%s] with [%s]", com, rest);
 	if (Tcl_GetCommandInfo(irp, com, &info) && info.proc)
 	{
 		result = (*info.proc)(info.clientData, irp, argc, ArgList);
@@ -2400,7 +2409,11 @@ char *com;
 			debugyell("Tcl returning with [%d]", result);
 	}
 	else
-		Tcl_AppendResult(irp, "Unknown command \"", com, "\"", NULL);
+	{
+		if (internal_debug & DEBUG_TCL)
+			debugyell("Tcl could not find command [%s]", com);
+	}
+
 	return result;
 }
 

source/tcl_public.c

@@ -41,8 +41,6 @@ cmd_t C_dcc[] =
 };
 
 #ifdef WANT_TCL
-#include <tcl.h>
-
 /* 
  * I wish to thank vore!vore@domination.ml.org for pushing me 
  * todo something like this, although by-Tor requested 
@@ -234,16 +232,16 @@ static int CompareKeyListField (tcl_interp, fieldName, field, valuePtr, valueSiz
     int   fieldNameSize, elementSize;
 
     if (field [0] == '\0') {
-        tcl_interp->result =
+        Tcl_AppendResult(tcl_interp,
-            "invalid keyed list format: list contains an empty field entry";
+            "invalid keyed list format: list contains an empty field entry", NULL);
         return TCL_ERROR;
     }
     if (TclFindElement (tcl_interp, (char *) field, &elementPtr, &nextPtr, 
                         &elementSize, NULL) != TCL_OK)
         return TCL_ERROR;
     if (elementSize == 0) {
-        tcl_interp->result =
+        Tcl_AppendResult(tcl_interp,
-            "invalid keyed list format: list contains an empty field name";
+            "invalid keyed list format: list contains an empty field name", NULL);
         return TCL_ERROR;
     }
     if (nextPtr[0] == '\0') {
@@ -310,7 +308,7 @@ static int SplitAndFindField (tcl_interp, fieldName, keyedList, fieldInfoPtr)
     int  idx, result, braced;
 
     if (fieldName == '\0') {
-        tcl_interp->result = "null key not allowed";
+        Tcl_AppendResult(tcl_interp, "null key not allowed", NULL);
         return TCL_ERROR;
     }
 
@@ -505,7 +503,7 @@ int Tcl_GetKeyedListField (tcl_interp, fieldName, keyedList, fieldValuePtr)
 
 	if (fieldName == '\0') 
 	{
-		tcl_interp->result = "null key not allowed";
+		Tcl_AppendResult(tcl_interp, "null key not allowed", NULL);
 		return TCL_ERROR;
 	}
 
@@ -862,7 +860,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha
      * Handle retrieving a value for a specified key.
      */
     if (argv [2] == '\0') {
-        tcl_interp->result = "null key not allowed";
+        Tcl_AppendResult(tcl_interp, "null key not allowed", NULL);
         return TCL_ERROR;
     }
     if ((argc == 4) && (argv [3][0] == '\0'))
@@ -884,7 +882,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha
                               "\" not found in keyed list", (char *) NULL);
             return TCL_ERROR;
         } else {
-            tcl_interp->result = zero;
+            Tcl_AppendResult(tcl_interp, zero, NULL);
             return TCL_OK;
         }
     }
@@ -901,7 +899,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha
      * Handle null return variable specified and key was found.
      */
     if (argv [3][0] == '\0') {
-        tcl_interp->result = one;
+        Tcl_AppendResult(tcl_interp, one, NULL);
         return TCL_OK;
     }
 
@@ -913,7 +911,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha
     else
         result = TCL_OK;
     ckfree (fieldValue);
-    tcl_interp->result = one;
+    Tcl_AppendResult(tcl_interp, one, NULL);
     return result;
 }
 
@@ -1199,7 +1197,7 @@ int Tcl_LemptyCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, char
 	scanPtr = argv [1];
 	while ((*scanPtr != '\0') && (ISSPACE (*scanPtr)))
 		scanPtr++;
-	sprintf (tcl_interp->result, "%d", (*scanPtr == '\0'));
+	Tcl_AppendResult(tcl_interp, (*scanPtr == '\0') ? "1" : "0", NULL);
 	return TCL_OK;
 }
 
@@ -1430,7 +1428,7 @@ struct timeval now1;
 			int code;
 			Tcl_DStringInit(&ds);
 			if (Tcl_SplitList(tcl_interp,mark->command,&argc,&argv) != TCL_OK) 
-				putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, tcl_interp->result);
+				putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, Tcl_GetStringResult(tcl_interp));
 			else 
 			{
 				for (i=0; i<argc; i++) 
@@ -1440,7 +1438,7 @@ struct timeval now1;
 				/* code=Tcl_Eval(tcl_interp,mark->cmd); */
 				Tcl_DStringFree(&ds);
 				if (code!=TCL_OK)
-					putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, tcl_interp->result);
+					putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, Tcl_GetStringResult(tcl_interp));
 			}
 		}
 		else