summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-10-05 18:22:21 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-10-05 18:22:21 (GMT)
commit501d0b1523e4a2b370c58cd262bbed99725a5ab1 (patch)
tree57b5f8cd5ff8ef866da62495bc435946f4655c50 /win
parent291d618cfb6ad5e935244599abbf1bdb93a284fc (diff)
downloadtk-501d0b1523e4a2b370c58cd262bbed99725a5ab1.zip
tk-501d0b1523e4a2b370c58cd262bbed99725a5ab1.tar.gz
tk-501d0b1523e4a2b370c58cd262bbed99725a5ab1.tar.bz2
Greatly clean up Tk's handling of the writability of the Tcl result object.
Diffstat (limited to 'win')
-rw-r--r--win/tkWinDialog.c18
-rw-r--r--win/tkWinFont.c24
-rw-r--r--win/tkWinSend.c8
-rw-r--r--win/tkWinSendCom.c10
-rw-r--r--win/tkWinWm.c112
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;
}
/*