From 501d0b1523e4a2b370c58cd262bbed99725a5ab1 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 5 Oct 2008 18:22:21 +0000 Subject: Greatly clean up Tk's handling of the writability of the Tcl result object. --- ChangeLog | 27 +++++++ generic/tkButton.c | 5 +- generic/tkCmds.c | 206 +++++++++++++++++++++--------------------------- generic/tkConfig.c | 11 ++- generic/tkEntry.c | 20 ++--- generic/tkFont.c | 46 +++++------ generic/tkImage.c | 13 +-- generic/tkImgPhoto.c | 21 +++-- generic/tkListbox.c | 6 +- generic/tkMenu.c | 8 +- generic/tkMenubutton.c | 4 +- generic/tkPanedWindow.c | 10 +-- generic/tkSelect.c | 6 +- generic/tkTest.c | 6 +- generic/tkTextIndex.c | 7 +- macosx/tkMacOSXMenus.c | 201 +++++++++++++++++++++++----------------------- macosx/tkMacOSXWm.c | 8 +- unix/tkUnixEvent.c | 10 ++- unix/tkUnixFont.c | 9 ++- unix/tkUnixWm.c | 6 +- win/tkWinDialog.c | 18 +++-- win/tkWinFont.c | 24 +++--- win/tkWinSend.c | 8 +- win/tkWinSendCom.c | 10 +-- win/tkWinWm.c | 112 +++++++++++--------------- 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 + + * 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 * 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 * - * 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; } /* -- cgit v0.12