summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog27
-rw-r--r--generic/tkButton.c5
-rw-r--r--generic/tkCmds.c206
-rw-r--r--generic/tkConfig.c11
-rw-r--r--generic/tkEntry.c20
-rw-r--r--generic/tkFont.c46
-rw-r--r--generic/tkImage.c13
-rw-r--r--generic/tkImgPhoto.c21
-rw-r--r--generic/tkListbox.c6
-rw-r--r--generic/tkMenu.c8
-rw-r--r--generic/tkMenubutton.c4
-rw-r--r--generic/tkPanedWindow.c10
-rw-r--r--generic/tkSelect.c6
-rw-r--r--generic/tkTest.c6
-rw-r--r--generic/tkTextIndex.c7
-rw-r--r--macosx/tkMacOSXMenus.c201
-rw-r--r--macosx/tkMacOSXWm.c8
-rw-r--r--unix/tkUnixEvent.c10
-rw-r--r--unix/tkUnixFont.c9
-rw-r--r--unix/tkUnixWm.c6
-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
25 files changed, 400 insertions, 402 deletions
diff --git a/ChangeLog b/ChangeLog
index a1d7ad1..d693d51 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,30 @@
+2008-10-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/tkWinWm.c (WmAttributesCmd, WmOverrideredirectCmd)
+ (WmStackorderCmd):
+ * win/tkWinSendCom.c (Async):
+ * win/tkWinSend.c (Tk_SendObjCmd):
+ * win/tkWinFont.c (TkpGetFontFamilies, TkpGetSubFonts):
+ * unix/tkUnixWm.c (WmOverrideredirectCmd, WmStackorderCmd):
+ * unix/tkUnixFont.c (TkpGetFontFamilies, TkpGetSubFonts):
+ * macosx/tkMacOSXWm.c (WmOverrideredirectCmd, WmStackorderCmd):
+ * generic/tkTextIndex.c (SetTextIndexFromAny):
+ * generic/tkTest.c (TrivialConfigObjCmd):
+ * generic/tkSelect.c (HandleTclCommand):
+ * generic/tkPanedWindow.c (Tk_PanedWindowObjCmd)
+ (PanedWindowSashCommand, PanedWindowProxyCommand):
+ * generic/tkMenubutton.c (Tk_MenubuttonObjCmd):
+ * generic/tkMenu.c (MenuWidgetObjCmd):
+ * generic/tkListbox.c (ListboxWidgetObjCmd):
+ * generic/tkImgPhoto.c (ImgPhotoCmd): (mostly)
+ * generic/tkImage.c (Tk_ImageObjCmd):
+ * generic/tkFont.c (Tk_FontObjCmd, GetAttributeInfoObj):
+ * generic/tkEntry.c (EntryWidgetObjCmd, SpinboxWidgetObjCmd):
+ * generic/tkConfig.c (SetOptionFromAny, Tk_SetOptions):
+ * generic/tkCmds.c (Tk_TkObjCmd, Tk_WinfoObjCmd, TkGetDisplayOf):
+ * generic/tkButton.c (ButtonCreate): Get rid of code that insists on
+ non-idiomatically writing to the object in the interpreter result.
+
2008-10-03 Donal K. Fellows <dkf@users.sf.net>
* generic/tkArgv.c, generic/tkCanvText.c, generic/tkEntry.c:
diff --git a/generic/tkButton.c b/generic/tkButton.c
index 9fbc387..616a861 100644
--- a/generic/tkButton.c
+++ b/generic/tkButton.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: tkButton.c,v 1.29 2008/07/23 23:24:21 nijtmans Exp $
+ * RCS: @(#) $Id: tkButton.c,v 1.30 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -753,8 +753,7 @@ ButtonCreate(
return TCL_ERROR;
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin),
- -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(butPtr->tkwin),-1));
return TCL_OK;
}
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index 8852ee8..cc36d5c 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.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: tkCmds.c,v 1.42 2008/06/13 05:46:09 mistachkin Exp $
+ * RCS: @(#) $Id: tkCmds.c,v 1.43 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -715,7 +715,7 @@ Tk_TkObjCmd(
} else /* if (index == TK_CARET_HEIGHT) -- last case */ {
value = caretPtr->height;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
} else {
int i, value, x = 0, y = 0, height = -1;
@@ -761,7 +761,7 @@ Tk_TkObjCmd(
d = 25.4 / 72;
d *= WidthOfScreen(screenPtr);
d /= WidthMMOfScreen(screenPtr);
- Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d));
} else if (objc - skip == 3) {
if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
return TCL_ERROR;
@@ -825,8 +825,8 @@ Tk_TkObjCmd(
"?-displayof window? ?boolean?");
return TCL_ERROR;
}
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- (int) (dispPtr->flags & TK_DISPLAY_USE_IM));
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_USE_IM));
break;
}
case TK_WINDOWINGSYSTEM: {
@@ -843,7 +843,7 @@ Tk_TkObjCmd(
#else
windowingsystem = "x11";
#endif
- Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(windowingsystem, -1));
break;
}
case TK_INACTIVE: {
@@ -1203,7 +1203,6 @@ Tk_WinfoObjCmd(
char *string;
TkWindow *winPtr;
Tk_Window tkwin;
- Tcl_Obj *resultPtr;
static const TkStateMap visualMap[] = {
{PseudoColor, "pseudocolor"},
@@ -1276,14 +1275,14 @@ Tk_WinfoObjCmd(
}
}
winPtr = (TkWindow *) tkwin;
- resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
case WIN_CELLS:
- Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(Tk_Visual(tkwin)->map_entries));
break;
case WIN_CHILDREN: {
- Tcl_Obj *strPtr;
+ Tcl_Obj *strPtr, *resultPtr = Tcl_NewObj();
winPtr = winPtr->childList;
for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
@@ -1292,57 +1291,50 @@ Tk_WinfoObjCmd(
Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
}
+ Tcl_SetObjResult(interp, resultPtr);
break;
}
case WIN_CLASS:
- Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Class(tkwin), -1));
break;
case WIN_COLORMAPFULL:
- Tcl_SetBooleanObj(resultPtr,
- TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(TkpCmapStressed(tkwin,Tk_Colormap(tkwin))));
break;
case WIN_DEPTH:
- Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Depth(tkwin)));
break;
- case WIN_GEOMETRY: {
- char buf[16 + TCL_INTEGER_SPACE * 4];
-
- sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
- Tk_X(tkwin), Tk_Y(tkwin));
- Tcl_SetStringObj(resultPtr, buf, -1);
+ case WIN_GEOMETRY:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d+%d+%d",
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_X(tkwin), Tk_Y(tkwin)));
break;
- }
case WIN_HEIGHT:
- Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Height(tkwin)));
break;
case WIN_ID: {
char buf[TCL_INTEGER_SPACE];
Tk_MakeWindowExist(tkwin);
TkpPrintWindowId(buf, Tk_WindowId(tkwin));
-
- /*
- * interp result may have changed, refetch it
- */
-
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetStringObj(resultPtr, buf, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
break;
}
case WIN_ISMAPPED:
- Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tk_IsMapped(tkwin)));
break;
case WIN_MANAGER:
if (winPtr->geomMgrPtr != NULL) {
- Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(winPtr->geomMgrPtr->name, -1));
}
break;
case WIN_NAME:
- Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Name(tkwin), -1));
break;
case WIN_PARENT:
if (winPtr->parentPtr != NULL) {
- Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(winPtr->parentPtr->pathName, -1));
}
break;
case WIN_POINTERX:
@@ -1366,54 +1358,58 @@ Tk_WinfoObjCmd(
TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
}
if (useX & useY) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *xyObj[2];
- sprintf(buf, "%d %d", x, y);
- Tcl_SetStringObj(resultPtr, buf, -1);
+ xyObj[0] = Tcl_NewIntObj(x);
+ xyObj[1] = Tcl_NewIntObj(y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(xyObj, 2));
} else if (useX) {
- Tcl_SetIntObj(resultPtr, x);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
} else {
- Tcl_SetIntObj(resultPtr, y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
}
break;
case WIN_REQHEIGHT:
- Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqHeight(tkwin)));
break;
case WIN_REQWIDTH:
- Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqWidth(tkwin)));
break;
case WIN_ROOTX:
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_SetIntObj(resultPtr, x);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
break;
case WIN_ROOTY:
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_SetIntObj(resultPtr, y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
break;
- case WIN_SCREEN: {
- char buf[TCL_INTEGER_SPACE];
-
- sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
- Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin),".",buf, NULL);
+ case WIN_SCREEN:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s.%d",
+ Tk_DisplayName(tkwin), Tk_ScreenNumber(tkwin)));
break;
- }
case WIN_SCREENCELLS:
- Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(CellsOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENDEPTH:
- Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENHEIGHT:
- Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(HeightOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENWIDTH:
- Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(WidthOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENMMHEIGHT:
- Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(HeightMMOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENMMWIDTH:
- Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(WidthMMOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENVISUAL:
class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
@@ -1424,7 +1420,7 @@ Tk_WinfoObjCmd(
case WIN_TOPLEVEL:
winPtr = GetTopHierarchy(tkwin);
if (winPtr != NULL) {
- Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->pathName, -1));
}
break;
case WIN_VIEWABLE: {
@@ -1440,7 +1436,7 @@ Tk_WinfoObjCmd(
}
}
- Tcl_SetBooleanObj(resultPtr, viewable);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(viewable));
break;
}
case WIN_VISUAL:
@@ -1451,40 +1447,36 @@ Tk_WinfoObjCmd(
if (string == NULL) {
string = "unknown";
}
- Tcl_SetStringObj(resultPtr, string, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string, -1));
break;
- case WIN_VISUALID: {
- char buf[TCL_INTEGER_SPACE];
-
- sprintf(buf, "0x%x",
- (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
- Tcl_SetStringObj(resultPtr, buf, -1);
+ case WIN_VISUALID:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned)
+ XVisualIDFromVisual(Tk_Visual(tkwin))));
break;
- }
case WIN_VROOTHEIGHT:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(height));
break;
case WIN_VROOTWIDTH:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, width);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(width));
break;
case WIN_VROOTX:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, x);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
break;
case WIN_VROOTY:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
break;
case WIN_WIDTH:
- Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Width(tkwin)));
break;
case WIN_X:
- Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_X(tkwin)));
break;
case WIN_Y:
- Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Y(tkwin)));
break;
/*
@@ -1502,7 +1494,8 @@ Tk_WinfoObjCmd(
}
objv += skip;
string = Tcl_GetString(objv[2]);
- Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
+ Tcl_SetObjResult(interp,
+ Tcl_NewLongObj((long) Tk_InternAtom(tkwin, string)));
break;
case WIN_ATOMNAME: {
const char *name;
@@ -1522,12 +1515,11 @@ Tk_WinfoObjCmd(
}
name = Tk_GetAtomName(tkwin, (Atom) id);
if (strcmp(name, "?bad atom?") == 0) {
- string = Tcl_GetString(objv[2]);
- Tcl_AppendStringsToObj(resultPtr,
- "no atom exists with id \"", string, "\"", NULL);
+ Tcl_AppendResult(interp, "no atom exists with id \"",
+ Tcl_GetString(objv[2]), "\"", NULL);
return TCL_ERROR;
}
- Tcl_SetStringObj(resultPtr, name, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
break;
}
case WIN_CONTAINING:
@@ -1551,12 +1543,10 @@ Tk_WinfoObjCmd(
}
tkwin = Tk_CoordsToWindow(x, y, tkwin);
if (tkwin != NULL) {
- Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1));
}
break;
- case WIN_INTERPS: {
- int result;
-
+ case WIN_INTERPS:
skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
if (skip < 0) {
return TCL_ERROR;
@@ -1565,9 +1555,7 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
return TCL_ERROR;
}
- result = TkGetInterpNames(interp, tkwin);
- return result;
- }
+ return TkGetInterpNames(interp, tkwin);
case WIN_PATHNAME: {
Window id;
@@ -1583,10 +1571,10 @@ Tk_WinfoObjCmd(
if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
return TCL_ERROR;
}
- winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id);
+ winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id);
if ((winPtr == NULL) ||
(winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
- Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
+ Tcl_AppendResult(interp, "window id \"", string,
"\" doesn't exist in this application", NULL);
return TCL_ERROR;
}
@@ -1599,7 +1587,7 @@ Tk_WinfoObjCmd(
tkwin = (Tk_Window) winPtr;
if (Tk_PathName(tkwin) != NULL) {
- Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1));
}
break;
}
@@ -1618,13 +1606,12 @@ Tk_WinfoObjCmd(
string = Tcl_GetString(objv[2]);
winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
Tcl_ResetResult(interp);
- resultPtr = Tcl_GetObjResult(interp);
alive = 1;
if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
alive = 0;
}
- Tcl_SetBooleanObj(resultPtr, alive);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(alive));
break;
}
case WIN_FPIXELS: {
@@ -1634,9 +1621,7 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "window number");
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
@@ -1645,7 +1630,7 @@ Tk_WinfoObjCmd(
}
pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
/ WidthMMOfScreen(Tk_Screen(tkwin));
- Tcl_SetDoubleObj(resultPtr, pixels);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(pixels));
break;
}
case WIN_PIXELS: {
@@ -1655,47 +1640,40 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "window number");
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetIntObj(resultPtr, pixels);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pixels));
break;
}
case WIN_RGB: {
XColor *colorPtr;
- char buf[TCL_INTEGER_SPACE * 3];
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
- string = Tcl_GetString(objv[3]);
- colorPtr = Tk_GetColor(interp, tkwin, string);
+ colorPtr = Tk_GetColor(interp, tkwin, Tcl_GetString(objv[3]));
if (colorPtr == NULL) {
return TCL_ERROR;
}
- sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
- colorPtr->blue);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d",
+ colorPtr->red, colorPtr->green, colorPtr->blue));
Tk_FreeColor(colorPtr);
- Tcl_SetStringObj(resultPtr, buf, -1);
break;
}
case WIN_VISUALSAVAILABLE: {
XVisualInfo template, *visInfoPtr;
int count, i;
int includeVisualId;
- Tcl_Obj *strPtr;
+ Tcl_Obj *strPtr, *resultPtr;
char buf[16 + TCL_INTEGER_SPACE];
char visualIdString[TCL_INTEGER_SPACE];
@@ -1709,9 +1687,7 @@ Tk_WinfoObjCmd(
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
@@ -1719,10 +1695,11 @@ Tk_WinfoObjCmd(
visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
&template, &count);
if (visInfoPtr == NULL) {
- Tcl_SetStringObj(resultPtr,
- "can't find any visuals for screen", -1);
+ Tcl_SetObjResult(interp, "can't find any visuals for screen",
+ TCL_STATIC);
return TCL_ERROR;
}
+ resultPtr = Tcl_NewObj();
for (i = 0; i < count; i++) {
string = TkFindStateString(visualMap, visInfoPtr[i].class);
if (string == NULL) {
@@ -1732,12 +1709,13 @@ Tk_WinfoObjCmd(
}
if (includeVisualId) {
sprintf(visualIdString, " 0x%x",
- (unsigned int) visInfoPtr[i].visualid);
+ (unsigned) visInfoPtr[i].visualid);
strcat(buf, visualIdString);
}
strPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
+ Tcl_SetObjResult(interp, resultPtr);
XFree((char *) visInfoPtr);
break;
}
@@ -2011,8 +1989,8 @@ TkGetDisplayOf(
if ((length >= 2) &&
(strncmp(string, "-displayof", (unsigned) length) == 0)) {
if (objc < 2) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "value for \"-displayof\" missing", -1);
+ Tcl_SetResult(interp, "value for \"-displayof\" missing",
+ TCL_STATIC);
return -1;
}
*tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr);
diff --git a/generic/tkConfig.c b/generic/tkConfig.c
index 5521615..8482871 100644
--- a/generic/tkConfig.c
+++ b/generic/tkConfig.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: tkConfig.c,v 1.27 2008/04/27 22:38:55 dkf Exp $
+ * RCS: @(#) $Id: tkConfig.c,v 1.28 2008/10/05 18:22:21 dkf Exp $
*/
/*
@@ -1223,9 +1223,9 @@ SetOptionFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendResult(interp,
"can't convert value to option except via GetOptionFromObj API",
- -1);
+ NULL);
return TCL_ERROR;
}
@@ -1306,9 +1306,8 @@ Tk_SetOptions(
if (objc < 2) {
if (interp != NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "value for \"", Tcl_GetStringFromObj(*objv, NULL),
- "\" missing", NULL);
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetStringFromObj(*objv, NULL), "\" missing",NULL);
goto error;
}
}
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index fa0c07e..97f64f2 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkEntry.c,v 1.50 2008/10/03 13:13:31 dkf Exp $
+ * RCS: @(#) $Id: tkEntry.c,v 1.51 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -691,7 +691,7 @@ EntryWidgetObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
goto error;
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1));
break;
case COMMAND_ICURSOR:
@@ -3738,8 +3738,7 @@ SpinboxWidgetObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
goto error;
}
- /* FIXME: modification of objresult */
- Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1));
break;
case SB_CMD_ICURSOR:
@@ -3767,9 +3766,8 @@ SpinboxWidgetObjCmd(
}
elem = GetSpinboxElement(sbPtr, x, y);
if (elem != SEL_NONE) {
- /* FIXME: modification of objresult */
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- selElementNames[elem], -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(selElementNames[elem], -1));
}
break;
}
@@ -3990,9 +3988,8 @@ SpinboxWidgetObjCmd(
goto error;
}
if (objc == 3) {
- /* FIXME: modification of objresult */
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- selElementNames[sbPtr->selElement], -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ selElementNames[sbPtr->selElement], -1));
} else {
int lastElement = sbPtr->selElement;
@@ -4018,8 +4015,7 @@ SpinboxWidgetObjCmd(
if (objc == 3) {
EntryValueChanged(entryPtr, Tcl_GetString(objv[2]));
}
- /* FIXME: modification of objresult */
- Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1));
break;
case SB_CMD_VALIDATE: {
diff --git a/generic/tkFont.c b/generic/tkFont.c
index 9326ddb..76e7667 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.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: tkFont.c,v 1.44 2008/07/23 23:24:23 nijtmans Exp $
+ * RCS: @(#) $Id: tkFont.c,v 1.45 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -733,8 +733,8 @@ Tk_FontObjCmd(
return TCL_ERROR;
}
string = Tcl_GetStringFromObj(objv[3 + skip], &length);
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(Tk_TextWidth(tkfont, string, length)));
Tk_FreeFont(tkfont);
break;
}
@@ -763,12 +763,10 @@ Tk_FontObjCmd(
objv += skip;
fmPtr = GetFontMetrics(tkfont);
if (objc == 3) {
- char buf[64 + TCL_INTEGER_SPACE * 4];
-
- sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "-ascent %d -descent %d -linespace %d -fixed %d",
fmPtr->ascent, fmPtr->descent,
- fmPtr->ascent + fmPtr->descent, fmPtr->fixed);
- Tcl_AppendResult(interp, buf, NULL);
+ fmPtr->ascent + fmPtr->descent, fmPtr->fixed));
} else {
if (Tcl_GetIndexFromObj(interp, objv[3], switches, "metric", 0,
&index) != TCL_OK) {
@@ -782,33 +780,35 @@ Tk_FontObjCmd(
case 2: i = fmPtr->ascent + fmPtr->descent; break;
case 3: i = fmPtr->fixed; break;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
}
Tk_FreeFont(tkfont);
break;
}
case FONT_NAMES: {
- char *string;
- NamedFont *nfPtr;
Tcl_HashSearch search;
Tcl_HashEntry *namedHashPtr;
- Tcl_Obj *strPtr, *resultPtr;
+ Tcl_Obj *resultPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "names");
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
+ resultPtr = Tcl_NewObj();
namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
while (namedHashPtr != NULL) {
- nfPtr = Tcl_GetHashValue(namedHashPtr);
+ NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr);
+
if (nfPtr->deletePending == 0) {
- string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
- strPtr = Tcl_NewStringObj(string, -1);
- Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ char *string = Tcl_GetHashKey(&fiPtr->namedTable,
+ namedHashPtr);
+
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(string, -1));
}
namedHashPtr = Tcl_NextHashEntry(&search);
}
+ Tcl_SetObjResult(interp, resultObj);
break;
}
}
@@ -3087,9 +3087,7 @@ GetAttributeInfoObj(
{
int i, index, start, end;
const char *str;
- Tcl_Obj *optionPtr, *valuePtr, *resultPtr;
-
- resultPtr = Tcl_GetObjResult(interp);
+ Tcl_Obj *valuePtr, *resultPtr = NULL;
start = 0;
end = FONT_NUMFIELDS;
@@ -3103,6 +3101,9 @@ GetAttributeInfoObj(
}
valuePtr = NULL;
+ if (objPtr == NULL) {
+ resultPtr = Tcl_NewObj();
+ }
for (i = start; i < end; i++) {
switch (i) {
case FONT_FAMILY:
@@ -3136,10 +3137,11 @@ GetAttributeInfoObj(
Tcl_SetObjResult(interp, valuePtr);
return TCL_OK;
}
- optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
- Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(fontOpt[i], -1));
Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
}
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
diff --git a/generic/tkImage.c b/generic/tkImage.c
index 8b389be..db6352c 100644
--- a/generic/tkImage.c
+++ b/generic/tkImage.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: tkImage.c,v 1.37 2008/07/23 23:24:21 nijtmans Exp $
+ * RCS: @(#) $Id: tkImage.c,v 1.38 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -413,19 +413,20 @@ Tk_ImageObjCmd(
switch ((enum options) index) {
case IMAGE_HEIGHT:
- Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->height));
break;
case IMAGE_INUSE:
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- masterPtr->typePtr!=NULL && masterPtr->instancePtr!=NULL);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ masterPtr->typePtr && masterPtr->instancePtr));
break;
case IMAGE_TYPE:
if (masterPtr->typePtr != NULL) {
- Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(masterPtr->typePtr->name, -1));
}
break;
case IMAGE_WIDTH:
- Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->width);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->width));
break;
default:
Tcl_Panic("can't happen");
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 9644ecf..993ae46 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -17,7 +17,7 @@
* Department of Computer Science,
* Australian National University.
*
- * RCS: @(#) $Id: tkImgPhoto.c,v 1.81 2008/08/28 18:13:34 dgp Exp $
+ * RCS: @(#) $Id: tkImgPhoto.c,v 1.82 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkImgPhoto.h"
@@ -512,6 +512,10 @@ ImgPhotoCmd(
if (length > 1 && !strncmp(arg, "-data", (unsigned) length)) {
Tcl_AppendResult(interp, "-data {} {} {}", NULL);
if (masterPtr->dataString) {
+ /*
+ * TODO: Modifying result is bad!
+ */
+
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
masterPtr->dataString);
} else {
@@ -522,6 +526,10 @@ ImgPhotoCmd(
!strncmp(arg, "-format", (unsigned) length)) {
Tcl_AppendResult(interp, "-format {} {} {}", NULL);
if (masterPtr->format) {
+ /*
+ * TODO: Modifying result is bad!
+ */
+
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
masterPtr->format);
} else {
@@ -532,9 +540,10 @@ ImgPhotoCmd(
return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
configSpecs, (char *) masterPtr, arg, 0);
}
+ } else {
+ return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
}
- return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
- TK_CONFIG_ARGV_ONLY);
case PHOTO_COPY:
/*
@@ -1146,7 +1155,7 @@ ImgPhotoCmd(
return TCL_ERROR;
}
if ((x < 0) || (x >= masterPtr->width)
- || (y < 0) || (y >= masterPtr->height)) {
+ || (y < 0) || (y >= masterPtr->height)) {
Tcl_AppendResult(interp, Tcl_GetString(objv[0]),
" transparency get: coordinates out of range", NULL);
return TCL_ERROR;
@@ -1163,8 +1172,8 @@ ImgPhotoCmd(
TkClipBox(testRegion, &testBox);
TkDestroyRegion(testRegion);
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- (testBox.width==0 && testBox.height==0));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ testBox.width==0 && testBox.height==0));
return TCL_OK;
}
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index 0c91a3a..79f8797 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.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: tkListbox.c,v 1.47 2008/10/03 15:37:02 dkf Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.48 2008/10/05 18:22:21 dkf Exp $
*/
#include "default.h"
@@ -820,8 +820,8 @@ ListboxWidgetObjCmd(
Tcl_SetObjResult(interp, elemPtrs[first]);
} else {
- Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1),
- &(elemPtrs[first]));
+ Tcl_SetObjResult(interp,
+ Tcl_NewListObj(last-first+1, elemPtrs+first));
}
result = TCL_OK;
break;
diff --git a/generic/tkMenu.c b/generic/tkMenu.c
index 650f5d0..fb04861 100644
--- a/generic/tkMenu.c
+++ b/generic/tkMenu.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: tkMenu.c,v 1.43 2008/07/23 23:24:23 nijtmans Exp $
+ * RCS: @(#) $Id: tkMenu.c,v 1.44 2008/10/05 18:22:21 dkf Exp $
*/
/*
@@ -871,7 +871,7 @@ MenuWidgetObjCmd(
if (index < 0) {
Tcl_SetResult(interp, "none", TCL_STATIC);
} else {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
}
break;
}
@@ -959,8 +959,8 @@ MenuWidgetObjCmd(
if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {
Tcl_SetResult(interp, "tearoff", TCL_STATIC);
} else {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- menuEntryTypeStrings[menuPtr->entries[index]->type], -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ menuEntryTypeStrings[menuPtr->entries[index]->type], -1));
}
break;
}
diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c
index 2ae03a0..a5bc369 100644
--- a/generic/tkMenubutton.c
+++ b/generic/tkMenubutton.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: tkMenubutton.c,v 1.21 2008/07/23 23:24:23 nijtmans Exp $
+ * RCS: @(#) $Id: tkMenubutton.c,v 1.22 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -308,7 +308,7 @@ Tk_MenubuttonObjCmd(
return TCL_ERROR;
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(mbPtr->tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(mbPtr->tkwin), -1));
return TCL_OK;
}
diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c
index 9d4a4c2..105af9e 100644
--- a/generic/tkPanedWindow.c
+++ b/generic/tkPanedWindow.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: tkPanedWindow.c,v 1.33 2008/07/23 23:24:21 nijtmans Exp $
+ * RCS: @(#) $Id: tkPanedWindow.c,v 1.34 2008/10/05 18:22:21 dkf Exp $
*/
#include "default.h"
@@ -493,7 +493,7 @@ Tk_PanedWindowObjCmd(
return TCL_ERROR;
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(pwPtr->tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(pwPtr->tkwin), -1));
return TCL_OK;
}
@@ -1109,7 +1109,7 @@ PanedWindowSashCommand(
coords[0] = Tcl_NewIntObj(slavePtr->sashx);
coords[1] = Tcl_NewIntObj(slavePtr->sashy);
- Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
break;
case SASH_MARK:
@@ -1142,7 +1142,7 @@ PanedWindowSashCommand(
} else {
coords[0] = Tcl_NewIntObj(pwPtr->slaves[sash]->markx);
coords[1] = Tcl_NewIntObj(pwPtr->slaves[sash]->marky);
- Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
}
break;
@@ -2787,7 +2787,7 @@ PanedWindowProxyCommand(
coords[0] = Tcl_NewIntObj(pwPtr->proxyx);
coords[1] = Tcl_NewIntObj(pwPtr->proxyy);
- Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
break;
case PROXY_FORGET:
diff --git a/generic/tkSelect.c b/generic/tkSelect.c
index 7c42e60..7f3f9df 100644
--- a/generic/tkSelect.c
+++ b/generic/tkSelect.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: tkSelect.c,v 1.22 2008/07/23 23:24:21 nijtmans Exp $
+ * RCS: @(#) $Id: tkSelect.c,v 1.23 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -1331,7 +1331,6 @@ HandleTclCommand(
char *command, *string;
Tcl_Interp *interp = cmdInfoPtr->interp;
Tcl_DString oldResult;
- Tcl_Obj *objPtr;
int extraBytes, charOffset, count, numChars;
const char *p;
@@ -1384,8 +1383,7 @@ HandleTclCommand(
Tcl_DStringInit(&oldResult);
Tcl_DStringGetResult(interp, &oldResult);
if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
- objPtr = Tcl_GetObjResult(interp);
- string = Tcl_GetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
count = (length > maxBytes) ? maxBytes : length;
memcpy(buffer, string, (size_t) count);
buffer[count] = '\0';
diff --git a/generic/tkTest.c b/generic/tkTest.c
index f4945eb..515e27e 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkTest.c,v 1.37 2008/07/23 23:24:23 nijtmans Exp $
+ * RCS: @(#) $Id: tkTest.c,v 1.38 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkInt.h"
@@ -1314,7 +1314,7 @@ TrivialConfigObjCmd(
headerPtr->optionTable, objc - 2, objv + 2,
tkwin, NULL, &mask);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
}
}
break;
@@ -1324,7 +1324,7 @@ TrivialConfigObjCmd(
tkwin, &saved, &mask);
Tk_FreeSavedOptions(&saved);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
}
break;
}
diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c
index e1d58e8..a0cce5c 100644
--- a/generic/tkTextIndex.c
+++ b/generic/tkTextIndex.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: tkTextIndex.c,v 1.29 2008/04/27 22:38:58 dkf Exp $
+ * RCS: @(#) $Id: tkTextIndex.c,v 1.30 2008/10/05 18:22:22 dkf Exp $
*/
#include "default.h"
@@ -145,9 +145,8 @@ SetTextIndexFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "can't convert value to textindex except via TkTextGetIndexFromObj API",
- -1);
+ Tcl_AppendResult(interp, "can't convert value to textindex except "
+ "via TkTextGetIndexFromObj API", -1);
return TCL_ERROR;
}
diff --git a/macosx/tkMacOSXMenus.c b/macosx/tkMacOSXMenus.c
index f153ce6..e1b0446 100644
--- a/macosx/tkMacOSXMenus.c
+++ b/macosx/tkMacOSXMenus.c
@@ -1,17 +1,17 @@
/*
* tkMacOSXMenus.c --
*
- * These calls set up and manage the menubar for the
- * Macintosh version of Tk.
+ * These calls set up and manage the menubar for the Macintosh version of
+ * Tk.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
- * Copyright 2001, Apple Computer, Inc.
+ * Copyright (c) 2001, Apple Computer, Inc.
* Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net>
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMacOSXMenus.c,v 1.21 2007/12/13 15:27:10 dgp Exp $
+ * RCS: @(#) $Id: tkMacOSXMenus.c,v 1.22 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkMacOSXPrivate.h"
@@ -34,14 +34,13 @@ MenuRef tkAppleMenu;
MenuRef tkFileMenu;
MenuRef tkEditMenu;
-static Tcl_Interp * gInterp = NULL; /* Standard menu interpreter. */
+static Tcl_Interp *gInterp = NULL; /* Standard menu interpreter. */
static EventHandlerRef menuEventHandlerRef = NULL;
-static void GenerateEditEvent(int flag);
-static Tcl_Obj* GetWidgetDemoPath(Tcl_Interp *interp);
-static OSStatus MenuEventHandlerProc(EventHandlerCallRef callRef,
- EventRef event, void *userData);
-
+static void GenerateEditEvent(int flag);
+static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp);
+static OSStatus MenuEventHandlerProc(EventHandlerCallRef callRef,
+ EventRef event, void *userData);
/*
*----------------------------------------------------------------------
@@ -59,11 +58,11 @@ static OSStatus MenuEventHandlerProc(EventHandlerCallRef callRef,
*----------------------------------------------------------------------
*/
-Tcl_Obj*
+static Tcl_Obj *
GetWidgetDemoPath(
Tcl_Interp *interp)
{
- Tcl_Obj *libpath , *result = NULL;
+ Tcl_Obj *libpath, *result = NULL;
libpath = Tcl_GetVar2Ex(gInterp, "tk_library", NULL, TCL_GLOBAL_ONLY);
if (libpath) {
@@ -102,6 +101,7 @@ TkMacOSXHandleMenuSelect(
Tk_Window tkwin;
Window window;
TkDisplay *dispPtr;
+ Tcl_CmdInfo dummy;
if (theItem == 0) {
TkMacOSXClearMenubarActive();
@@ -109,89 +109,84 @@ TkMacOSXHandleMenuSelect(
}
switch (theMenu) {
- case kAppleMenu:
- switch (theItem) {
- case kAppleAboutItem:
- {
- Tcl_CmdInfo dummy;
- if (optionKeyPressed || gInterp == NULL ||
- Tcl_GetCommandInfo(gInterp,
- "tkAboutDialog", &dummy) == 0) {
- TkAboutDlg();
- } else {
- if (Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
- TCL_EVAL_GLOBAL) != TCL_OK) {
- Tcl_BackgroundError(gInterp);
- }
- Tcl_ResetResult(gInterp);
- }
- break;
- }
+ case kAppleMenu:
+ switch (theItem) {
+ case kAppleAboutItem:
+ if (optionKeyPressed || gInterp == NULL ||
+ Tcl_GetCommandInfo(gInterp, "tkAboutDialog", &dummy) == 0) {
+ TkAboutDlg();
+ } else {
+ if (Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
+ TCL_EVAL_GLOBAL) != TCL_OK) {
+ Tcl_BackgroundError(gInterp);
+ }
+ Tcl_ResetResult(gInterp);
}
break;
- case kFileMenu:
- switch (theItem) {
- case kSourceItem:
- if (gInterp) {
- if(Tcl_EvalEx(gInterp, "tk_getOpenFile -filetypes {"
- "{{TCL Scripts} {.tcl} TEXT} "
- "{{Text Files} {} TEXT}}", -1, TCL_EVAL_GLOBAL)
- == TCL_OK) {
- Tcl_Obj *path = Tcl_GetObjResult(gInterp);
- int len;
-
- Tcl_GetStringFromObj(path, &len);
- if (len) {
- Tcl_IncrRefCount(path);
- if (Tcl_FSEvalFile(gInterp, path)
- == TCL_ERROR) {
- Tcl_BackgroundError(gInterp);
- }
- Tcl_DecrRefCount(path);
- }
- }
- Tcl_ResetResult(gInterp);
- }
- break;
- case kDemoItem:
- if (gInterp) {
- Tcl_Obj *path = GetWidgetDemoPath(gInterp);
-
- if (path) {
- Tcl_IncrRefCount(path);
- if (Tcl_FSEvalFile(gInterp, path)
- == TCL_ERROR) {
- Tcl_BackgroundError(gInterp);
- }
- Tcl_DecrRefCount(path);
- Tcl_ResetResult(gInterp);
+ }
+ break;
+ case kFileMenu:
+ switch (theItem) {
+ case kSourceItem:
+ if (gInterp) {
+ if (Tcl_EvalEx(gInterp, "tk_getOpenFile -filetypes {"
+ "{{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}",
+ -1, TCL_EVAL_GLOBAL) == TCL_OK) {
+ Tcl_Obj *path = Tcl_GetObjResult(gInterp);
+ int len;
+
+ Tcl_GetStringFromObj(path, &len);
+ if (len) {
+ Tcl_IncrRefCount(path);
+ if (Tcl_FSEvalFile(gInterp, path) == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
}
+ Tcl_DecrRefCount(path);
}
- break;
- case kCloseItem:
- /* Send close event */
- window = TkMacOSXGetXWindow(ActiveNonFloatingWindow());
- dispPtr = TkGetDisplayList();
- tkwin = Tk_IdToWindow(dispPtr->display, window);
- TkGenWMDestroyEvent(tkwin);
- break;
+ }
+ Tcl_ResetResult(gInterp);
}
break;
- case kEditMenu:
- /*
- * This implementation just send the keysyms Tk thinks are
- * associated with function keys that do Cut, Copy & Paste on
- * a Sun keyboard.
- */
- GenerateEditEvent(theItem);
+ case kDemoItem:
+ if (gInterp) {
+ Tcl_Obj *path = GetWidgetDemoPath(gInterp);
+
+ if (path) {
+ Tcl_IncrRefCount(path);
+ if (Tcl_FSEvalFile(gInterp, path) == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
+ }
+ Tcl_DecrRefCount(path);
+ Tcl_ResetResult(gInterp);
+ }
+ }
break;
- default:
- TkMacOSXDispatchMenuEvent(theMenu, theItem);
+ case kCloseItem:
+ /* Send close event */
+ window = TkMacOSXGetXWindow(ActiveNonFloatingWindow());
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
+ TkGenWMDestroyEvent(tkwin);
break;
+ }
+ break;
+ case kEditMenu:
+ /*
+ * This implementation just send the keysyms Tk thinks are associated
+ * with function keys that do Cut, Copy & Paste on a Sun keyboard.
+ */
+
+ GenerateEditEvent(theItem);
+ break;
+ default:
+ TkMacOSXDispatchMenuEvent(theMenu, theItem);
+ break;
}
+
/*
* Finally we unhighlight the menu.
*/
+
HiliteMenu(0);
}
@@ -327,6 +322,7 @@ TkMacOSXInitMenus(
* kEventCommandUpdateStatus handler), unless the kHICommandPreferences
* menu item has previously been enabled manually. [Bug 1481503]
*/
+
EnableMenuCommand(NULL, kHICommandPreferences);
DrawMenuBar();
@@ -338,8 +334,8 @@ TkMacOSXInitMenus(
*
* GenerateEditEvent --
*
- * Takes an edit menu item and posts the corasponding a virtual
- * event to Tk's event queue.
+ * Takes an edit menu item and posts the corasponding a virtual event to
+ * Tk's event queue.
*
* Results:
* None.
@@ -384,18 +380,25 @@ GenerateEditEvent(
event.same_screen = true;
switch (flag) {
- case EDIT_CUT:
- event.name = Tk_GetUid("Cut");
- break;
- case EDIT_COPY:
- event.name = Tk_GetUid("Copy");
- break;
- case EDIT_PASTE:
- event.name = Tk_GetUid("Paste");
- break;
- case EDIT_CLEAR:
- event.name = Tk_GetUid("Clear");
- break;
+ case EDIT_CUT:
+ event.name = Tk_GetUid("Cut");
+ break;
+ case EDIT_COPY:
+ event.name = Tk_GetUid("Copy");
+ break;
+ case EDIT_PASTE:
+ event.name = Tk_GetUid("Paste");
+ break;
+ case EDIT_CLEAR:
+ event.name = Tk_GetUid("Clear");
+ break;
}
Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL);
}
+
+/*
+ * Local Variables:
+ * fill-column: 78
+ * c-basic-offset: 4
+ * End:
+ */
diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c
index 98b4a9a..11519f3 100644
--- a/macosx/tkMacOSXWm.c
+++ b/macosx/tkMacOSXWm.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMacOSXWm.c,v 1.66 2008/07/23 23:24:44 nijtmans Exp $
+ * RCS: @(#) $Id: tkMacOSXWm.c,v 1.67 2008/10/05 18:22:21 dkf Exp $
*/
#include "tkMacOSXPrivate.h"
@@ -2295,8 +2295,8 @@ WmOverrideredirectCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- Tk_Attributes((Tk_Window) winPtr)->override_redirect);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ Tk_Attributes((Tk_Window) winPtr)->override_redirect));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
@@ -2719,7 +2719,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;
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;
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;
}
/*
generated by cgit v0.12 at 2024-11-25 10:58:39 (GMT)