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

5 files changed, 75 insertions, 97 deletions

diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 93d2d57..c55fb2a 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinDialog.c,v 1.52 2008/04/27 22:39:14 dkf Exp $
+ * RCS: @(#) $Id: tkWinDialog.c,v 1.53 2008/10/05 18:22:22 dkf Exp $
  *
  */
 
@@ -883,12 +883,13 @@ GetFileNameW(
 	    int listObjc, count;
 	    Tcl_Obj **listObjv = NULL;
 	    Tcl_Obj **typeInfo = NULL;
+
 	    if (Tcl_ListObjGetElements(interp, filterObj,
-			    &listObjc, &listObjv) != TCL_OK) {
+		    &listObjc, &listObjv) != TCL_OK) {
 		result = TCL_ERROR;
 	    } else if (Tcl_ListObjGetElements(interp,
-			    listObjv[ofn.nFilterIndex - 1],
-			    &count, &typeInfo) != TCL_OK) {
+		    listObjv[ofn.nFilterIndex - 1], &count,
+		    &typeInfo) != TCL_OK) {
 		result = TCL_ERROR;
 	    } else {
 		Tcl_ObjSetVar2(interp, typeVariableObj, NULL, typeInfo[0], 0);
@@ -1332,12 +1333,13 @@ GetFileNameA(
 	    int listObjc, count;
 	    Tcl_Obj **listObjv = NULL;
 	    Tcl_Obj **typeInfo = NULL;
-	    if (Tcl_ListObjGetElements(interp, filterObj,
-			    &listObjc, &listObjv) != TCL_OK) {
+
+	    if (Tcl_ListObjGetElements(interp, filterObj, &listObjc,
+		    &listObjv) != TCL_OK) {
 		result = TCL_ERROR;
 	    } else if (Tcl_ListObjGetElements(interp,
-			    listObjv[ofn.nFilterIndex - 1],
-			    &count, &typeInfo) != TCL_OK) {
+		    listObjv[ofn.nFilterIndex - 1], &count,
+		    &typeInfo) != TCL_OK) {
 		result = TCL_ERROR;
 	    } else {
 		Tcl_ObjSetVar2(interp, typeVariableObj, NULL, typeInfo[0], 0);
diff --git a/win/tkWinFont.c b/win/tkWinFont.c
index c6ce1e7..b5e6679 100644
--- a/win/tkWinFont.c
+++ b/win/tkWinFont.c
@@ -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: tkWinFont.c,v 1.39 2008/04/27 22:39:17 dkf Exp $
+ * RCS: @(#) $Id: tkWinFont.c,v 1.40 2008/10/05 18:22:22 dkf Exp $
  */
 
 #include "tkWinInt.h"
@@ -615,10 +615,12 @@ TkpGetFontFamilies(
     HDC hdc;
     HWND hwnd;
     Window window;
+    Tcl_Obj *resultObj;
 
     window = Tk_WindowId(tkwin);
     hwnd = (window == None) ? NULL : TkWinGetHWND(window);
     hdc = GetDC(hwnd);
+    resultObj = Tcl_NewObj();
 
     /*
      * On any version NT, there may fonts with international names. Use the
@@ -637,12 +639,13 @@ TkpGetFontFamilies(
 
     if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
 	EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc,
-		(LPARAM) interp);
+		(LPARAM) resultObj);
     } else {
 	EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc,
-		(LPARAM) interp);
+		(LPARAM) resultObj);
     }
     ReleaseDC(hwnd, hdc);
+    Tcl_SetObjResult(interp, resultObj);
 }
 
 static int CALLBACK
@@ -652,17 +655,13 @@ WinFontFamilyEnumProc(
     int fontType,		/* Type of font (not used). */
     LPARAM lParam)		/* Result object to hold result. */
 {
-    char *faceName;
+    char *faceName = lfPtr->elfLogFont.lfFaceName;
+    Tcl_Obj *resultObj = (Tcl_Obj *) lParam;
     Tcl_DString faceString;
-    Tcl_Obj *strPtr;
-    Tcl_Interp *interp;
 
-    interp = (Tcl_Interp *) lParam;
-    faceName = lfPtr->elfLogFont.lfFaceName;
     Tcl_ExternalToUtfDString(systemEncoding, faceName, -1, &faceString);
-    strPtr = Tcl_NewStringObj(Tcl_DStringValue(&faceString),
-	    Tcl_DStringLength(&faceString));
-    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
+    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+	    Tcl_DStringValue(&faceString), Tcl_DStringLength(&faceString)));
     Tcl_DStringFree(&faceString);
     return 1;
 }
@@ -695,13 +694,14 @@ TkpGetSubFonts(
     FontFamily *familyPtr;
     Tcl_Obj *resultPtr, *strPtr;
 
-    resultPtr = Tcl_GetObjResult(interp);
+    resultPtr = Tcl_NewObj();
     fontPtr = (WinFont *) tkfont;
     for (i = 0; i < fontPtr->numSubFonts; i++) {
 	familyPtr = fontPtr->subFontArray[i].familyPtr;
 	strPtr = Tcl_NewStringObj(familyPtr->faceName, -1);
 	Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
     }
+    Tcl_SetObjResult(interp, resultPtr);
 }
 
 /*
diff --git a/win/tkWinSend.c b/win/tkWinSend.c
index ac94c0b..84b37ac 100644
--- a/win/tkWinSend.c
+++ b/win/tkWinSend.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: tkWinSend.c,v 1.16 2008/04/08 03:28:05 kennykb Exp $
+ * RCS: @(#) $Id: tkWinSend.c,v 1.17 2008/10/05 18:22:22 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -365,9 +365,8 @@ Tk_SendObjCmd(
      */
 
     if (displayPtr) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp),
-		"option not implemented: \"displayof\" is not available "
-		"for this platform.", -1);
+	Tcl_SetResult(interp, "option not implemented: \"displayof\" is "
+		"not available for this platform.", TCL_STATIC);
 	result = TCL_ERROR;
     }
 
@@ -377,6 +376,7 @@ Tk_SendObjCmd(
     /* FIX ME: we need to check for local interp */
     if (result == TCL_OK) {
 	LPDISPATCH pdisp;
+
 	result = FindInterpreterObject(interp, Tcl_GetString(objv[i]), &pdisp);
 	if (result == TCL_OK) {
 	    i++;
diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c
index b71b63a..f07259e 100644
--- a/win/tkWinSendCom.c
+++ b/win/tkWinSendCom.c
@@ -18,7 +18,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinSendCom.c,v 1.8 2007/12/13 15:28:56 dgp Exp $
+ * RCS: @(#) $Id: tkWinSendCom.c,v 1.9 2008/10/05 18:22:22 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -381,8 +381,8 @@ Async(
 
     hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR);
     if (FAILED(hr)) {
-	Tcl_SetStringObj(Tcl_GetObjResult(obj->interp),
-		"invalid args: Async(command)", -1);
+	Tcl_SetObjResult(obj->interp, Tcl_NewStringObj(
+		"invalid args: Async(command)", -1));
 	SetExcepInfo(obj->interp, pExcepInfo);
 	hr = DISP_E_EXCEPTION;
     }
@@ -390,13 +390,13 @@ Async(
     if (SUCCEEDED(hr)) {
 	if (obj->interp) {
 	    Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
-		    (int)SysStringLen(vCmd.bstrVal));
+		    (int) SysStringLen(vCmd.bstrVal));
+
 	    result = TkWinSend_QueueCommand(obj->interp, scriptPtr);
 	}
     }
 
     VariantClear(&vCmd);
-
     return hr;
 }
 
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index a82e9bb..db347bd 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.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: tkWinWm.c,v 1.128 2008/08/01 19:39:04 patthoyts Exp $
+ * RCS: @(#) $Id: tkWinWm.c,v 1.129 2008/10/05 18:22:22 dkf Exp $
  */
 
 #include "tkWinInt.h"
@@ -3017,12 +3017,9 @@ WmAspectCmd(
     }
     if (objc == 3) {
 	if (wmPtr->sizeHintsFlags & PAspect) {
-	    char buf[TCL_INTEGER_SPACE * 4];
-
-	    sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
-		    wmPtr->minAspect.y, wmPtr->maxAspect.x,
-		    wmPtr->maxAspect.y);
-	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d",
+		    wmPtr->minAspect.x, wmPtr->minAspect.y,
+		    wmPtr->maxAspect.x, wmPtr->maxAspect.y);
 	}
 	return TCL_OK;
     }
@@ -3254,16 +3251,16 @@ WmAttributesCmd(
 	    }
 	    if (config_fullscreen) {
 		if (objc == 4) {
-		    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
-			(wmPtr->flags & WM_FULLSCREEN));
+		    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+			    wmPtr->flags & WM_FULLSCREEN));
 		} else {
 		    fullscreen_attr_changed = 1;
 		    fullscreen_attr = boolean;
 		}
 		config_fullscreen = 0;
 	    } else if (objc == 4) {
-		Tcl_SetIntObj(Tcl_GetObjResult(interp),
-			((*stylePtr & styleBit) != 0));
+		Tcl_SetObjResult(interp,
+			Tcl_NewBooleanObj(*stylePtr & styleBit));
 	    } else if (boolean) {
 		*stylePtr |= styleBit;
 	    } else {
@@ -3744,7 +3741,6 @@ WmFrameCmd(
 {
     register WmInfo *wmPtr = winPtr->wmInfoPtr;
     HWND hwnd;
-    char buf[TCL_INTEGER_SPACE];
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 2, objv, "window");
@@ -3757,8 +3753,7 @@ WmFrameCmd(
     if (hwnd == NULL) {
 	hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
     }
-    sprintf(buf, "0x%x", (unsigned int) hwnd);
-    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) hwnd));
     return TCL_OK;
 }
 
@@ -3796,10 +3791,8 @@ WmGeometryCmd(
 	Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?");
 	return TCL_ERROR;
     }
-    if (objc == 3) {
-	char buf[16 + TCL_INTEGER_SPACE * 4];
-	int x, y;
 
+    if (objc == 3) {
 	xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
 	ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
 	if (wmPtr->gridWin != NULL) {
@@ -3818,10 +3811,11 @@ WmGeometryCmd(
 	}
 	x = wmPtr->x;
 	y = wmPtr->y;
-	sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, x, ySign, y);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d",
+		width, height, xSign, wmPtr->x, ySign, wmPtr->y));
 	return TCL_OK;
     }
+
     argv3 = Tcl_GetString(objv[3]);
     if (*argv3 == '\0') {
 	wmPtr->width = -1;
@@ -3867,12 +3861,9 @@ WmGridCmd(
     }
     if (objc == 3) {
 	if (wmPtr->sizeHintsFlags & PBaseSize) {
-	    char buf[TCL_INTEGER_SPACE * 4];
-
-	    sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
-		    wmPtr->reqGridHeight, wmPtr->widthInc,
-		    wmPtr->heightInc);
-	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d",
+		    wmPtr->reqGridWidth, wmPtr->reqGridHeight,
+		    wmPtr->widthInc, wmPtr->heightInc));
 	}
 	return TCL_OK;
     }
@@ -4443,11 +4434,8 @@ WmIconpositionCmd(
     }
     if (objc == 3) {
 	if (wmPtr->hints.flags & IconPositionHint) {
-	    char buf[TCL_INTEGER_SPACE * 2];
-
-	    sprintf(buf, "%d %d", wmPtr->hints.icon_x,
-		    wmPtr->hints.icon_y);
-	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d",
+		    wmPtr->hints.icon_x, wmPtr->hints.icon_y));
 	}
 	return TCL_OK;
     }
@@ -4652,11 +4640,8 @@ WmMaxsizeCmd(
 	return TCL_ERROR;
     }
     if (objc == 3) {
-	char buf[TCL_INTEGER_SPACE * 2];
-
 	GetMaxSize(wmPtr, &width, &height);
-	sprintf(buf, "%d %d", width, height);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", width, height));
 	return TCL_OK;
     }
     if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
@@ -4702,11 +4687,8 @@ WmMinsizeCmd(
 	return TCL_ERROR;
     }
     if (objc == 3) {
-	char buf[TCL_INTEGER_SPACE * 2];
-
 	GetMinSize(wmPtr, &width, &height);
-	sprintf(buf, "%d %d", width, height);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", width, height));
 	return TCL_OK;
     }
     if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
@@ -4763,7 +4745,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) {
@@ -4980,12 +4962,9 @@ WmResizableCmd(
 	return TCL_ERROR;
     }
     if (objc == 3) {
-	char buf[TCL_INTEGER_SPACE * 2];
-
-	sprintf(buf, "%d %d",
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d",
 		(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
-		(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1));
 	return TCL_OK;
     }
     if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
@@ -5119,13 +5098,12 @@ WmStackorderCmd(
 	windows = TkWmStackorderToplevel(winPtr);
 	if (windows == NULL) {
 	    Tcl_Panic("TkWmStackorderToplevel failed");
-	} else {
-	    for (window_ptr = windows; *window_ptr ; window_ptr++) {
-		Tcl_AppendElement(interp, (*window_ptr)->pathName);
-	    }
-	    ckfree((char *) windows);
-	    return TCL_OK;
 	}
+	for (window_ptr = windows; *window_ptr ; window_ptr++) {
+	    Tcl_AppendElement(interp, (*window_ptr)->pathName);
+	}
+	ckfree((char *) windows);
+	return TCL_OK;
     } else {
 	TkWindow *winPtr2, **winPtr2Ptr = &winPtr2;
 	int index1=-1, index2=-1, result;
@@ -5159,29 +5137,28 @@ WmStackorderCmd(
 	 */
 
 	windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
-
 	if (windows == NULL) {
 	    Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL);
 	    return TCL_ERROR;
-	} else {
-	    for (window_ptr = windows; *window_ptr ; window_ptr++) {
-		if (*window_ptr == winPtr) {
-		    index1 = (window_ptr - windows);
-		}
-		if (*window_ptr == winPtr2) {
-		    index2 = (window_ptr - windows);
-		}
-	    }
-	    if (index1 == -1) {
-		Tcl_Panic("winPtr window not found");
+	}
+
+	for (window_ptr = windows; *window_ptr ; window_ptr++) {
+	    if (*window_ptr == winPtr) {
+		index1 = (window_ptr - windows);
 	    }
-	    if (index2 == -1) {
-		Tcl_Panic("winPtr2 window not found");
+	    if (*window_ptr == winPtr2) {
+		index2 = (window_ptr - windows);
 	    }
-
-	    ckfree((char *) windows);
+	}
+	if (index1 == -1) {
+	    Tcl_Panic("winPtr window not found");
+	}
+	if (index2 == -1) {
+	    Tcl_Panic("winPtr2 window not found");
 	}
 
+	ckfree((char *) windows);
+
 	if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0,
 		&index) != TCL_OK) {
 	    return TCL_ERROR;
@@ -5191,10 +5168,9 @@ 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;
 }
 
 /*