diff options
Diffstat (limited to 'generic/tkCmds.c')
| -rw-r--r-- | generic/tkCmds.c | 947 |
1 files changed, 411 insertions, 536 deletions
diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 4933d34..2010b6e 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -34,42 +34,6 @@ static void WaitVisibilityProc(ClientData clientData, XEvent *eventPtr); static void WaitWindowProc(ClientData clientData, XEvent *eventPtr); -static int AppnameCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int CaretCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int InactiveCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int ScalingCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int UseinputmethodsCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -static int WindowingsystemCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); - -#if defined(__WIN32__) || defined(MAC_OSX_TK) -MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[]; -#else -#define tkFontchooserEnsemble NULL -#endif - -/* - * Table of tk subcommand names and implementations. - */ - -static const TkEnsemble tkCmdMap[] = { - {"appname", AppnameCmd, NULL }, - {"busy", Tk_BusyObjCmd, NULL }, - {"caret", CaretCmd, NULL }, - {"inactive", InactiveCmd, NULL }, - {"scaling", ScalingCmd, NULL }, - {"useinputmethods", UseinputmethodsCmd, NULL }, - {"windowingsystem", WindowingsystemCmd, NULL }, - {"fontchooser", NULL, tkFontchooserEnsemble}, - {NULL, NULL, NULL} -}; /* *---------------------------------------------------------------------- @@ -95,11 +59,11 @@ Tk_BellObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *const bellOptions[] = { + static const char *bellOptions[] = { "-displayof", "-nice", NULL }; enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE }; - Tk_Window tkwin = clientData; + Tk_Window tkwin = (Tk_Window) clientData; int i, index, nice = 0; if (objc > 4) { @@ -109,8 +73,8 @@ Tk_BellObjCmd( } for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObjStruct(interp, objv[i], bellOptions, - sizeof(char *), "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -160,10 +124,10 @@ Tk_BindObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = clientData; + Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr; ClientData object; - const char *string; + char *string; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?"); @@ -184,7 +148,7 @@ Tk_BindObjCmd( } object = (ClientData) winPtr->pathName; } else { - winPtr = clientData; + winPtr = (TkWindow *) clientData; object = (ClientData) Tk_GetUid(string); } @@ -198,8 +162,9 @@ Tk_BindObjCmd( if (objc == 4) { int append = 0; unsigned long mask; - const char *sequence = Tcl_GetString(objv[2]); - const char *script = Tcl_GetString(objv[3]); + char *sequence, *script; + sequence = Tcl_GetString(objv[2]); + script = Tcl_GetString(objv[3]); /* * If the script is null, just delete the binding. @@ -233,7 +198,7 @@ Tk_BindObjCmd( Tcl_ResetResult(interp); return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); + Tcl_SetResult(interp, (char *) command, TCL_STATIC); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -282,7 +247,8 @@ TkBindEventProc( */ if (winPtr->numTags > MAX_OBJS) { - objPtr = ckalloc(winPtr->numTags * sizeof(ClientData)); + objPtr = (ClientData *) ckalloc((unsigned) + (winPtr->numTags * sizeof(ClientData))); } for (i = 0; i < winPtr->numTags; i++) { p = winPtr->tagPtr[i]; @@ -316,7 +282,7 @@ TkBindEventProc( Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr, count, objPtr); if (objPtr != objects) { - ckfree(objPtr); + ckfree((char *) objPtr); } } @@ -344,10 +310,10 @@ Tk_BindtagsObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = clientData; + Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr, *winPtr2; int i, length; - const char *p; + char *p; Tcl_Obj *listPtr, **tags; if ((objc < 2) || (objc > 3)) { @@ -362,24 +328,24 @@ Tk_BindtagsObjCmd( if (objc == 2) { listPtr = Tcl_NewObj(); if (winPtr->numTags == 0) { - Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); - Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(winPtr->classUid, -1)); winPtr2 = winPtr; while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) { winPtr2 = winPtr2->parentPtr; } if ((winPtr != winPtr2) && (winPtr2 != NULL)) { - Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(winPtr2->pathName, -1)); } - Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("all", -1)); } else { for (i = 0; i < winPtr->numTags; i++) { - Tcl_ListObjAppendElement(NULL, listPtr, - Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1)); + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1)); } } Tcl_SetObjResult(interp, listPtr); @@ -396,7 +362,8 @@ Tk_BindtagsObjCmd( } winPtr->numTags = length; - winPtr->tagPtr = ckalloc(length * sizeof(ClientData)); + winPtr->tagPtr = (ClientData *) ckalloc((unsigned) + (length * sizeof(ClientData))); for (i = 0; i < length; i++) { p = Tcl_GetString(tags[i]); if (p[0] == '.') { @@ -409,7 +376,7 @@ Tk_BindtagsObjCmd( * is one. */ - copy = ckalloc(strlen(p) + 1); + copy = (char *) ckalloc((unsigned) (strlen(p) + 1)); strcpy(copy, p); winPtr->tagPtr[i] = (ClientData) copy; } else { @@ -455,7 +422,7 @@ TkFreeBindingTags( ckfree((char *)p); } } - ckfree(winPtr->tagPtr); + ckfree((char *) winPtr->tagPtr); winPtr->numTags = 0; winPtr->tagPtr = NULL; } @@ -485,7 +452,7 @@ Tk_DestroyObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window window; - Tk_Window tkwin = clientData; + Tk_Window tkwin = (Tk_Window) clientData; int i; for (i = 1; i < objc; i++) { @@ -532,7 +499,7 @@ Tk_LowerObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window mainwin = clientData; + Tk_Window mainwin = (Tk_Window) clientData; Tk_Window tkwin, other; if ((objc != 2) && (objc != 3)) { @@ -553,15 +520,9 @@ Tk_LowerObjCmd( } } if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) { - if (other) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't lower \"%s\" below \"%s\"", - Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); - } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't lower \"%s\" to bottom", Tcl_GetString(objv[1]))); - } - Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", NULL); + Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]), + "\" below \"", (other ? Tcl_GetString(objv[2]) : ""), + "\"", NULL); return TCL_ERROR; } return TCL_OK; @@ -592,7 +553,7 @@ Tk_RaiseObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window mainwin = clientData; + Tk_Window mainwin = (Tk_Window) clientData; Tk_Window tkwin, other; if ((objc != 2) && (objc != 3)) { @@ -613,56 +574,21 @@ Tk_RaiseObjCmd( } } if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) { - if (other) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't raise \"%s\" above \"%s\"", - Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); - } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't raise \"%s\" to top", Tcl_GetString(objv[1]))); - } - Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", NULL); + Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]), + "\" above \"", (other ? Tcl_GetString(objv[2]) : ""), + "\"", NULL); return TCL_ERROR; } return TCL_OK; } /* - * ---------------------------------------------------------------------- - * - * TkInitTkCmd -- - * - * Set up the tk ensemble. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - * ---------------------------------------------------------------------- - */ - -int -TkInitTkCmd( - Tcl_Interp *interp, - ClientData clientData) -{ - TkMakeEnsemble(interp, "::", "tk", clientData, tkCmdMap); -#if defined(__WIN32__) || defined(MAC_OSX_TK) - TkInitFontchooser(interp, clientData); -#endif - return TCL_OK; -} - -/* *---------------------------------------------------------------------- * - * AppnameCmd, CaretCmd, ScalingCmd, UseinputmethodsCmd, - * WindowingsystemCmd, InactiveCmd -- + * Tk_TkObjCmd -- * - * These functions are invoked to process the "tk" ensemble subcommands. - * See the user documentation for details on what they do. + * This function is invoked to process the "tk" Tcl command. See the user + * documentation for details on what it does. * * Results: * A standard Tcl result. @@ -674,299 +600,286 @@ TkInitTkCmd( */ int -AppnameCmd( +Tk_TkObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = clientData; - TkWindow *winPtr; - const char *string; - - if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "appname not accessible in a safe interpreter", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "APPLICATION", NULL); - return TCL_ERROR; - } - - winPtr = (TkWindow *) tkwin; - - if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?newName?"); - return TCL_ERROR; - } - if (objc == 2) { - string = Tcl_GetString(objv[1]); - winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); - } - Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); - return TCL_OK; -} - -int -CaretCmd( - ClientData clientData, /* Main window associated with interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - Tk_Window tkwin = clientData; int index; - Tcl_Obj *objPtr; - TkCaret *caretPtr; - Tk_Window window; - static const char *const caretStrings[] = { - "-x", "-y", "-height", NULL + Tk_Window tkwin; + static const char *optionStrings[] = { + "appname", "caret", "scaling", "useinputmethods", + "windowingsystem", "inactive", NULL }; - enum caretOptions { - TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT + enum options { + TK_APPNAME, TK_CARET, TK_SCALING, TK_USE_IM, + TK_WINDOWINGSYSTEM, TK_INACTIVE }; - if ((objc < 2) || ((objc > 3) && !!(objc & 1))) { - Tcl_WrongNumArgs(interp, 1, objv, - "window ?-x x? ?-y y? ?-height height?"); + tkwin = (Tk_Window) clientData; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; } - window = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin); - if (window == NULL) { + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } - caretPtr = &(((TkWindow *) window)->dispPtr->caret); - if (objc == 2) { - /* - * Return all the current values - */ - objPtr = Tcl_NewObj(); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-height", 7)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->height)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-x", 2)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->x)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-y", 2)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->y)); - Tcl_SetObjResult(interp, objPtr); - } else if (objc == 3) { - int value; + switch ((enum options) index) { + case TK_APPNAME: { + TkWindow *winPtr; + char *string; - /* - * Return the current value of the selected option - */ + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "appname not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; + } - if (Tcl_GetIndexFromObj(interp, objv[2], caretStrings, - "caret option", 0, &index) != TCL_OK) { + winPtr = (TkWindow *) tkwin; + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?newName?"); return TCL_ERROR; } - if (index == TK_CARET_X) { - value = caretPtr->x; - } else if (index == TK_CARET_Y) { - value = caretPtr->y; - } else /* if (index == TK_CARET_HEIGHT) -- last case */ { - value = caretPtr->height; + if (objc == 3) { + string = Tcl_GetString(objv[2]); + winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); } - Tcl_SetObjResult(interp, Tcl_NewIntObj(value)); - } else { - int i, value, x = 0, y = 0, height = -1; + Tcl_AppendResult(interp, winPtr->nameUid, NULL); + break; + } + case TK_CARET: { + Tcl_Obj *objPtr; + TkCaret *caretPtr; + Tk_Window window; + static const char *caretStrings[] = { + "-x", "-y", "-height", NULL + }; + enum caretOptions { + TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT + }; + + if ((objc < 3) || ((objc > 4) && !(objc & 1))) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?-x x? ?-y y? ?-height height?"); + return TCL_ERROR; + } + window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + if (window == NULL) { + return TCL_ERROR; + } + caretPtr = &(((TkWindow *) window)->dispPtr->caret); + if (objc == 3) { + /* + * Return all the current values + */ + + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-height", 7)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->height)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-x", 2)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->x)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-y", 2)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->y)); + Tcl_SetObjResult(interp, objPtr); + } else if (objc == 4) { + int value; + + /* + * Return the current value of the selected option + */ - for (i = 2; i < objc; i += 2) { - if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings, - "caret option", 0, &index) != TCL_OK) || - Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings, + "caret option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == TK_CARET_X) { - x = value; + value = caretPtr->x; } else if (index == TK_CARET_Y) { - y = value; + value = caretPtr->y; } else /* if (index == TK_CARET_HEIGHT) -- last case */ { - height = value; + value = caretPtr->height; } - } - if (height < 0) { - height = Tk_Height(window); - } - Tk_SetCaretPos(window, x, y, height); - } - return TCL_OK; -} + Tcl_SetIntObj(Tcl_GetObjResult(interp), value); + } else { + int i, value, x = 0, y = 0, height = -1; -int -ScalingCmd( - ClientData clientData, /* Main window associated with interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - Tk_Window tkwin = clientData; - Screen *screenPtr; - int skip, width, height; - double d; - - if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "scaling not accessible in a safe interpreter", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL); - return TCL_ERROR; + for (i = 3; i < objc; i += 2) { + if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings, + "caret option", 0, &index) != TCL_OK) || + Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) { + return TCL_ERROR; + } + if (index == TK_CARET_X) { + x = value; + } else if (index == TK_CARET_Y) { + y = value; + } else /* if (index == TK_CARET_HEIGHT) -- last case */ { + height = value; + } + } + if (height < 0) { + height = Tk_Height(window); + } + Tk_SetCaretPos(window, x, y, height); + } + break; } + case TK_SCALING: { + Screen *screenPtr; + int skip, width, height; + double d; - skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin); - if (skip < 0) { - return TCL_ERROR; - } - screenPtr = Tk_Screen(tkwin); - if (objc - skip == 1) { - d = 25.4 / 72; - d *= WidthOfScreen(screenPtr); - d /= WidthMMOfScreen(screenPtr); - Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d)); - } else if (objc - skip == 2) { - if (Tcl_GetDoubleFromObj(interp, objv[1+skip], &d) != TCL_OK) { + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "scaling not accessible in a safe interpreter", + TCL_STATIC); return TCL_ERROR; } - d = (25.4 / 72) / d; - width = (int) (d * WidthOfScreen(screenPtr) + 0.5); - if (width <= 0) { - width = 1; + + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + if (skip < 0) { + return TCL_ERROR; } - height = (int) (d * HeightOfScreen(screenPtr) + 0.5); - if (height <= 0) { - height = 1; + screenPtr = Tk_Screen(tkwin); + if (objc - skip == 2) { + d = 25.4 / 72; + d *= WidthOfScreen(screenPtr); + d /= WidthMMOfScreen(screenPtr); + Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d); + } else if (objc - skip == 3) { + if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) { + return TCL_ERROR; + } + d = (25.4 / 72) / d; + width = (int) (d * WidthOfScreen(screenPtr) + 0.5); + if (width <= 0) { + width = 1; + } + height = (int) (d * HeightOfScreen(screenPtr) + 0.5); + if (height <= 0) { + height = 1; + } + WidthMMOfScreen(screenPtr) = width; + HeightMMOfScreen(screenPtr) = height; + } else { + Tcl_WrongNumArgs(interp, 2, objv, + "?-displayof window? ?factor?"); + return TCL_ERROR; } - WidthMMOfScreen(screenPtr) = width; - HeightMMOfScreen(screenPtr) = height; - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?factor?"); - return TCL_ERROR; - } - return TCL_OK; -} - -int -UseinputmethodsCmd( - ClientData clientData, /* Main window associated with interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - Tk_Window tkwin = clientData; - TkDisplay *dispPtr; - int skip; - - if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "useinputmethods not accessible in a safe interpreter", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "INPUT_METHODS", NULL); - return TCL_ERROR; + break; } + case TK_USE_IM: { + TkDisplay *dispPtr; + int skip; - skip = TkGetDisplayOf(interp, objc-1, objv+1, &tkwin); - if (skip < 0) { - return TCL_ERROR; - } - dispPtr = ((TkWindow *) tkwin)->dispPtr; - if ((objc - skip) == 2) { - /* - * In the case where TK_USE_INPUT_METHODS is not defined, this - * will be ignored and we will always return 0. That will indicate - * to the user that input methods are just not available. - */ - - int boolVal; + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "useinputmethods not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; + } - if (Tcl_GetBooleanFromObj(interp, objv[1+skip], - &boolVal) != TCL_OK) { + skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin); + if (skip < 0) { return TCL_ERROR; } + dispPtr = ((TkWindow *) tkwin)->dispPtr; + if ((objc - skip) == 3) { + /* + * In the case where TK_USE_INPUT_METHODS is not defined, this + * will be ignored and we will always return 0. That will indicate + * to the user that input methods are just not available. + */ + + int boolVal; + + if (Tcl_GetBooleanFromObj(interp, objv[2+skip], + &boolVal) != TCL_OK) { + return TCL_ERROR; + } #ifdef TK_USE_INPUT_METHODS - if (boolVal) { - dispPtr->flags |= TK_DISPLAY_USE_IM; - } else { - dispPtr->flags &= ~TK_DISPLAY_USE_IM; - } + if (boolVal) { + dispPtr->flags |= TK_DISPLAY_USE_IM; + } else { + dispPtr->flags &= ~TK_DISPLAY_USE_IM; + } #endif /* TK_USE_INPUT_METHODS */ - } else if ((objc - skip) != 1) { - Tcl_WrongNumArgs(interp, 1, objv, - "?-displayof window? ?boolean?"); - return TCL_ERROR; + } else if ((objc - skip) != 2) { + Tcl_WrongNumArgs(interp, 2, objv, + "?-displayof window? ?boolean?"); + return TCL_ERROR; + } + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), + (int) (dispPtr->flags & TK_DISPLAY_USE_IM)); + break; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_USE_IM)); - return TCL_OK; -} - -int -WindowingsystemCmd( - ClientData clientData, /* Main window associated with interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - const char *windowingsystem; + case TK_WINDOWINGSYSTEM: { + const char *windowingsystem; - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); - return TCL_ERROR; - } + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } #if defined(WIN32) - windowingsystem = "win32"; + windowingsystem = "win32"; #elif defined(MAC_OSX_TK) - windowingsystem = "aqua"; + windowingsystem = "aqua"; #else - windowingsystem = "x11"; + windowingsystem = "x11"; #endif - Tcl_SetObjResult(interp, Tcl_NewStringObj(windowingsystem, -1)); - return TCL_OK; -} - -int -InactiveCmd( - ClientData clientData, /* Main window associated with interpreter. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - Tk_Window tkwin = clientData; - int skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin); - - if (skip < 0) { - return TCL_ERROR; + Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1); + break; } - if (objc - skip == 1) { - long inactive; - - inactive = (Tcl_IsSafe(interp) ? -1 : - Tk_GetUserInactiveTime(Tk_Display(tkwin))); - Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); - } else if (objc - skip == 2) { - const char *string; - - string = Tcl_GetString(objv[objc-1]); - if (strcmp(string, "reset") != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be reset", string)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", - string, NULL); + case TK_INACTIVE: { + int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + + if (skip < 0) { return TCL_ERROR; } - if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "resetting the user inactivity timer " - "is not allowed in a safe interpreter", -1)); - Tcl_SetErrorCode(interp, "TK", "SAFE", "INACTIVITY_TIMER", NULL); + if (objc - skip == 2) { + long inactive; + + inactive = (Tcl_IsSafe(interp) ? -1 : + Tk_GetUserInactiveTime(Tk_Display(tkwin))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); + + } else if (objc - skip == 3) { + char *string; + + string = Tcl_GetString(objv[objc-1]); + if (strcmp(string, "reset") != 0) { + Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1); + + Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL); + Tcl_SetObjResult(interp, msg); + return TCL_ERROR; + } + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "resetting the user inactivity timer " + "is not allowed in a safe interpreter", TCL_STATIC); + return TCL_ERROR; + } + Tk_ResetUserInactiveTime(Tk_Display(tkwin)); + Tcl_ResetResult(interp); + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? ?reset?"); return TCL_ERROR; } - Tk_ResetUserInactiveTime(Tk_Display(tkwin)); - Tcl_ResetResult(interp); - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?reset?"); - return TCL_ERROR; + break; + } } return TCL_OK; } @@ -996,10 +909,9 @@ Tk_TkwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = clientData; + Tk_Window tkwin = (Tk_Window) clientData; int done, index; - int code = TCL_OK; - static const char *const optionStrings[] = { + static const char *optionStrings[] = { "variable", "visibility", "window", NULL }; enum options { @@ -1018,22 +930,18 @@ Tk_TkwaitObjCmd( switch ((enum options) index) { case TKWAIT_VARIABLE: - if (Tcl_TraceVar2(interp, Tcl_GetString(objv[2]), - NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - WaitVariableProc, &done) != TCL_OK) { + if (Tcl_TraceVar(interp, Tcl_GetString(objv[2]), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, (ClientData) &done) != TCL_OK) { return TCL_ERROR; } done = 0; while (!done) { - if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { - code = TCL_ERROR; - break; - } Tcl_DoOneEvent(0); } - Tcl_UntraceVar2(interp, Tcl_GetString(objv[2]), - NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - WaitVariableProc, &done); + Tcl_UntraceVar(interp, Tcl_GetString(objv[2]), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, (ClientData) &done); break; case TKWAIT_VISIBILITY: { @@ -1045,31 +953,25 @@ Tk_TkwaitObjCmd( } Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask, - WaitVisibilityProc, &done); + WaitVisibilityProc, (ClientData) &done); done = 0; while (!done) { - if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { - code = TCL_ERROR; - break; - } Tcl_DoOneEvent(0); } - if ((done != 0) && (done != 1)) { + if (done != 1) { /* * Note that we do not delete the event handler because it was * deleted automatically when the window was destroyed. */ Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "window \"%s\" was deleted before its visibility changed", - Tcl_GetString(objv[2]))); - Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL); + Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]), + "\" was deleted before its visibility changed", NULL); return TCL_ERROR; } Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask, - WaitVisibilityProc, &done); + WaitVisibilityProc, (ClientData) &done); break; } @@ -1081,40 +983,28 @@ Tk_TkwaitObjCmd( return TCL_ERROR; } Tk_CreateEventHandler(window, StructureNotifyMask, - WaitWindowProc, &done); + WaitWindowProc, (ClientData) &done); done = 0; while (!done) { - if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { - code = TCL_ERROR; - break; - } Tcl_DoOneEvent(0); } /* - * Note: normally there's no need to delete the event handler. It was - * deleted automatically when the window was destroyed; however, if - * the wait operation was canceled, we need to delete it. + * Note: there's no need to delete the event handler. It was deleted + * automatically when the window was destroyed. */ - if (done == 0) { - Tk_DeleteEventHandler(window, StructureNotifyMask, - WaitWindowProc, &done); - } break; } } /* * Clear out the interpreter's result, since it may have been set by event - * handlers. This is skipped if an error occurred above, such as the wait - * operation being canceled. + * handlers. */ - if (code == TCL_OK) Tcl_ResetResult(interp); - - return code; + return TCL_OK; } /* ARGSUSED */ @@ -1126,7 +1016,7 @@ WaitVariableProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - int *donePtr = clientData; + int *donePtr = (int *) clientData; *donePtr = 1; return NULL; @@ -1138,11 +1028,12 @@ WaitVisibilityProc( ClientData clientData, /* Pointer to integer to set to 1. */ XEvent *eventPtr) /* Information about event (not used). */ { - int *donePtr = clientData; + int *donePtr = (int *) clientData; if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } else if (eventPtr->type == DestroyNotify) { + } + if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1152,7 +1043,7 @@ WaitWindowProc( ClientData clientData, /* Pointer to integer to set to 1. */ XEvent *eventPtr) /* Information about event. */ { - int *donePtr = clientData; + int *donePtr = (int *) clientData; if (eventPtr->type == DestroyNotify) { *donePtr = 1; @@ -1184,10 +1075,9 @@ Tk_UpdateObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *const updateOptions[] = {"idletasks", NULL}; + static const char *updateOptions[] = {"idletasks", NULL}; int flags, index; TkDisplay *dispPtr; - int code = TCL_OK; if (objc == 1) { flags = TCL_DONT_WAIT; @@ -1212,35 +1102,12 @@ Tk_UpdateObjCmd( while (1) { while (Tcl_DoOneEvent(flags) != 0) { - if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { - code = TCL_ERROR; - break; - } + /* Empty loop body */ } - - /* - * If event processing was canceled proceed no further. - */ - - if (code == TCL_ERROR) - break; - for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XSync(dispPtr->display, False); } - - /* - * Check again if event processing has been canceled because the inner - * loop (above) may not have checked (i.e. no events were processed and - * the loop body was skipped). - */ - - if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { - code = TCL_ERROR; - break; - } - if (Tcl_DoOneEvent(flags) == 0) { break; } @@ -1248,14 +1115,11 @@ Tk_UpdateObjCmd( /* * Must clear the interpreter's result because event handlers could have - * executed commands. This is skipped if an error occurred above, such as - * the wait operation being canceled. + * executed commands. */ - if (code == TCL_OK) Tcl_ResetResult(interp); - - return code; + return TCL_OK; } /* @@ -1283,9 +1147,10 @@ Tk_WinfoObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int index, x, y, width, height, useX, useY, class, skip; - const char *string; + char *string; TkWindow *winPtr; - Tk_Window tkwin = clientData; + Tk_Window tkwin; + Tcl_Obj *resultPtr; static const TkStateMap visualMap[] = { {PseudoColor, "pseudocolor"}, @@ -1296,7 +1161,7 @@ Tk_WinfoObjCmd( {StaticGray, "staticgray"}, {-1, NULL} }; - static const char *const optionStrings[] = { + static const char *optionStrings[] = { "cells", "children", "class", "colormapfull", "depth", "geometry", "height", "id", "ismapped", "manager", "name", "parent", @@ -1335,6 +1200,8 @@ Tk_WinfoObjCmd( WIN_VISUALSAVAILABLE }; + tkwin = (Tk_Window) clientData; + if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; @@ -1356,14 +1223,14 @@ Tk_WinfoObjCmd( } } winPtr = (TkWindow *) tkwin; + resultPtr = Tcl_GetObjResult(interp); switch ((enum options) index) { case WIN_CELLS: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tk_Visual(tkwin)->map_entries)); + Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries); break; case WIN_CHILDREN: { - Tcl_Obj *strPtr, *resultPtr = Tcl_NewObj(); + Tcl_Obj *strPtr; winPtr = winPtr->childList; for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) { @@ -1372,50 +1239,57 @@ Tk_WinfoObjCmd( Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } } - Tcl_SetObjResult(interp, resultPtr); break; } case WIN_CLASS: - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Class(tkwin), -1)); + Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1); break; case WIN_COLORMAPFULL: - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj(TkpCmapStressed(tkwin,Tk_Colormap(tkwin)))); + Tcl_SetBooleanObj(resultPtr, + TkpCmapStressed(tkwin, Tk_Colormap(tkwin))); break; case WIN_DEPTH: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Depth(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin)); break; - case WIN_GEOMETRY: - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d+%d+%d", - Tk_Width(tkwin), Tk_Height(tkwin), Tk_X(tkwin), Tk_Y(tkwin))); + 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); break; + } case WIN_HEIGHT: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Height(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_Height(tkwin)); break; case WIN_ID: { char buf[TCL_INTEGER_SPACE]; Tk_MakeWindowExist(tkwin); TkpPrintWindowId(buf, Tk_WindowId(tkwin)); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + + /* + * interp result may have changed, refetch it + */ + + resultPtr = Tcl_GetObjResult(interp); + Tcl_SetStringObj(resultPtr, buf, -1); break; } case WIN_ISMAPPED: - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tk_IsMapped(tkwin))); + Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin)); break; case WIN_MANAGER: if (winPtr->geomMgrPtr != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(winPtr->geomMgrPtr->name, -1)); + Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1); } break; case WIN_NAME: - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Name(tkwin), -1)); + Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1); break; case WIN_PARENT: if (winPtr->parentPtr != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(winPtr->parentPtr->pathName, -1)); + Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1); } break; case WIN_POINTERX: @@ -1439,58 +1313,54 @@ Tk_WinfoObjCmd( TkGetPointerCoords((Tk_Window) winPtr, &x, &y); } if (useX & useY) { - Tcl_Obj *xyObj[2]; + char buf[TCL_INTEGER_SPACE * 2]; - xyObj[0] = Tcl_NewIntObj(x); - xyObj[1] = Tcl_NewIntObj(y); - Tcl_SetObjResult(interp, Tcl_NewListObj(2, xyObj)); + sprintf(buf, "%d %d", x, y); + Tcl_SetStringObj(resultPtr, buf, -1); } else if (useX) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(x)); + Tcl_SetIntObj(resultPtr, x); } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(y)); + Tcl_SetIntObj(resultPtr, y); } break; case WIN_REQHEIGHT: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqHeight(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin)); break; case WIN_REQWIDTH: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqWidth(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin)); break; case WIN_ROOTX: Tk_GetRootCoords(tkwin, &x, &y); - Tcl_SetObjResult(interp, Tcl_NewIntObj(x)); + Tcl_SetIntObj(resultPtr, x); break; case WIN_ROOTY: Tk_GetRootCoords(tkwin, &x, &y); - Tcl_SetObjResult(interp, Tcl_NewIntObj(y)); + Tcl_SetIntObj(resultPtr, y); break; - case WIN_SCREEN: - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s.%d", - Tk_DisplayName(tkwin), Tk_ScreenNumber(tkwin))); + case WIN_SCREEN: { + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "%d", Tk_ScreenNumber(tkwin)); + Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin),".",buf, NULL); break; + } case WIN_SCREENCELLS: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(CellsOfScreen(Tk_Screen(tkwin)))); + Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin))); break; case WIN_SCREENDEPTH: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin)))); + Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin))); break; case WIN_SCREENHEIGHT: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(HeightOfScreen(Tk_Screen(tkwin)))); + Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin))); break; case WIN_SCREENWIDTH: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(WidthOfScreen(Tk_Screen(tkwin)))); + Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin))); break; case WIN_SCREENMMHEIGHT: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(HeightMMOfScreen(Tk_Screen(tkwin)))); + Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin))); break; case WIN_SCREENMMWIDTH: - Tcl_SetObjResult(interp, - Tcl_NewIntObj(WidthMMOfScreen(Tk_Screen(tkwin)))); + Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin))); break; case WIN_SCREENVISUAL: class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class; @@ -1501,7 +1371,7 @@ Tk_WinfoObjCmd( case WIN_TOPLEVEL: winPtr = GetTopHierarchy(tkwin); if (winPtr != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->pathName, -1)); + Tcl_SetStringObj(resultPtr, winPtr->pathName, -1); } break; case WIN_VIEWABLE: { @@ -1517,7 +1387,7 @@ Tk_WinfoObjCmd( } } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(viewable)); + Tcl_SetBooleanObj(resultPtr, viewable); break; } case WIN_VISUAL: @@ -1528,36 +1398,40 @@ Tk_WinfoObjCmd( if (string == NULL) { string = "unknown"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(string, -1)); + Tcl_SetStringObj(resultPtr, string, -1); break; - case WIN_VISUALID: - Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) - XVisualIDFromVisual(Tk_Visual(tkwin)))); + case WIN_VISUALID: { + char buf[TCL_INTEGER_SPACE]; + + sprintf(buf, "0x%x", + (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin))); + Tcl_SetStringObj(resultPtr, buf, -1); break; + } case WIN_VROOTHEIGHT: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_NewIntObj(height)); + Tcl_SetIntObj(resultPtr, height); break; case WIN_VROOTWIDTH: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_NewIntObj(width)); + Tcl_SetIntObj(resultPtr, width); break; case WIN_VROOTX: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_NewIntObj(x)); + Tcl_SetIntObj(resultPtr, x); break; case WIN_VROOTY: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_NewIntObj(y)); + Tcl_SetIntObj(resultPtr, y); break; case WIN_WIDTH: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Width(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_Width(tkwin)); break; case WIN_X: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_X(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_X(tkwin)); break; case WIN_Y: - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Y(tkwin))); + Tcl_SetIntObj(resultPtr, Tk_Y(tkwin)); break; /* @@ -1575,8 +1449,7 @@ Tk_WinfoObjCmd( } objv += skip; string = Tcl_GetString(objv[2]); - Tcl_SetObjResult(interp, - Tcl_NewLongObj((long) Tk_InternAtom(tkwin, string))); + Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string)); break; case WIN_ATOMNAME: { const char *name; @@ -1596,13 +1469,12 @@ Tk_WinfoObjCmd( } name = Tk_GetAtomName(tkwin, (Atom) id); if (strcmp(name, "?bad atom?") == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no atom exists with id \"%s\"", Tcl_GetString(objv[2]))); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM", - Tcl_GetString(objv[2]), NULL); + string = Tcl_GetString(objv[2]); + Tcl_AppendStringsToObj(resultPtr, + "no atom exists with id \"", string, "\"", NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); + Tcl_SetStringObj(resultPtr, name, -1); break; } case WIN_CONTAINING: @@ -1626,7 +1498,7 @@ Tk_WinfoObjCmd( } tkwin = Tk_CoordsToWindow(x, y, tkwin); if (tkwin != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1)); + Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } break; case WIN_INTERPS: @@ -1654,13 +1526,11 @@ 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_SetObjResult(interp, Tcl_ObjPrintf( - "window id \"%s\" doesn't exist in this application", - string)); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, NULL); + Tcl_AppendStringsToObj(resultPtr, "window id \"", string, + "\" doesn't exist in this application", NULL); return TCL_ERROR; } @@ -1672,7 +1542,7 @@ Tk_WinfoObjCmd( tkwin = (Tk_Window) winPtr; if (Tk_PathName(tkwin) != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1)); + Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } break; } @@ -1691,12 +1561,13 @@ 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_SetObjResult(interp, Tcl_NewBooleanObj(alive)); + Tcl_SetBooleanObj(resultPtr, alive); break; } case WIN_FPIXELS: { @@ -1706,7 +1577,9 @@ Tk_WinfoObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "window number"); return TCL_ERROR; } - if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { + string = Tcl_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); @@ -1715,7 +1588,7 @@ Tk_WinfoObjCmd( } pixels = mm * WidthOfScreen(Tk_Screen(tkwin)) / WidthMMOfScreen(Tk_Screen(tkwin)); - Tcl_SetObjResult(interp, Tcl_NewDoubleObj(pixels)); + Tcl_SetDoubleObj(resultPtr, pixels); break; } case WIN_PIXELS: { @@ -1725,40 +1598,47 @@ Tk_WinfoObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "window number"); return TCL_ERROR; } - if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { + string = Tcl_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(pixels)); + Tcl_SetIntObj(resultPtr, 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; } - if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { + string = Tcl_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { return TCL_ERROR; } - colorPtr = Tk_GetColor(interp, tkwin, Tcl_GetString(objv[3])); + string = Tcl_GetString(objv[3]); + colorPtr = Tk_GetColor(interp, tkwin, string); if (colorPtr == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d", - colorPtr->red, colorPtr->green, colorPtr->blue)); + sprintf(buf, "%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, *resultPtr; + Tcl_Obj *strPtr; char buf[16 + TCL_INTEGER_SPACE]; char visualIdString[TCL_INTEGER_SPACE]; @@ -1772,7 +1652,9 @@ Tk_WinfoObjCmd( return TCL_ERROR; } - if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { + string = Tcl_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { return TCL_ERROR; } @@ -1780,12 +1662,10 @@ Tk_WinfoObjCmd( visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask, &template, &count); if (visInfoPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't find any visuals for screen", -1)); - Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", NULL); + Tcl_SetStringObj(resultPtr, + "can't find any visuals for screen", -1); return TCL_ERROR; } - resultPtr = Tcl_NewObj(); for (i = 0; i < count; i++) { string = TkFindStateString(visualMap, visInfoPtr[i].class); if (string == NULL) { @@ -1795,13 +1675,12 @@ Tk_WinfoObjCmd( } if (includeVisualId) { sprintf(visualIdString, " 0x%x", - (unsigned) visInfoPtr[i].visualid); + (unsigned int) visInfoPtr[i].visualid); strcat(buf, visualIdString); } strPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } - Tcl_SetObjResult(interp, resultPtr); XFree((char *) visInfoPtr); break; } @@ -1838,7 +1717,7 @@ Tk_WmObjCmd( Tk_Window tkwin; TkWindow *winPtr; - static const char *const optionStrings[] = { + static const char *optionStrings[] = { "aspect", "client", "command", "deiconify", "focusmodel", "frame", "geometry", "grid", "group", "iconbitmap", "iconify", "iconmask", @@ -1877,8 +1756,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetObjResult(interp, Tcl_NewBooleanObj( - dispPtr->flags & TK_DISPLAY_WM_TRACING)); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1903,10 +1782,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "window \"%s\" isn't a top-level window", winPtr->pathName)); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, - NULL); + Tcl_AppendResult(interp, "window \"", winPtr->pathName, + "\" isn't a top-level window", NULL); return TCL_ERROR; } @@ -2020,7 +1897,7 @@ Tk_WmObjCmd( updateGeom: if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } return TCL_OK; @@ -2067,7 +1944,7 @@ TkGetDisplayOf( * unmodified if "-displayof" argument was not * present. */ { - const char *string; + char *string; int length; if (objc < 1) { @@ -2077,9 +1954,8 @@ TkGetDisplayOf( if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) { if (objc < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "value for \"-displayof\" missing", -1)); - Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL); + Tcl_SetStringObj(Tcl_GetObjResult(interp), + "value for \"-displayof\" missing", -1); return -1; } *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr); @@ -2117,9 +1993,8 @@ TkDeadAppCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't invoke \"%s\" command: application has been destroyed", - argv[0])); + Tcl_AppendResult(interp, "can't invoke \"", argv[0], + "\" command: application has been destroyed", NULL); return TCL_ERROR; } |