Greatly clean up Tk's handling of the writability of the Tcl result object.

3 files changed, 17 insertions, 8 deletions

diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c
index e4b6f09..a6b1485 100644
--- a/unix/tkUnixEvent.c
+++ b/unix/tkUnixEvent.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkUnixEvent.c,v 1.29 2008/08/19 15:52:13 georgeps Exp $
+ * RCS: @(#) $Id: tkUnixEvent.c,v 1.30 2008/10/05 18:22:21 dkf Exp $
  */
 
 #include "tkUnixInt.h"
@@ -287,6 +287,14 @@ TransferXEventsToTcl(
 
     while (QLength(display) > 0) {
 	XNextEvent(display, &event);
+#ifdef GenericEvent
+	if (event.type == GenericEvent) {
+	    xGenericEvent *xgePtr = (xGenericEvent *) &event;
+
+	    Tcl_Panic("Wild GenericEvent; panic! (extension=%d,evtype=%d)"
+		    xgePtr->extension, xgePtr->evtype);
+	}
+#endif
 	if (event.type != KeyPress && event.type != KeyRelease) {
 	    if (XFilterEvent(&event, None)) {
 		continue;
diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c
index 286ac32..7409f2f 100644
--- a/unix/tkUnixFont.c
+++ b/unix/tkUnixFont.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkUnixFont.c,v 1.34 2008/04/27 22:39:13 dkf Exp $
+ * RCS: @(#) $Id: tkUnixFont.c,v 1.35 2008/10/05 18:22:21 dkf Exp $
  */
 
 #include "tkUnixInt.h"
@@ -847,8 +847,6 @@ TkpGetFontFamilies(
     Tcl_HashSearch search;
     Tcl_Obj *resultPtr, *strPtr;
 
-    resultPtr = Tcl_GetObjResult(interp);
-
     Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);
     nameList = ListFonts(Tk_Display(tkwin), "*", &numNames);
     for (i = 0; i < numNames; i++) {
@@ -876,11 +874,13 @@ TkpGetFontFamilies(
     XFreeFontNames(nameList);
 
     hPtr = Tcl_FirstHashEntry(&familyTable, &search);
+    resultPtr = Tcl_NewObj();
     while (hPtr != NULL) {
 	strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1);
 	Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
 	hPtr = Tcl_NextHashEntry(&search);
     }
+    Tcl_SetObjResult(interp, resultPtr);
 
     Tcl_DeleteHashTable(&familyTable);
 }
@@ -913,7 +913,7 @@ TkpGetSubFonts(
     UnixFont *fontPtr;
     FontFamily *familyPtr;
 
-    resultPtr = Tcl_GetObjResult(interp);
+    resultPtr = Tcl_NewObj();
     fontPtr = (UnixFont *) tkfont;
     for (i = 0; i < fontPtr->numSubFonts; i++) {
 	familyPtr = fontPtr->subFontArray[i].familyPtr;
@@ -924,6 +924,7 @@ TkpGetSubFonts(
 	listPtr = Tcl_NewListObj(3, objv);
 	Tcl_ListObjAppendElement(NULL, resultPtr, listPtr);
     }
+    Tcl_SetObjResult(interp, resultPtr);
 }
 
 /*
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index 11da8ac..ab75626 100644
--- a/unix/tkUnixWm.c
+++ b/unix/tkUnixWm.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkUnixWm.c,v 1.60 2008/07/23 23:24:45 nijtmans Exp $
+ * RCS: @(#) $Id: tkUnixWm.c,v 1.61 2008/10/05 18:22:21 dkf Exp $
  */
 
 #include "tkUnixInt.h"
@@ -2822,7 +2822,7 @@ WmOverrideredirectCmd(
     }
     curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
     if (objc == 3) {
-	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(curValue));
 	return TCL_OK;
     }
     if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
@@ -3254,7 +3254,7 @@ WmStackorderCmd(
 	} else { /* OPT_ISBELOW */
 	    result = index1 < index2;
 	}
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
 	return TCL_OK;
     }
     return TCL_OK;