diff options
Diffstat (limited to 'generic')
57 files changed, 1431 insertions, 1217 deletions
diff --git a/generic/tkBind.c b/generic/tkBind.c index c051c7a..93a6a52 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -2927,7 +2927,7 @@ HandleEventGenerate( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "window id \"%s\" doesn't exist in this application", Tcl_GetString(objv[0]))); - Tcl_SetErrorCode(interp, "TK", "EVENT", "FOREIGN_TARGET", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", NULL); return TCL_ERROR; } @@ -2941,14 +2941,14 @@ HandleEventGenerate( return TCL_ERROR; } if (count != 1) { - Tcl_SetResult(interp, "Double or Triple modifier not allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Double or Triple modifier not allowed", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL); return TCL_ERROR; } if (*p != '\0') { - Tcl_SetResult(interp, "only one event specification allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "only one event specification allowed", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL); return TCL_ERROR; } @@ -3663,9 +3663,9 @@ FindSequence( if (eventMask & VirtualEventMask) { if (allowVirtual == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "virtual event not allowed in definition of another virtual event", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", NULL); return NULL; @@ -3693,13 +3693,14 @@ FindSequence( */ if (numPats == 0) { - Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no events specified in binding", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL); return NULL; } if ((numPats > 1) && (virtualFound != 0)) { - Tcl_SetResult(interp, "virtual events may not be composed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual events may not be composed", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", NULL); return NULL; @@ -3862,16 +3863,16 @@ ParseEventDescription( p = strchr(field, '>'); if (p == field) { - Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual event \"<<>>\" is badly formed", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); count = 0; goto done; } if ((p == NULL) || (p[1] != '>')) { - Tcl_SetResult(interp, "missing \">\" in virtual binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in virtual binding", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); count = 0; @@ -3971,8 +3972,8 @@ ParseEventDescription( } } } else if (eventFlags == 0) { - Tcl_SetResult(interp, "no event type or button # or keysym", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no event type or button # or keysym", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); count = 0; goto done; @@ -3985,15 +3986,15 @@ ParseEventDescription( while (*p != '\0') { p++; if (*p == '>') { - Tcl_SetResult(interp, - "extra characters after detail in binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after detail in binding", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); count = 0; goto done; } } - Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in binding", -1)); Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); count = 0; goto done; diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index 1c28977..0815b3b 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -342,9 +342,9 @@ GetBitmap( int result; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't specify bitmap with '@' in a safe interpreter", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); goto error; } diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index bf4c78f..bf58779 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.c @@ -936,9 +936,9 @@ BitmapToPostscript( return TCL_ERROR; } if (width > 60000) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "can't generate Postscript for bitmaps more" - " than 60000 pixels wide", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't generate Postscript for bitmaps more than 60000" + " pixels wide", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); return TCL_ERROR; } diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index e259a71..95bbb29 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -337,8 +337,8 @@ TkCanvPostscriptCmd( */ if (psInfo.channelName != NULL) { - Tcl_SetResult(interp, "can't specify both -file and -channel", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify both -file and -channel", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", NULL); result = TCL_ERROR; goto cleanup; @@ -350,8 +350,8 @@ TkCanvPostscriptCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, "can't specify -file in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify -file in a safe interpreter", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "SAFE", NULL); result = TCL_ERROR; goto cleanup; diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index a225646..cda9b1c 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -1359,7 +1359,8 @@ GetTextIndex( } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.first", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } @@ -1367,7 +1368,8 @@ GetTextIndex( } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.last", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 0cb8ccb..c696d65 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -1032,9 +1032,9 @@ CanvasWidgetCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, canvasPtr->bindingTable, object, Tcl_GetString(objv[3])); - Tcl_SetResult(interp, "requested illegal events;" - " only key, button, motion, enter, leave, and virtual" - " events may be used", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_EVENTS", NULL); result = TCL_ERROR; goto done; @@ -1856,7 +1856,8 @@ CanvasWidgetCmd( goto done; } if ((xScale == 0.0) || (yScale == 0.0)) { - Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scale factor cannot be zero", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_SCALE", NULL); result = TCL_ERROR; goto done; @@ -3592,9 +3593,8 @@ TagSearchScanExpr( case '!': /* Negate next tag or subexpr */ if (looking_for_tag > 1) { - Tcl_SetResult(interp, - "too many '!' in tag search expression", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many '!' in tag search expression", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "COMPLEXITY", NULL); return TCL_ERROR; @@ -3643,17 +3643,16 @@ TagSearchScanExpr( *tag++ = c; } if (!found_endquote) { - Tcl_SetResult(interp, - "missing endquote in tag search expression", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing endquote in tag search expression", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "ENDQUOTE", NULL); return TCL_ERROR; } if (!(tag - searchPtr->rewritebuffer)) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "null quoted tag string in tag search expression", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "EMPTY", NULL); return TCL_ERROR; @@ -3669,9 +3668,8 @@ TagSearchScanExpr( case '|': case '^': case ')': - Tcl_SetResult(interp, - "unexpected operator in tag search expression", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected operator in tag search expression", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "UNEXPECTED", NULL); return TCL_ERROR; @@ -3734,9 +3732,8 @@ TagSearchScanExpr( case '&': /* AND operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '&') { - Tcl_SetResult(interp, - "singleton '&' in tag search expression", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '&' in tag search expression", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "INCOMPLETE_OP", NULL); return TCL_ERROR; @@ -3748,9 +3745,8 @@ TagSearchScanExpr( case '|': /* OR operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '|') { - Tcl_SetResult(interp, - "singleton '|' in tag search expression", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '|' in tag search expression", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "INCOMPLETE_OP", NULL); return TCL_ERROR; @@ -3769,9 +3765,9 @@ TagSearchScanExpr( goto breakwhile; default: /* syntax error */ - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "invalid boolean operator in tag search expression", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "BAD_OP", NULL); return TCL_ERROR; @@ -3783,7 +3779,8 @@ TagSearchScanExpr( if (found_tag && !looking_for_tag) { return TCL_OK; } - Tcl_SetResult(interp, "missing tag in tag search expression", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing tag in tag search expression", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "NO_TAG", NULL); return TCL_ERROR; } diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index e153064..94e8d7c 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -367,10 +367,12 @@ Tk_ClipboardAppend( Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, type, ClipboardHandler, targetPtr, format); } else if (targetPtr->format != format) { - Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format), - "\" does not match current format \"", - Tk_GetAtomName(tkwin, targetPtr->format),"\" for ", - Tk_GetAtomName(tkwin, type), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "format \"%s\" does not match current format \"%s\" for %s", + Tk_GetAtomName(tkwin, format), + Tk_GetAtomName(tkwin, targetPtr->format), + Tk_GetAtomName(tkwin, type))); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "FORMAT_MISMATCH", NULL); return TCL_ERROR; } @@ -474,8 +476,9 @@ Tk_ClipboardObjCmd( i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum appendOptions) subIndex) { @@ -563,8 +566,9 @@ Tk_ClipboardObjCmd( } i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum getOptions) subIndex) { @@ -702,12 +706,11 @@ ClipboardGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - const char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1); return TCL_OK; } - /* * Local Variables: diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 63f626e..08eb377 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -233,7 +233,7 @@ Tk_BindObjCmd( Tcl_ResetResult(interp); return TCL_OK; } - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -361,30 +361,28 @@ Tk_BindtagsObjCmd( } if (objc == 2) { listPtr = Tcl_NewObj(); - Tcl_IncrRefCount(listPtr); if (winPtr->numTags == 0) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->classUid, -1)); winPtr2 = winPtr; while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) { winPtr2 = winPtr2->parentPtr; } if ((winPtr != winPtr2) && (winPtr2 != NULL)) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr2->pathName, -1)); } - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("all", -1)); } else { for (i = 0; i < winPtr->numTags; i++) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1)); + Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1)); } } Tcl_SetObjResult(interp, listPtr); - Tcl_DecrRefCount(listPtr); return TCL_OK; } if (winPtr->tagPtr != NULL) { @@ -555,9 +553,15 @@ Tk_LowerObjCmd( } } if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]), - "\" below \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + 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); return TCL_ERROR; } return TCL_OK; @@ -609,9 +613,15 @@ Tk_RaiseObjCmd( } } if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]), - "\" above \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + 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); return TCL_ERROR; } return TCL_OK; @@ -675,9 +685,9 @@ AppnameCmd( const char *string; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "appname not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "appname not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", NULL); return TCL_ERROR; } @@ -691,7 +701,7 @@ AppnameCmd( string = Tcl_GetString(objv[1]); winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); } - Tcl_AppendResult(interp, winPtr->nameUid, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); return TCL_OK; } @@ -800,8 +810,9 @@ ScalingCmd( double d; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, "scaling not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scaling not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", NULL); return TCL_ERROR; } @@ -849,9 +860,9 @@ UseinputmethodsCmd( int skip; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "useinputmethods not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "useinputmethods not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", NULL); return TCL_ERROR; } @@ -933,22 +944,22 @@ InactiveCmd( 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_Obj *msg = Tcl_NewStringObj("bad option \"", -1); - - Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL); - Tcl_SetObjResult(interp, msg); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be reset", string)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string, NULL); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "resetting the user inactivity timer " - "is not allowed in a safe interpreter", TCL_STATIC); + "is not allowed in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", NULL); return TCL_ERROR; } Tk_ResetUserInactiveTime(Tk_Display(tkwin)); @@ -1050,8 +1061,10 @@ Tk_TkwaitObjCmd( */ Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]), - "\" was deleted before its visibility changed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" was deleted before its visibility changed", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL); return TCL_ERROR; } Tk_DeleteEventHandler(window, @@ -1129,8 +1142,7 @@ WaitVisibilityProc( if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } - if (eventPtr->type == DestroyNotify) { + } else if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1584,8 +1596,9 @@ Tk_WinfoObjCmd( } name = Tk_GetAtomName(tkwin, (Atom) id); if (strcmp(name, "?bad atom?") == 0) { - Tcl_AppendResult(interp, "no atom exists with id \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no atom exists with id \"%s\"", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); @@ -1643,8 +1656,10 @@ Tk_WinfoObjCmd( winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id); if ((winPtr == NULL) || (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", string, - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", NULL); return TCL_ERROR; } @@ -1764,8 +1779,9 @@ Tk_WinfoObjCmd( visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask, &template, &count); if (visInfoPtr == NULL) { - Tcl_SetResult(interp, "can't find any visuals for screen", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find any visuals for screen", -1)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "VISUAL", NULL); return TCL_ERROR; } resultPtr = Tcl_NewObj(); @@ -1860,8 +1876,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) { @@ -1886,8 +1902,9 @@ Tk_WmObjCmd( return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -2058,8 +2075,9 @@ TkGetDisplayOf( if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) { if (objc < 2) { - Tcl_SetResult(interp, "value for \"-displayof\" missing", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-displayof\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL); return -1; } *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr); @@ -2097,8 +2115,9 @@ TkDeadAppCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - Tcl_AppendResult(interp, "can't invoke \"", argv[0], - "\" command: application has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't invoke \"%s\" command: application has been destroyed", + argv[0])); return TCL_ERROR; } diff --git a/generic/tkColor.c b/generic/tkColor.c index b1ed4f1..1bfb037 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -224,12 +224,12 @@ Tk_GetColor( if (tkColPtr == NULL) { if (interp != NULL) { if (*name == '#') { - Tcl_AppendResult(interp, "invalid color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", name)); Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); } else { - Tcl_AppendResult(interp, "unknown color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color name \"%s\"", name)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "COLOR", name, NULL); } } diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 51ac6dc..5d963d4 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -1158,7 +1158,8 @@ GetOptionFromObj( error: if (interp != NULL) { - Tcl_AppendResult(interp, "unknown option \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", name)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL); } return NULL; @@ -1226,9 +1227,9 @@ SetOptionFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to option except via GetOptionFromObj API", - NULL); + -1)); Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } @@ -1345,8 +1346,9 @@ Tk_SetOptions( if (objc < 2) { if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetStringFromObj(*objv, NULL), "\" missing",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", + Tcl_GetStringFromObj(*objv, NULL))); Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); goto error; } diff --git a/generic/tkConsole.c b/generic/tkConsole.c index 53f49c1..434350a 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -747,7 +747,9 @@ ConsoleObjCmd( Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); Tcl_Release(consoleInterp); } else { - Tcl_AppendResult(interp, "no active console interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active console interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NONE", NULL); result = TCL_ERROR; } Tcl_DecrRefCount(cmd); @@ -796,7 +798,9 @@ InterpreterObjCmd( } if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) { - Tcl_AppendResult(interp, "no active master interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active master interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL); return TCL_ERROR; } diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 2bbf861..6b2d5f4 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -352,11 +352,15 @@ Tk_GetCursorFromData( */ if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", bg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 39aa228..d78f396 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -449,8 +449,8 @@ static int ComputeFormat(Spinbox *sbPtr); static const Tk_ClassProcs entryClass = { sizeof(Tk_ClassProcs), /* size */ EntryWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -612,6 +612,7 @@ EntryWidgetObjCmd( switch ((enum entryCmd) cmdIndex) { case COMMAND_BBOX: { int index, x, y, width, height; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -625,8 +626,11 @@ EntryWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height)); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -755,9 +759,11 @@ EntryWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -851,7 +857,7 @@ EntryWidgetObjCmd( goto error; } Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_NewBooleanObj(entryPtr->selectFirst >= 0)); goto done; case SELECTION_RANGE: @@ -912,7 +918,7 @@ EntryWidgetObjCmd( if (entryPtr->validate != VALIDATE_NONE) { entryPtr->validate = selIndex; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK)); break; } @@ -921,13 +927,12 @@ EntryWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -1165,9 +1170,11 @@ ConfigureEntry( if (entryPtr->type == TK_SPINBOX) { if (sbPtr->fromValue > sbPtr->toValue) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "-to value must be greater than -from value", - TCL_VOLATILE); + -1)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "RANGE_SANITY", + NULL); continue; } @@ -1184,9 +1191,12 @@ ConfigureEntry( formatLen = strlen(fmt); if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) { - badFormatOpt: - Tcl_AppendResult(interp, "bad spinbox format specifier \"", - sbPtr->reqFormat, "\"", NULL); + badFormatOpt: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad spinbox format specifier \"%s\"", + sbPtr->reqFormat)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "FORMAT_SANITY", + NULL); continue; } if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3) @@ -2528,8 +2538,12 @@ GetEntryIndex( case 's': if (entryPtr->selectFirst < 0) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "NO_SELECTION", NULL); return TCL_ERROR; } if (length < 5) { @@ -2589,6 +2603,9 @@ GetEntryIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad %s index \"%s\"", (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", string)); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "BAD_INDEX", NULL); return TCL_ERROR; } @@ -3591,7 +3608,7 @@ Tk_SpinboxObjCmd( goto error; } - Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin)); return TCL_OK; error: @@ -3649,6 +3666,7 @@ SpinboxWidgetObjCmd( switch ((enum sbCmd) cmdIndex) { case SB_CMD_BBOX: { int index, x, y, width, height; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -3662,8 +3680,11 @@ SpinboxWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height)); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -3829,9 +3850,11 @@ SpinboxWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -3924,8 +3947,8 @@ SpinboxWidgetObjCmd( Tcl_WrongNumArgs(interp, 3, objv, NULL); goto error; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + entryPtr->selectFirst >= 0)); goto done; case SB_SEL_RANGE: @@ -4029,13 +4052,12 @@ SpinboxWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c index fba570b..8588d70 100644 --- a/generic/tkFileFilter.c +++ b/generic/tkFileFilter.c @@ -120,10 +120,12 @@ TkGetFileFilters( } if (count != 2 && count != 3) { - Tcl_AppendResult(interp, "bad file type \"", - Tcl_GetString(listObjv[i]), "\", ", - "should be \"typeName {extension ?extensions ...?} ", - "?{macType ?macTypes ...?}?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad file type \"%s\", should be " + "\"typeName {extension ?extensions ...?} " + "?{macType ?macTypes ...?}?\"", + Tcl_GetString(listObjv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILE_TYPE", NULL); return TCL_ERROR; } @@ -289,8 +291,10 @@ AddClause( Tcl_DStringFree(&osTypeDS); } if (len != 4) { - Tcl_AppendResult(interp, "bad Macintosh file type \"", - Tcl_GetString(ostypeList[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad Macintosh file type \"%s\"", + Tcl_GetString(ostypeList[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MAC_TYPE", NULL); code = TCL_ERROR; goto done; } diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 2f50009..b5e2edf 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -115,7 +115,7 @@ Tk_FocusObjCmd( }; Tk_Window tkwin = clientData; TkWindow *winPtr = clientData; - TkWindow *newPtr, *focusWinPtr, *topLevelPtr; + TkWindow *newPtr, *topLevelPtr; ToplevelFocusInfo *tlFocusPtr; const char *windowName; int index; @@ -125,9 +125,10 @@ Tk_FocusObjCmd( */ if (objc == 1) { - focusWinPtr = TkGetFocusWin(winPtr); - if (focusWinPtr != NULL) { - Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC); + Tk_Window focusWin = (Tk_Window) TkGetFocusWin(winPtr); + + if (focusWin != NULL) { + Tcl_SetObjResult(interp, TkNewWindowObj(focusWin)); } return TCL_OK; } @@ -180,7 +181,7 @@ Tk_FocusObjCmd( } newPtr = TkGetFocusWin(newPtr); if (newPtr != NULL) { - Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) newPtr)); } break; case 1: /* -force */ @@ -213,12 +214,12 @@ Tk_FocusObjCmd( for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; tlFocusPtr = tlFocusPtr->nextPtr) { if (tlFocusPtr->topLevelPtr == topLevelPtr) { - Tcl_SetResult(interp, - tlFocusPtr->focusWinPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + tlFocusPtr->focusWinPtr)); return TCL_OK; } } - Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) topLevelPtr)); return TCL_OK; } break; diff --git a/generic/tkFont.c b/generic/tkFont.c index e536c41..2e400b8 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -617,8 +617,8 @@ Tk_FontObjCmd( nfPtr = Tcl_GetHashValue(namedHashPtr); } if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) { - Tcl_AppendResult(interp, "named font \"", string, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", string)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); return TCL_ERROR; } @@ -672,7 +672,7 @@ Tk_FontObjCmd( if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } - Tcl_AppendResult(interp, name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); break; } case FONT_DELETE: { @@ -728,8 +728,8 @@ Tk_FontObjCmd( return TCL_ERROR; } string = Tcl_GetStringFromObj(objv[3 + skip], &length); - Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tk_TextWidth(tkfont, string, length))); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tk_TextWidth(tkfont, string, length))); Tk_FreeFont(tkfont); break; } @@ -951,8 +951,8 @@ TkCreateNamedFont( nfPtr = Tcl_GetHashValue(namedHashPtr); if (nfPtr->deletePending == 0) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" already exists", name)); Tcl_SetErrorCode(interp, "TK", "FONT", "EXISTS", NULL); } return TCL_ERROR; @@ -1003,8 +1003,8 @@ TkDeleteNamedFont( namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name); if (namedHashPtr == NULL) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", name)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL); } return TCL_ERROR; @@ -1187,8 +1187,9 @@ Tk_AllocFontFromObj( if (isNew) { Tcl_DeleteHashEntry(cacheHashPtr); } - Tcl_AppendResult(interp, "failed to allocate font due to ", - "internal system font engine problem", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "failed to allocate font due to internal system font engine" + " problem", -1)); Tcl_SetErrorCode(interp, "TK", "FONT", "INTERNAL_PROBLEM", NULL); return NULL; } @@ -3408,8 +3409,9 @@ ConfigAttributesObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(optionPtr), "\" option missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" option missing", + Tcl_GetString(optionPtr))); Tcl_SetErrorCode(interp, "TK", "FONT", "NO_ATTRIBUTE", NULL); } return TCL_ERROR; @@ -3652,8 +3654,8 @@ ParseFontNameObj( if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK) || (objc < 1)) { if (interp != NULL) { - Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "font \"%s\" doesn't exist", string)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); } return TCL_ERROR; @@ -3701,8 +3703,8 @@ ParseFontNameObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "unknown font style \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown font style \"%s\"", Tcl_GetString(objv[i]))); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT_STYLE", Tcl_GetString(objv[i]), NULL); } diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 55f5d51..f09369e 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -548,8 +548,9 @@ CreateFrame( * are being destroyed. Let an error be thrown. */ - Tcl_AppendResult(interp, "unable to create widget \"", - Tcl_GetString(objv[1]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to create widget \"%s\"", Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "APP_GONE", NULL); newWin = NULL; } else { /* @@ -562,9 +563,11 @@ CreateFrame( goto error; } else { /* - * Mark Tk frames as suitable candidates for [wm manage] + * Mark Tk frames as suitable candidates for [wm manage]. */ + TkWindow *winPtr = (TkWindow *)newWin; + winPtr->flags |= TK_WM_MANAGEABLE; } if (className == NULL) { @@ -669,8 +672,10 @@ CreateFrame( if (framePtr->useThis == NULL) { TkpMakeContainer(framePtr->tkwin); } else { - Tcl_AppendResult(interp, "A window cannot have both the -use ", - "and the -container option set.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "windows cannot have both the -use and the -container" + " option set", -1)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CONTAINMENT", NULL); goto error; } } @@ -765,6 +770,7 @@ FrameWidgetObjCmd( for (i = 2; i < objc; i++) { const char *arg = Tcl_GetStringFromObj(objv[i], &length); + if (length < 2) { continue; } @@ -785,23 +791,22 @@ FrameWidgetObjCmd( #ifdef SUPPORT_CONFIG_EMBEDDED if (c == 'u') { const char *string = Tcl_GetString(objv[i+1]); + if (TkpUseWindow(interp, framePtr->tkwin, string) != TCL_OK) { result = TCL_ERROR; goto done; } - } else { - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; + continue; } -#else - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; #endif + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't modify %s option after widget is created", + arg)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CREATE_ONLY", + NULL); + result = TCL_ERROR; + goto done; } } result = ConfigureFrame(interp, framePtr, objc-2, objv+2); @@ -1011,19 +1016,14 @@ ConfigureFrame( } sibling = ancestor; if (Tk_IsTopLevel(ancestor)) { - badWindow: - Tcl_AppendResult(interp, "can't use ", - Tk_PathName(labelframePtr->labelWin), - " as label in this frame", NULL); - labelframePtr->labelWin = NULL; - return TCL_ERROR; + goto badLabelWindow; } } if (Tk_IsTopLevel(labelframePtr->labelWin)) { - goto badWindow; + goto badLabelWindow; } if (labelframePtr->labelWin == framePtr->tkwin) { - goto badWindow; + goto badLabelWindow; } Tk_CreateEventHandler(labelframePtr->labelWin, StructureNotifyMask, FrameStructureProc, framePtr); @@ -1044,6 +1044,14 @@ ConfigureFrame( FrameWorldChanged(framePtr); return TCL_OK; + + badLabelWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as label in this frame", + Tk_PathName(labelframePtr->labelWin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); + labelframePtr->labelWin = NULL; + return TCL_ERROR; } /* diff --git a/generic/tkGeometry.c b/generic/tkGeometry.c index 2c6c113..2e0009a 100644 --- a/generic/tkGeometry.c +++ b/generic/tkGeometry.c @@ -321,7 +321,8 @@ Tk_SetMinimumRequestSize( int TkSetGeometryMaster( Tcl_Interp *interp, /* Current interpreter, for error. */ - Tk_Window tkwin, /* Window that will have geometry master set. */ + Tk_Window tkwin, /* Window that will have geometry master + * set. */ const char *master) /* The master identity. */ { register TkWindow *winPtr = (TkWindow *) tkwin; @@ -332,10 +333,11 @@ TkSetGeometryMaster( } if (winPtr->geometryMaster != NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "cannot use geometry manager ", master, - " inside ", Tk_PathName(tkwin), - " which already has slaves managed by ", - winPtr->geometryMaster, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot use geometry manager %s inside %s which already" + " has slaves managed by %s", + master, Tk_PathName(tkwin), winPtr->geometryMaster)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "FIGHT", NULL); } return TCL_ERROR; } @@ -364,8 +366,9 @@ TkSetGeometryMaster( void TkFreeGeometryMaster( - Tk_Window tkwin, /* Window that will have geometry master cleared. */ - const char *master) /* The master identity. */ + Tk_Window tkwin, /* Window that will have geometry master + * cleared. */ + const char *master) /* The master identity. */ { register TkWindow *winPtr = (TkWindow *) tkwin; diff --git a/generic/tkGet.c b/generic/tkGet.c index bd63971..d58b4a5 100644 --- a/generic/tkGet.c +++ b/generic/tkGet.c @@ -152,8 +152,10 @@ Tk_GetAnchor( } error: - Tcl_AppendResult(interp, "bad anchor position \"", string, - "\": must be n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad anchor position \"%s\": must be" + " n, ne, e, se, s, sw, w, nw, or center", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ANCHOR", NULL); return TCL_ERROR; } @@ -237,8 +239,10 @@ Tk_GetJoinStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad join style \"", string, - "\": must be bevel, miter, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad join style \"%s\": must be bevel, miter, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JOIN", NULL); return TCL_ERROR; } @@ -316,8 +320,10 @@ Tk_GetCapStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad cap style \"", string, - "\": must be butt, projecting, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cap style \"%s\": must be butt, projecting, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CAP", NULL); return TCL_ERROR; } @@ -432,8 +438,10 @@ Tk_GetJustify( return TCL_OK; } - Tcl_AppendResult(interp, "bad justification \"", string, - "\": must be left, right, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad justification \"%s\": must be left, right, or center", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JUSTIFY", NULL); return TCL_ERROR; } @@ -568,9 +576,7 @@ Tk_GetScreenMM( d = strtod(string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -606,6 +612,12 @@ Tk_GetScreenMM( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCREEN_DISTANCE", NULL); + return TCL_ERROR; } /* @@ -684,9 +696,7 @@ TkGetDoublePixels( d = strtod((char *) string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -725,6 +735,12 @@ TkGetDoublePixels( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL); + return TCL_ERROR; } /* diff --git a/generic/tkGrab.c b/generic/tkGrab.c index 9e9daae..e825c7b 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -211,11 +211,15 @@ Tk_GrabObjCmd( * is "grab", but if it has been aliased, the message will be * incorrect. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "wrong # args: should be \"", - Tcl_GetString(objv[0]), " ?-global? window\" or \"", - Tcl_GetString(objv[0]), " option ?arg ...?\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + + Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), + " option ?arg ...?\"", NULL); + /* This API not exposed: + * + ((Interp *) interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS; + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); + */ return TCL_ERROR; } @@ -278,17 +282,20 @@ Tk_GrabObjCmd( } dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName, - TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + dispPtr->eventualGrabWinPtr)); } } else { + Tcl_Obj *resultObj = Tcl_NewObj(); + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_AppendElement(interp, - dispPtr->eventualGrabWinPtr->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, TkNewWindowObj( + (Tk_Window) dispPtr->eventualGrabWinPtr)); } } + Tcl_SetObjResult(interp, resultObj); } return TCL_OK; @@ -341,6 +348,7 @@ Tk_GrabObjCmd( case GRABCMD_STATUS: { /* [grab status window] */ TkWindow *winPtr; + const char *statusString; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "status window"); @@ -353,12 +361,13 @@ Tk_GrabObjCmd( } dispPtr = winPtr->dispPtr; if (dispPtr->eventualGrabWinPtr != winPtr) { - Tcl_SetResult(interp, "none", TCL_STATIC); + statusString = "none"; } else if (dispPtr->grabFlags & GRAB_GLOBAL) { - Tcl_SetResult(interp, "global", TCL_STATIC); + statusString = "global"; } else { - Tcl_SetResult(interp, "local", TCL_STATIC); + statusString = "local"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(statusString, -1)); break; } } @@ -528,19 +537,21 @@ Tk_Grab( grabError: if (grabResult == GrabNotViewable) { - Tcl_SetResult(interp, "grab failed: window not viewable", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: window not viewable", -1)); Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL); } else if (grabResult == AlreadyGrabbed) { alreadyGrabbed: - Tcl_SetResult(interp, "grab failed: another application has grab", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: another application has grab", -1)); Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL); } else if (grabResult == GrabFrozen) { - Tcl_SetResult(interp, - "grab failed: keyboard or pointer frozen", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: keyboard or pointer frozen", -1)); Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL); } else if (grabResult == GrabInvalidTime) { - Tcl_SetResult(interp, "grab failed: invalid time", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: invalid time", -1)); Tcl_SetErrorCode(interp, "TK", "GRAB", "BADTIME", NULL); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 627bb89..8714969 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -402,7 +402,8 @@ Tk_GridObjCmd( } /* This should not happen */ - Tcl_SetResult(interp, "internal error in grid", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("internal error in grid", -1)); + Tcl_SetErrorCode(interp, "TK", "UNREACHABLE", NULL); return TCL_ERROR; } @@ -447,8 +448,9 @@ GridAnchorCommand( if (objc == 3) { gridPtr = masterPtr->masterDataPtr; - Tcl_SetResult(interp, (char *) Tk_NameOfAnchor(gridPtr == NULL ? - GRID_DEFAULT_ANCHOR : gridPtr->anchor), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfAnchor(gridPtr?gridPtr->anchor:GRID_DEFAULT_ANCHOR), + -1)); return TCL_OK; } @@ -994,9 +996,8 @@ GridRowColumnConfigureCommand( string = Tcl_GetString(objv[1]); slotType = (*string == 'c') ? COLUMN : ROW; if (lObjc == 0) { - Tcl_AppendResult(interp, "no ", - (slotType == COLUMN) ? "column" : "row", - " indices specified", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("no %s indices specified", + (slotType == COLUMN) ? "column" : "row")); Tcl_SetErrorCode(interp, "TK", "GRID", "NOINDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; @@ -1008,9 +1009,9 @@ GridRowColumnConfigureCommand( if ((objc == 4) || (objc == 5)) { if (lObjc != 1) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), - ": must specify a single element on retrieval", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s %s: must specify a single element on retrieval", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]))); Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; @@ -1076,19 +1077,19 @@ GridRowColumnConfigureCommand( return TCL_ERROR; } if (index == ROWCOL_MINSIZE) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].minSize : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].minSize : 0)); } else if (index == ROWCOL_WEIGHT) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].weight : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].weight : 0)); } else if (index == ROWCOL_UNIFORM) { Tk_Uid value = (ok == TCL_OK) ? slotPtr[slot].uniform : ""; - Tcl_SetObjResult(interp, - Tcl_NewStringObj(value == NULL ? "" : value, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (value == NULL) ? "" : value, -1)); } else if (index == ROWCOL_PAD) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].pad : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].pad : 0)); } Tcl_DecrRefCount(listCopy); return TCL_OK; @@ -1121,18 +1122,19 @@ GridRowColumnConfigureCommand( slavePtr = GetGrid(slave); if (slavePtr->masterPtr != masterPtr) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": the window \"", - Tcl_GetString(lObjv[j]), "\" is not managed by \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s %s: the window \"%s\" is not managed by \"%s\"", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]), + Tcl_GetString(lObjv[j]), Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "GRID_MASTER", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } } else { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": illegal index \"", - Tcl_GetString(lObjv[j]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s %s: illegal index \"%s\"", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]), + Tcl_GetString(lObjv[j]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; @@ -1153,11 +1155,12 @@ GridRowColumnConfigureCommand( for (slot = first; slot <= last; slot++) { ok = CheckSlotData(masterPtr, slot, slotType, /*checkOnly*/ 0); if (ok != TCL_OK) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": \"", - Tcl_GetString(lObjv[j]), - "\" is out of range", NULL); - Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s %s: \"%s\" is out of range", + Tcl_GetString(objv[0]), Tcl_GetString(objv[1]), + Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", + NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1191,13 +1194,8 @@ GridRowColumnConfigureCommand( Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (wt < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); Tcl_DecrRefCount(listCopy); - Tcl_SetErrorCode(interp, "TK", "GRID", - "NEG_INDEX", NULL); - return TCL_ERROR; + goto negativeIndex; } else { slotPtr[slot].weight = wt; } @@ -1214,13 +1212,8 @@ GridRowColumnConfigureCommand( Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (size < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); - Tcl_SetErrorCode(interp, "TK", "GRID", - "NEG_INDEX", NULL); Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + goto negativeIndex; } else { slotPtr[slot].pad = size; } @@ -1269,6 +1262,13 @@ GridRowColumnConfigureCommand( Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } return TCL_OK; + + negativeIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid arg \"%s\": should be non-negative", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); + return TCL_ERROR; } /* @@ -1371,8 +1371,8 @@ GridSlavesCommand( return TCL_ERROR; } if (value < 0) { - Tcl_AppendResult(interp, Tcl_GetString(objv[i]), - " is an invalid value: should NOT be < 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%d is an invalid value: should NOT be < 0", value)); Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); return TCL_ERROR; } @@ -1391,11 +1391,11 @@ GridSlavesCommand( res = Tcl_NewListObj(0, NULL); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - if (column>=0 && (slavePtr->column > column + if ((column >= 0) && (slavePtr->column > column || slavePtr->column+slavePtr->numCols-1 < column)) { continue; } - if (row>=0 && (slavePtr->row > row || + if ((row >= 0) && (slavePtr->row > row || slavePtr->row+slavePtr->numRows-1 < row)) { continue; } @@ -2539,7 +2539,7 @@ SetSlaveColumn( lastCol = ((newColumn >= 0) ? newColumn : 0) + newNumCols; if (lastCol >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Column out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("column out of bounds",-1)); Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_COLUMN", NULL); return TCL_ERROR; } @@ -2580,7 +2580,7 @@ SetSlaveRow( lastRow = ((newRow >= 0) ? newRow : 0) + newNumRows; if (lastRow >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Row out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("row out of bounds", -1)); Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_ROW", NULL); return TCL_ERROR; } @@ -3005,8 +3005,8 @@ ConfigureSlaves( continue; } if (length > 1 && i == 0) { - Tcl_AppendResult(interp, "bad argument \"", string, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", string)); Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3014,17 +3014,17 @@ ConfigureSlaves( break; } if (length > 1) { - Tcl_AppendResult(interp, "unexpected parameter, \"", - string, "\", in configure list. ", - "Should be window name or option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unexpected parameter \"%s\" in configure list:" + " should be window name or option", string)); Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if ((firstChar == REL_HORIZ) && ((numWindows == 0) || (prevChar == REL_SKIP) || (prevChar == REL_VERT))) { - Tcl_AppendResult(interp, - "Must specify window before shortcut '-'.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify window before shortcut '-'", -1)); Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3034,15 +3034,17 @@ ConfigureSlaves( continue; } - Tcl_AppendResult(interp, "invalid window shortcut, \"", - string, "\" should be '-', 'x', or '^'", NULL); - Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid window shortcut, \"%s\" should be '-', 'x', or '^'", + string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } numWindows = i; if ((objc - numWindows) & 1) { - Tcl_AppendResult(interp, "extra option or option with no value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra option or option with no value", -1)); Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3069,10 +3071,9 @@ ConfigureSlaves( } else if (index == CONF_ROW) { if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "POSITIVE_INT", NULL); return TCL_ERROR; } @@ -3135,8 +3136,9 @@ ConfigureSlaves( } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't manage \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -3164,9 +3166,9 @@ ConfigureSlaves( case CONF_COLUMN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad column value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad column value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } @@ -3177,9 +3179,9 @@ ConfigureSlaves( case CONF_COLUMNSPAN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp <= 0) { - Tcl_AppendResult(interp, "bad columnspan value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad columnspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } @@ -3193,8 +3195,8 @@ ConfigureSlaves( return TCL_ERROR; } if (other == slave) { - Tcl_SetResult(interp, "Window can't be managed in itself", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "window can't be managed in itself", -1)); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } @@ -3206,9 +3208,10 @@ ConfigureSlaves( int sticky = StringToSticky(Tcl_GetString(objv[i+1])); if (sticky == -1) { - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a string containing n, e, s, and/or w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be" + " a string containing n, e, s, and/or w", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } @@ -3218,9 +3221,9 @@ ConfigureSlaves( case CONF_IPADX: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } @@ -3229,9 +3232,9 @@ ConfigureSlaves( case CONF_IPADY: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } @@ -3252,9 +3255,9 @@ ConfigureSlaves( case CONF_ROW: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), - "\": must be a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } @@ -3265,9 +3268,9 @@ ConfigureSlaves( case CONF_ROWSPAN: if ((Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK) || tmp <= 0) { - Tcl_AppendResult(interp, "bad rowspan value \"", - Tcl_GetString(objv[i+1]), - "\": must be a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad rowspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } @@ -3333,8 +3336,9 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); Unlink(slavePtr); return TCL_ERROR; @@ -3346,9 +3350,9 @@ ConfigureSlaves( */ if (masterPtr->masterPtr == slavePtr) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), - ", would cause management loop.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s, would cause management loop", + Tcl_GetString(objv[j]), Tk_PathName(masterPtr->tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); Unlink(slavePtr); return TCL_ERROR; @@ -3409,8 +3413,8 @@ ConfigureSlaves( numSkip = 0; for (j = 0; j < numWindows; j++) { struct Gridder *otherPtr; - int match; /* Found a match for the ^ */ - int lastRow, lastColumn; /* Implied end of table. */ + int match; /* Found a match for the ^ */ + int lastRow, lastColumn; /* Implied end of table. */ string = Tcl_GetString(objv[j]); firstChar = string[0]; @@ -3427,7 +3431,8 @@ ConfigureSlaves( } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't use '^', cant find master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't use '^', cant find master", -1)); Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3480,15 +3485,16 @@ ConfigureSlaves( } } if (!match) { - Tcl_AppendResult(interp, "can't find slave to extend with \"^\".", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find slave to extend with \"^\"", -1)); Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't determine master window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't determine master window", -1)); Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } diff --git a/generic/tkImage.c b/generic/tkImage.c index 9cc8738..bb115f6 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -225,6 +225,7 @@ Tk_ImageObjCmd( char idString[16 + TCL_INTEGER_SPACE]; TkDisplay *dispPtr = winPtr->dispPtr; const char *arg, *name; + Tcl_Obj *resultObj; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -271,8 +272,8 @@ Tk_ImageObjCmd( } } if (typePtr == NULL) { - Tcl_AppendResult(interp, "image type \"", arg, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image type \"%s\" doesn't exist", arg)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", NULL); return TCL_ERROR; } @@ -305,8 +306,9 @@ Tk_ImageObjCmd( topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name); if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { - Tcl_AppendResult(interp, "images may not be named the ", - "same as the main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "images may not be named the same as the main window", + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL); return TCL_ERROR; } @@ -389,9 +391,8 @@ Tk_ImageObjCmd( imagePtr->instanceData = typePtr->getProc(imagePtr->tkwin, masterPtr->masterData); } - Tcl_SetResult(interp, - Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); break; } case IMAGE_DELETE: @@ -414,28 +415,34 @@ Tk_ImageObjCmd( return TCL_ERROR; } hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); + resultObj = Tcl_NewObj(); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { continue; } - Tcl_AppendElement(interp, Tcl_GetHashKey( - &winPtr->mainPtr->imageTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_TYPES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_HEIGHT: @@ -492,7 +499,7 @@ Tk_ImageObjCmd( return TCL_OK; alreadyDeleted: - Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" doesn't exist",arg)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", NULL); return TCL_ERROR; } @@ -633,7 +640,8 @@ Tk_GetImage( noSuchImage: if (interp) { - Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist", name)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", NULL); } return NULL; diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index a08bb8f..56ad066 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -277,8 +277,8 @@ ImgBmapConfigureMaster( if ((masterPtr->maskFileString != NULL) || (masterPtr->maskDataString != NULL)) { if (masterPtr->data == NULL) { - Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap", - TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "can't have mask without bitmap", -1)); Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", "NO_BITMAP", NULL); return TCL_ERROR; @@ -293,8 +293,8 @@ ImgBmapConfigureMaster( || (maskHeight != masterPtr->height)) { ckfree(masterPtr->maskData); masterPtr->maskData = NULL; - Tcl_SetResult(masterPtr->interp, - "bitmap and mask have different sizes", TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "bitmap and mask have different sizes", -1)); Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", "MASK_SIZE", NULL); return TCL_ERROR; @@ -494,8 +494,9 @@ TkGetBitmapData( pi.string = string; if (string == NULL) { if ((interp != NULL) && Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get bitmap data from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get bitmap data from a file in a safe interpreter", + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "SAFE", NULL); return NULL; } @@ -508,8 +509,9 @@ TkGetBitmapData( if (pi.chan == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read bitmap file \"", - fileName, "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read bitmap file \"%s\": %s", + fileName, Tcl_PosixError(interp))); } return NULL; } @@ -598,8 +600,9 @@ TkGetBitmapData( } } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) { if (interp != NULL) { - Tcl_AppendResult(interp, "format error in bitmap data; ", - "looks like it's an obsolete X10 bitmap file", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data; looks like it's an" + " obsolete X10 bitmap file", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OBSOLETE", NULL); } @@ -643,7 +646,8 @@ TkGetBitmapData( error: if (interp != NULL) { - Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "FORMAT", NULL); } @@ -1159,9 +1163,9 @@ ImgBmapPsImagemask( }; if (width*height > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unable to generate postscript for bitmaps " - "larger than 60000 pixels", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to generate postscript for bitmaps larger than 60000" + " pixels", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OUTSIZE", NULL); return TCL_ERROR; } diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 62d364f..fed4da4 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -430,10 +430,10 @@ FileReadGIF( return TCL_ERROR; } if (i == (argc-1)) { - Tcl_AppendResult(interp, "no value given for \"", - Tcl_GetString(objv[i]), "\" option", NULL); - Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "OPT_VALUE", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no value given for \"%s\" option", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "OPT_VALUE", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) { @@ -446,14 +446,14 @@ FileReadGIF( */ if (!ReadGIFHeader(gifConfPtr, chan, &fileWidth, &fileHeight)) { - Tcl_AppendResult(interp, "couldn't read GIF header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read GIF header from file \"%s\"", fileName)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "GIF image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "GIF image file \"%s\" has dimension(s) <= 0", fileName)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BOGUS_SIZE", NULL); return TCL_ERROR; } @@ -469,9 +469,9 @@ FileReadGIF( if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); - Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); return TCL_ERROR; } } @@ -507,8 +507,8 @@ FileReadGIF( * Premature end of image. */ - Tcl_AppendResult(interp, - "premature end of image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "premature end of image data for this index", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", NULL); goto error; @@ -516,7 +516,8 @@ FileReadGIF( switch (buf[0]) { case GIF_TERMINATOR: - Tcl_AppendResult(interp, "no image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no image data for this index", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL); goto error; @@ -526,17 +527,17 @@ FileReadGIF( */ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "error reading extension function code in GIF image", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", NULL); goto error; } if (DoExtension(gifConfPtr, chan, buf[0], gifConfPtr->workingBuffer, &transparent) < 0) { - Tcl_SetResult(interp, "error reading extension in GIF image", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading extension in GIF image", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", NULL); goto error; @@ -544,9 +545,9 @@ FileReadGIF( continue; case GIF_START: if (Fread(gifConfPtr, buf, 1, 9, chan) != 9) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't read left/top/width/height in GIF image", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "DIMENSIONS", NULL); goto error; @@ -576,7 +577,8 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); goto error; @@ -625,7 +627,8 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); goto error; } @@ -677,7 +680,7 @@ FileReadGIF( block.pixelPtr = ckalloc(nBytes); if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth, - imageHeight, colorMap, srcX, srcY, BitSet(buf[8],INTERLACE), + imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE), transparent) != TCL_OK) { ckfree(block.pixelPtr); goto error; @@ -695,7 +698,7 @@ FileReadGIF( * which suits as well). We're done. */ - Tcl_AppendResult(interp, tkImgFmtGIF.name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1)); result = TCL_OK; error: @@ -921,19 +924,19 @@ DoExtension( int count; switch (label) { - case 0x01: /* Plain Text Extension */ + case 0x01: /* Plain Text Extension */ break; - case 0xff: /* Application Extension */ + case 0xff: /* Application Extension */ break; - case 0xfe: /* Comment Extension */ + case 0xfe: /* Comment Extension */ do { count = GetDataBlock(gifConfPtr, chan, buf); } while (count > 0); return count; - case 0xf9: /* Graphic Control Extension */ + case 0xf9: /* Graphic Control Extension */ count = GetDataBlock(gifConfPtr, chan, buf); if (count < 0) { return 1; @@ -1029,13 +1032,13 @@ ReadImage( */ if (Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) <= 0) { - Tcl_AppendResult(interp, "error reading GIF image: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading GIF image: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (initialCodeSize > MAX_LWZ_BITS) { - Tcl_SetResult(interp, "malformed image", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("malformed image", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "MALFORMED", NULL); return TCL_ERROR; } @@ -1435,7 +1438,7 @@ Mgetc( handle->data++; } while (c == GIF_SPACE); - if (c>GIF_SPECIAL) { + if (c > GIF_SPECIAL) { handle->state = GIF_DONE; return handle->c; } @@ -1708,7 +1711,7 @@ CommonWriteGIF( state.pixelPitch = blockPtr->pitch; SaveMap(&state, blockPtr); if (state.num >= MAXCOLORMAPSIZE) { - Tcl_AppendResult(interp, "too many colors", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("too many colors", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLORFUL", NULL); return TCL_ERROR; } diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 96a17bd..aff2496 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -334,7 +334,8 @@ InitPNGImage( if (Tcl_ZlibStreamInit(NULL, dir, TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_COMPRESS_DEFAULT, NULL, &pngPtr->stream) != TCL_OK) { - Tcl_SetResult(interp, "zlib initialization failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "zlib initialization failed", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL); if (objPtr) { Tcl_DecrRefCount(objPtr); @@ -516,7 +517,8 @@ ReadBase64( } if (destSz) { - Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -559,7 +561,8 @@ ReadByteArray( */ if (pngPtr->strDataLen < destSz) { - Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -621,15 +624,10 @@ ReadData( int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ); blockSz = Tcl_Read(pngPtr->channel, (char *)destPtr, blockSz); - - /* - * Check for read failure. - */ - if (blockSz < 0) { /* TODO: failure info... */ - Tcl_AppendResult(interp, "channel read failed: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel read failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -651,7 +649,8 @@ ReadData( */ if (destSz && Tcl_Eof(pngPtr->channel)) { - Tcl_SetResult(interp, "unexpected end of file", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of file", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EOF", NULL); return TCL_ERROR; } @@ -737,7 +736,7 @@ CheckCRC( */ if (calculated != chunked) { - Tcl_SetResult(interp, "CRC check failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("CRC check failed", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "CRC", NULL); return TCL_ERROR; } @@ -888,8 +887,9 @@ ReadChunkHeader( temp = PNG_INT32(pc[0], pc[1], pc[2], pc[3]); if (temp > INT_MAX) { - Tcl_SetResult(interp, "chunk size is out of supported range " - "on this architecture", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "chunk size is out of supported range on this architecture", + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "OUTSIZE", NULL); return TCL_ERROR; } @@ -974,9 +974,27 @@ ReadChunkHeader( */ if (!(chunkType & PNG_CF_ANCILLARY)) { - Tcl_SetResult(interp, - "encountered an unsupported criticial chunk type", - TCL_STATIC); + if (chunkType & PNG_INT32(128,128,128,128)) { + /* + * No nice ASCII conversion; shouldn't happen either, but + * we'll be doubly careful. + */ + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "encountered an unsupported criticial chunk type", + -1)); + } else { + char typeString[5]; + + typeString[0] = (char) ((chunkType >> 24) & 255); + typeString[1] = (char) ((chunkType >> 16) & 255); + typeString[2] = (char) ((chunkType >> 8) & 255); + typeString[3] = (char) (chunkType & 255); + typeString[4] = '\0'; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "encountered an unsupported criticial chunk type" + " \"%s\"", typeString)); + } Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNSUPPORTED_CRITICAL", NULL); return TCL_ERROR; @@ -989,7 +1007,8 @@ ReadChunkHeader( for (i=0 ; i<4 ; i++) { if ((pc[i] < 65) || (pc[i] > 122) || ((pc[i] > 90) && (pc[i] < 97))) { - Tcl_SetResult(interp, "invalid chunk type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid chunk type", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_CHUNK", NULL); return TCL_ERROR; @@ -1047,7 +1066,6 @@ CheckColor( Tcl_Interp *interp, PNGImage *pngPtr) { - int result = TCL_OK; int offset; /* @@ -1060,14 +1078,14 @@ CheckColor( if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_RGB: pngPtr->numChannels = 3; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; @@ -1075,37 +1093,35 @@ CheckColor( pngPtr->numChannels = 1; if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_GRAYALPHA: pngPtr->numChannels = 2; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_RGBA: pngPtr->numChannels = 4; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + unsupportedDepth: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bit depth is not allowed for given color type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_DEPTH", NULL); + return TCL_ERROR; } break; default: - Tcl_SetResult(interp, "unknown color type field", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type field %d", pngPtr->colorType)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } - if (TCL_ERROR == result) { - Tcl_SetResult(interp, "bit depth is not allowed for given color type", - TCL_STATIC); - Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_DEPTH", NULL); - return TCL_ERROR; - } - /* * Set up the Tk photo block's pixel size and channel offsets. offset * array elements should already be 0 from the memset during InitPNGImage. @@ -1130,9 +1146,9 @@ CheckColor( */ if (pngPtr->block.width > INT_MAX / pngPtr->block.pixelSize) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "image pitch is out of supported range on this architecture", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PITCH", NULL); return TCL_ERROR; } @@ -1145,8 +1161,9 @@ CheckColor( */ if (pngPtr->block.height > INT_MAX / pngPtr->block.pitch) { - Tcl_SetResult(interp, "image total size is out of supported range " - "on this architecture", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image total size is out of supported range on this architecture", + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "SIZE", NULL); return TCL_ERROR; } @@ -1174,8 +1191,8 @@ CheckColor( pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 8 : 4; break; default: - Tcl_SetResult(interp, "internal error - unknown color type", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type %d", pngPtr->colorType)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } @@ -1256,8 +1273,8 @@ ReadIHDR( } if (mismatch) { - Tcl_SetResult(interp, "data stream does not have a PNG signature", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "data stream does not have a PNG signature", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_SIG", NULL); return TCL_ERROR; } @@ -1274,13 +1291,15 @@ ReadIHDR( */ if (chunkType != CHUNK_IHDR) { - Tcl_SetResult(interp, "expected IHDR chunk type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "expected IHDR chunk type", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_IHDR", NULL); return TCL_ERROR; } if (chunkSz != 13) { - Tcl_SetResult(interp, "invalid IHDR chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid IHDR chunk size", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IHDR", NULL); return TCL_ERROR; } @@ -1300,9 +1319,9 @@ ReadIHDR( } if (!width || !height || (width > INT_MAX) || (height > INT_MAX)) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "image dimensions are invalid or beyond architecture limits", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DIMENSIONS", NULL); return TCL_ERROR; } @@ -1345,8 +1364,9 @@ ReadIHDR( return TCL_ERROR; } - if (PNG_COMPRESS_DEFLATE != pngPtr->compression) { - Tcl_SetResult(interp, "unknown compression method", TCL_STATIC); + if (pngPtr->compression != PNG_COMPRESS_DEFLATE) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown compression method %d", pngPtr->compression)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_COMPRESS", NULL); return TCL_ERROR; } @@ -1360,8 +1380,9 @@ ReadIHDR( return TCL_ERROR; } - if (PNG_FILTMETH_STANDARD != pngPtr->filter) { - Tcl_SetResult(interp, "unknown filter method", TCL_STATIC); + if (pngPtr->filter != PNG_FILTMETH_STANDARD) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown filter method %d", pngPtr->filter)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -1376,7 +1397,8 @@ ReadIHDR( break; default: - Tcl_SetResult(interp, "unknown interlace method", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown interlace method %d", pngPtr->interlace)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_INTERLACE", NULL); return TCL_ERROR; } @@ -1420,8 +1442,8 @@ ReadPLTE( switch (pngPtr->colorType) { case PNG_COLOR_GRAY: case PNG_COLOR_GRAYALPHA: - Tcl_SetResult(interp, "PLTE chunk type forbidden for grayscale", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk type forbidden for grayscale", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PLTE_UNEXPECTED", NULL); return TCL_ERROR; @@ -1437,7 +1459,8 @@ ReadPLTE( */ if (!chunkSz || (chunkSz > PNG_PLTE_MAXSZ) || (chunkSz % 3)) { - Tcl_SetResult(interp, "invalid palette chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid palette chunk size", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PLTE", NULL); return TCL_ERROR; } @@ -1500,9 +1523,9 @@ ReadTRNS( int i; if (pngPtr->colorType & PNG_COLOR_ALPHA) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "tRNS chunk not allowed color types with a full alpha channel", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_TRNS", NULL); return TCL_ERROR; } @@ -1513,7 +1536,8 @@ ReadTRNS( */ if (chunkSz > PNG_TRNS_MAXSZ) { - Tcl_SetResult(interp, "invalid tRNS chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1543,9 +1567,8 @@ ReadTRNS( */ if (chunkSz > pngPtr->paletteLen) { - Tcl_SetResult(interp, - "size of tRNS chunk is too large for the palette", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "size of tRNS chunk is too large for the palette", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TRNS_SIZE", NULL); return TCL_ERROR; } @@ -1562,9 +1585,9 @@ ReadTRNS( */ if (chunkSz != 2) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "invalid tRNS chunk size - must 2 bytes for grayscale", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1589,9 +1612,8 @@ ReadTRNS( */ if (chunkSz != 6) { - Tcl_SetResult(interp, - "invalid tRNS chunk size - must 6 bytes for RGB", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 6 bytes for RGB", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1773,7 +1795,8 @@ UnfilterLine( } break; default: - Tcl_SetResult(interp, "invalid filter type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid filter type %d", *thisLine)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -2081,8 +2104,8 @@ ReadIDAT( */ if (Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_SetResult(interp, "extra data after end of zlib stream", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after end of zlib stream", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; @@ -2123,9 +2146,9 @@ ReadIDAT( if (len2 == pngPtr->phaseSize) { if (pngPtr->phase > 7) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "extra data after final scan line of final phase", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; @@ -2170,8 +2193,8 @@ ReadIDAT( */ if (chunkSz != 0) { - Tcl_AppendResult(interp, - "compressed data after stream finalize in PNG data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "compressed data after stream finalize in PNG data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2308,9 +2331,8 @@ ParseFormat( } if ((pngPtr->alpha < 0.0) || (pngPtr->alpha > 1.0)) { - Tcl_SetResult(interp, - "-alpha value must be between 0.0 and 1.0", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-alpha value must be between 0.0 and 1.0", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_ALPHA", NULL); return TCL_ERROR; @@ -2402,8 +2424,8 @@ DecodePNG( return TCL_ERROR; } } else if (PNG_COLOR_PLTE == pngPtr->colorType) { - Tcl_SetResult(interp, "PLTE chunk required for indexed color", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk required for indexed color", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_PLTE", NULL); return TCL_ERROR; } @@ -2439,9 +2461,9 @@ DecodePNG( * interested in IDAT. The others should have been skipped. */ - if (CHUNK_IDAT != chunkType) { - Tcl_SetResult(interp, "at least one IDAT chunk is required", - TCL_STATIC); + if (chunkType != CHUNK_IDAT) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "at least one IDAT chunk is required", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_IDAT", NULL); return TCL_ERROR; } @@ -2463,9 +2485,9 @@ DecodePNG( */ if (pngPtr->block.width > ((INT_MAX - 1) / (pngPtr->numChannels * 2))) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "line size is out of supported range on this architecture", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "LINE_SIZE", NULL); return TCL_ERROR; } @@ -2491,7 +2513,8 @@ DecodePNG( pngPtr->block.pixelPtr = attemptckalloc(pngPtr->blockLen); if (!pngPtr->block.pixelPtr) { - Tcl_SetResult(interp, "memory allocation failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } @@ -2542,7 +2565,8 @@ DecodePNG( */ if (!Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_AppendResult(interp, "unfinalized data stream in PNG data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unfinalized data stream in PNG data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2567,8 +2591,8 @@ DecodePNG( */ if (chunkSz) { - Tcl_SetResult(interp, "IEND chunk contents must be empty", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "IEND chunk contents must be empty", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } @@ -2588,7 +2612,8 @@ DecodePNG( #if 0 if (ReadData(interp, pngPtr, &c, 1, NULL) != TCL_ERROR) { - Tcl_SetResult(interp, "extra data following IEND chunk", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data following IEND chunk", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } @@ -2841,9 +2866,8 @@ WriteData( Tcl_GetByteArrayFromObj(pngPtr->objDataPtr, &objSz); if (objSz > INT_MAX - srcSz) { - Tcl_SetResult(interp, - "image too large to store completely in byte array", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image too large to store completely in byte array", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } @@ -2851,15 +2875,16 @@ WriteData( destPtr = Tcl_SetByteArrayLength(pngPtr->objDataPtr, objSz + srcSz); if (!destPtr) { - Tcl_SetResult(interp, "memory allocation failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } memcpy(destPtr+objSz, srcPtr, srcSz); } else if (Tcl_Write(pngPtr->channel, (const char *) srcPtr, srcSz) < 0) { - Tcl_AppendResult(interp, "write to channel failed: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "write to channel failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -3174,7 +3199,8 @@ WriteIDAT( } if (Tcl_ZlibStreamPut(pngPtr->stream, pngPtr->thisLineObj, flush) != TCL_OK) { - Tcl_SetResult(interp, "deflate() returned error", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "deflate() returned error", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DEFLATE", NULL); return TCL_ERROR; } @@ -3349,8 +3375,8 @@ EncodePNG( if ((blockPtr->width > (INT_MAX - 1) / (pngPtr->bytesPerPixel)) || (blockPtr->height > INT_MAX / pngPtr->lineSize)) { - Tcl_SetResult(interp, "image is too large to encode pixel data", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image is too large to encode pixel data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c index 0378d16..edd1b71 100644 --- a/generic/tkImgPPM.c +++ b/generic/tkImgPPM.c @@ -147,23 +147,21 @@ FileReadPPM( type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read raw PPM header from file \"%s\"", fileName)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has dimension(s) <= 0", fileName)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has bad maximum intensity value ", buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has bad maximum intensity value %d", + fileName, maxIntensity)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -221,10 +219,12 @@ FileReadPPM( } count = Tcl_Read(chan, (char *) pixelPtr, nBytes); if (count != nBytes) { - Tcl_AppendResult(interp, "error reading PPM image file \"", - fileName, "\": ", - Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading PPM image file \"%s\": %s", fileName, + Tcl_Eof(chan)?"not enough data":Tcl_PosixError(interp))); + if (Tcl_Eof(chan)) { + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "EOF", NULL); + } ckfree(pixelPtr); return TCL_ERROR; } @@ -328,8 +328,8 @@ FileWritePPM( chan = NULL; writeerror: - Tcl_AppendResult(interp, "error writing \"", fileName, "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", + fileName, Tcl_PosixError(interp))); if (chan != NULL) { Tcl_Close(NULL, chan); } @@ -485,24 +485,21 @@ StringReadPPM( type = ReadPPMStringHeader(dataObj, &fileWidth, &fileHeight, &maxIntensity, &dataBuffer, &dataSize); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from string", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't read raw PPM header from string", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image data has dimension(s) <= 0", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PPM image data has dimension(s) <= 0", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, - "PPM image data has bad maximum intensity value ", buffer, - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image data has bad maximum intensity value %d", + maxIntensity)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -544,7 +541,8 @@ StringReadPPM( */ if (block.pitch*height > dataSize) { - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } @@ -579,7 +577,8 @@ StringReadPPM( } if (dataSize < nBytes) { ckfree(pixelPtr); - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index d1e8524..3eff18d 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -562,9 +562,9 @@ ImgPhotoCmd( srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name)); if (srcHandle == NULL) { - Tcl_AppendResult(interp, "image \"", - Tcl_GetString(options.name), "\" doesn't", - " exist or is not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist or is not a photo image", + Tcl_GetString(options.name))); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO", NULL); return TCL_ERROR; } @@ -572,8 +572,9 @@ ImgPhotoCmd( if ((options.fromX2 > block.width) || (options.fromY2 > block.height) || (options.fromX2 > block.width) || (options.fromY2 > block.height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -626,8 +627,8 @@ ImgPhotoCmd( if (options.options & OPT_SHRINK) { if (ImgPhotoSetSize(masterPtr, options.toX2, options.toY2) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } @@ -675,8 +676,8 @@ ImgPhotoCmd( || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -723,9 +724,10 @@ ImgPhotoCmd( } } if (stringWriteProc == NULL) { - Tcl_AppendResult(interp, "image string format \"", - Tcl_GetString(options.format), "\" is ", - (matched ? "not supported" : "unknown"), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image string format \"%s\" is %s", + Tcl_GetString(options.format), + (matched ? "not supported" : "unknown"))); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", NULL); return TCL_ERROR; @@ -788,8 +790,9 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ", - "coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s get: coordinates out of range", + Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TK", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -884,8 +887,9 @@ ImgPhotoCmd( pixelPtr = ckalloc(dataWidth * dataHeight * 3); block.pixelPtr = pixelPtr; } else if (listObjc != dataWidth) { - Tcl_AppendResult(interp, "all elements of color list must", - " have the same number of elements", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "all elements of color list must have the same" + " number of elements", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "NON_RECTANGULAR", NULL); break; @@ -930,8 +934,8 @@ ImgPhotoCmd( if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), colorString, &color)) { - Tcl_AppendResult(interp, "can't parse color \"", - colorString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't parse color \"%s\"", colorString)); Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); break; } @@ -1003,8 +1007,8 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get image from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "SAFE", NULL); return TCL_ERROR; } @@ -1043,8 +1047,9 @@ ImgPhotoCmd( if ((options.fromX > imageWidth) || (options.fromY > imageHeight) || (options.fromX2 > imageWidth) || (options.fromY2 > imageHeight)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); Tcl_Close(NULL, chan); return TCL_ERROR; @@ -1065,7 +1070,8 @@ ImgPhotoCmd( if (ImgPhotoSetSize(masterPtr, options.toX + width, options.toY + height) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } @@ -1157,8 +1163,9 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency get: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency get: coordinates out of range", + Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TK", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -1195,8 +1202,9 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency set: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency set: coordinates out of range", + Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TK", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -1260,8 +1268,8 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't write image to a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't write image to a file in a safe interpreter", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "SAFE", NULL); return TCL_ERROR; } @@ -1287,8 +1295,8 @@ ImgPhotoCmd( || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -1356,14 +1364,16 @@ ImgPhotoCmd( } if (imageFormat == NULL) { if (fmtString == NULL) { - Tcl_AppendResult(interp, "no available image file format ", - "has file writing capability", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no available image file format has file writing" + " capability", -1)); } else if (!matched) { - Tcl_AppendResult(interp, "image file format \"", - fmtString, "\" is unknown", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is unknown", fmtString)); } else { - Tcl_AppendResult(interp, "image file format \"", - fmtString, "\" has no file writing capability", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" has no file writing capability", + fmtString)); } Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", fmtString, NULL); @@ -1502,9 +1512,9 @@ ParseSubcommandOptions( */ if ((allowedOptions & bit) == 0) { + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unrecognized option \"", - Tcl_GetString(objv[index]), - "\": must be ", NULL); + Tcl_GetString(objv[index]), "\": must be ", NULL); bit = 1; for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((allowedOptions & bit) != 0) { @@ -1540,8 +1550,8 @@ ParseSubcommandOptions( return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "the \"-background\" option ", - "requires a value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-background\" option requires a value", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL); return TCL_ERROR; @@ -1556,8 +1566,8 @@ ParseSubcommandOptions( *optIndexPtr = ++index; optPtr->format = objv[index]; } else { - Tcl_AppendResult(interp, "the \"-format\" option ", - "requires a value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-format\" option requires a value", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL); return TCL_ERROR; @@ -1586,8 +1596,9 @@ ParseSubcommandOptions( } *optIndexPtr = index; } else { - Tcl_AppendResult(interp, "the \"-compositingrule\" option ", - "requires a value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-compositingrule\" option requires a value", + -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL); return TCL_ERROR; @@ -1614,9 +1625,9 @@ ParseSubcommandOptions( } if (numValues == 0) { - Tcl_AppendResult(interp, "the \"", option, "\" option ", - "requires one ", maxValues == 2? "or two": "to four", - " integer values", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires one %s integer values", + option, (maxValues == 2) ? "or two": "to four")); Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL); return TCL_ERROR; @@ -1643,8 +1654,9 @@ ParseSubcommandOptions( case OPT_FROM: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -from", - " option must be non-negative", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value(s) for the -from option must be" + " non-negative", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -1667,8 +1679,9 @@ ParseSubcommandOptions( case OPT_TO: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -to", - " option must be non-negative", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value(s) for the -to option must be non-negative", + -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_TO", NULL); return TCL_ERROR; } @@ -1686,8 +1699,9 @@ ParseSubcommandOptions( break; case OPT_ZOOM: if ((values[0] <= 0) || (values[1] <= 0)) { - Tcl_AppendResult(interp, "value(s) for the -zoom", - " option must be positive", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value(s) for the -zoom option must be positive", + -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_ZOOM", NULL); return TCL_ERROR; } @@ -1758,8 +1772,8 @@ ImgPhotoConfigureMaster( j--; } else { ckfree(args); - Tcl_AppendResult(interp, - "value for \"-data\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-data\" missing", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL); return TCL_ERROR; @@ -1771,8 +1785,8 @@ ImgPhotoConfigureMaster( j--; } else { ckfree(args); - Tcl_AppendResult(interp, - "value for \"-format\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-format\" missing", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL); return TCL_ERROR; @@ -1864,8 +1878,8 @@ ImgPhotoConfigureMaster( if (ImgPhotoSetSize(masterPtr, masterPtr->width, masterPtr->height) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -1884,8 +1898,9 @@ ImgPhotoConfigureMaster( if (Tcl_IsSafe(interp)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "can't get image from a file in a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", + -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "SAFE", NULL); goto errorExit; } @@ -1910,8 +1925,8 @@ ImgPhotoConfigureMaster( result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight); if (result != TCL_OK) { Tcl_Close(NULL, chan); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -1941,8 +1956,8 @@ ImgPhotoConfigureMaster( goto errorExit; } if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -2387,8 +2402,9 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_FILE_FORMAT", NULL); return TCL_ERROR; @@ -2420,8 +2436,9 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_FILE_FORMAT", NULL); return TCL_ERROR; @@ -2445,13 +2462,14 @@ MatchFileFormat( if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image file format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is not supported", + formatString)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", NULL); } else { - Tcl_AppendResult(interp, - "couldn't recognize data in image file \"", fileName, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't recognize data in image file \"%s\"", + fileName)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "UNRECOGNIZED_DATA", NULL); } @@ -2523,8 +2541,9 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_DATA_FORMAT", NULL); return TCL_ERROR; @@ -2549,8 +2568,9 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_DATA_FORMAT", NULL); return TCL_ERROR; @@ -2568,11 +2588,12 @@ MatchStringFormat( } if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image format \"%s\" is not supported", formatString)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", NULL); } else { - Tcl_AppendResult(interp, "couldn't recognize image data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't recognize image data", -1)); Tcl_SetErrorCode(interp, "TK", "PHOTO", "UNRECOGNIZED_DATA", NULL); } @@ -2691,8 +2712,8 @@ Tk_PhotoPutBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; @@ -3088,8 +3109,8 @@ Tk_PhotoPutZoomedBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; @@ -3487,8 +3508,8 @@ Tk_PhotoExpand( if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width), MAX(height, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; @@ -3562,8 +3583,8 @@ Tk_PhotoSetSize( if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width), ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; diff --git a/generic/tkListbox.c b/generic/tkListbox.c index e8817af..355db5b 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -872,8 +872,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", - Tcl_GetString(objv[2]), "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEMIDX", NULL); result = TCL_ERROR; break; } @@ -907,8 +909,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", Tcl_GetString(objv[2]), - "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEMIDX", NULL); result = TCL_ERROR; break; } @@ -2742,18 +2746,12 @@ GetListboxIndex( start = stringRep + 1; y = strtol(start, &end, 0); if ((start == end) || (*end != ',')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } start = end+1; y = strtol(start, &end, 0); if ((start == end) || (*end != '\0')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } *indexPtr = NearestListboxElement(listPtr, y); return TCL_OK; @@ -2771,10 +2769,11 @@ GetListboxIndex( * Everything failed, nothing matched. Throw up an error message. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad listbox index \"", - Tcl_GetString(indexObj), "\": must be active, anchor, ", - "end, @x,y, or a number", NULL); + badIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad listbox index \"%s\": must be active, anchor, end, @x,y," + " or a number", Tcl_GetString(indexObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 49f49ad..12d6ebd 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -374,8 +374,8 @@ static void TkMenuCleanup(ClientData unused); static const Tk_ClassProcs menuClass = { sizeof(Tk_ClassProcs), /* size */ MenuWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -889,7 +889,7 @@ MenuWidgetObjCmd( goto error; } if (index < 0) { - Tcl_SetResult(interp, "none", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); } @@ -966,6 +966,7 @@ MenuWidgetObjCmd( } case MENU_TYPE: { int index; + const char *typeStr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -978,11 +979,11 @@ MenuWidgetObjCmd( goto done; } if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { - Tcl_SetResult(interp, "tearoff", TCL_STATIC); + typeStr = "tearoff"; } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - menuEntryTypeStrings[menuPtr->entries[index]->type], -1)); + typeStr = menuEntryTypeStrings[menuPtr->entries[index]->type]; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); break; } case MENU_UNPOST: @@ -2206,7 +2207,9 @@ TkGetMenuIndex( } } - Tcl_AppendResult(interp, "bad menu entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad menu entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; success: @@ -2390,9 +2393,9 @@ MenuAddOrInsert( index = menuPtr->numEntries; } if (index < 0) { - const char *indexString = Tcl_GetString(indexPtr); - - Tcl_AppendResult(interp, "bad index \"", indexString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\"", Tcl_GetString(indexPtr))); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; } if (menuPtr->tearoff && (index == 0)) { @@ -3265,6 +3268,7 @@ TkSetWindowMenuBar( && (cloneMenuRefPtr->menuPtr != NULL)) { Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1); Tcl_Obj *nullPtr = Tcl_NewObj(); + cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin; menuBarPtr = cloneMenuRefPtr->menuPtr; newObjv[0] = cursorPtr; @@ -3468,6 +3472,7 @@ TkFindMenuReferencesObj( Tcl_Obj *objPtr) /* The path of the menu widget. */ { const char *pathName = Tcl_GetString(objPtr); + return TkFindMenuReferences(interp, pathName); } diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 31dbfbb..545401c 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -23,8 +23,8 @@ static const Tk_ClassProcs menubuttonClass = { sizeof(Tk_ClassProcs), /* size */ TkMenuButtonWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* diff --git a/generic/tkMessage.c b/generic/tkMessage.c index 0787efc..4779e00 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -191,8 +191,8 @@ static void DisplayMessage(ClientData clientData); static const Tk_ClassProcs messageClass = { sizeof(Tk_ClassProcs), /* size */ MessageWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -277,7 +277,7 @@ Tk_MessageObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(msgPtr->tkwin)); return TCL_OK; } diff --git a/generic/tkObj.c b/generic/tkObj.c index 29a235a..ed947d3 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -735,8 +735,8 @@ SetMMFromAny( */ error: - Tcl_AppendResult(interp, "bad screen distance \"", string, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); Tcl_SetErrorCode(interp, "TK", "VALUE", "DISTANCE", NULL); return TCL_ERROR; } @@ -1034,10 +1034,9 @@ TkParsePadAmount( if (specObj->typePtr == &pixelObjType) { if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK){ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", - Tcl_GetString(specObj), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(specObj))); Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1054,8 +1053,8 @@ TkParsePadAmount( return TCL_ERROR; } if (objc != 1 && objc != 2) { - Tcl_AppendResult(interp, - "wrong number of parts to pad specification", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong number of parts to pad specification", -1)); Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "PARTS", NULL); return TCL_ERROR; } @@ -1066,9 +1065,9 @@ TkParsePadAmount( if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK || (firstInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1082,10 +1081,9 @@ TkParsePadAmount( secondInt = firstInt; } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1], &secondInt) != TCL_OK || (secondInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad 2nd pad value \"", - Tcl_GetString(objv[1]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad 2nd pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index 49d505e..5496076 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -95,7 +95,7 @@ Tk_ConfigureWidget( * we're on our way out of the application */ - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window", -1)); Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return TCL_ERROR; } @@ -136,7 +136,8 @@ Tk_ConfigureWidget( */ if (argc < 2) { - Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", arg)); Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); return TCL_ERROR; } @@ -266,8 +267,8 @@ FindConfigSpec( goto gotMatch; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", argvName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", argvName)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL); return NULL; } @@ -275,7 +276,8 @@ FindConfigSpec( } if (matchPtr == NULL) { - Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", argvName)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL); return NULL; } @@ -290,8 +292,9 @@ FindConfigSpec( if (specPtr->type == TK_CONFIG_SYNONYM) { for (specPtr = specs; ; specPtr++) { if (specPtr->type == TK_CONFIG_END) { - Tcl_AppendResult(interp, "couldn't find synonym for option \"", - argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't find synonym for option \"%s\"", + argvName)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL); return NULL; @@ -622,12 +625,13 @@ Tk_ConfigureInfo( Tcl_ResetResult(interp); if (argvName != NULL) { - specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags,hateFlags); + specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags, + hateFlags); if (specPtr == NULL) { return TCL_ERROR; } list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - Tcl_SetResult(interp, list, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(list, -1)); ckfree(list); return TCL_OK; } @@ -932,7 +936,7 @@ Tk_ConfigureValue( } result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, &freeProc); - Tcl_SetResult(interp, (char *) result, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); if (freeProc != NULL) { if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { ckfree(result); diff --git a/generic/tkOption.c b/generic/tkOption.c index a258bb0..24f7e39 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -690,7 +690,7 @@ Tk_OptionObjCmd( value = Tk_GetOption(window, Tcl_GetString(objv[3]), Tcl_GetString(objv[4])); if (value != NULL) { - Tcl_SetResult(interp, (char *) value, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); } break; } @@ -877,9 +877,10 @@ ParsePriority( priority = strtoul(string, &end, 0); if ((end == string) || (*end != 0) || (priority < 0) || (priority > 100)) { - Tcl_AppendResult(interp, "bad priority level \"", string, - "\": must be widgetDefault, startupFile, userDefault, ", - "interactive, or a number between 0 and 100", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad priority level \"%s\": must be " + "widgetDefault, startupFile, userDefault, " + "interactive, or a number between 0 and 100", string)); Tcl_SetErrorCode(interp, "TK", "VALUE", "PRIORITY", NULL); return -1; } @@ -1061,7 +1062,7 @@ ReadOptionFile( Tcl_Interp *interp, /* Interpreter to use for reporting results. */ Tk_Window tkwin, /* Token for window: options are entered for * this window's main window. */ - const char *fileName, /* Name of file containing options. */ + const char *fileName, /* Name of file containing options. */ int priority) /* Priority level to use for options in this * file, such as TK_USER_DEFAULT_PRIO or * TK_INTERACTIVE_PRIO. Must be between 0 and @@ -1078,8 +1079,8 @@ ReadOptionFile( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't read options from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't read options from a file in a safe interpreter", -1)); Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "SAFE", NULL); return TCL_ERROR; } @@ -1091,9 +1092,8 @@ ReadOptionFile( chan = Tcl_OpenFileChannel(interp, realName, "r", 0); Tcl_DStringFree(&newName); if (chan == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't open \"", fileName, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't open \"%s\": %s", + fileName, Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1106,8 +1106,9 @@ ReadOptionFile( Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error seeking to end of file \"", - fileName, "\":", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error seeking to end of file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1115,8 +1116,9 @@ ReadOptionFile( buffer = ckalloc(bufferSize + 1); bufferSize = Tcl_Read(chan, buffer, bufferSize); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error reading file \"", fileName, "\":", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } diff --git a/generic/tkPack.c b/generic/tkPack.c index 3c3b389..4fada47 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -152,7 +152,8 @@ void TkPrintPadAmount( Tcl_Interp *interp, /* The interpreter into which the result is * written. */ - const char *switchName, /* One of "padx", "pady", "ipadx" or "ipady" */ + const char *switchName, /* One of "padx", "pady", "ipadx" or + * "ipady" */ int halfSpace, /* The left or top padding amount */ int allSpace) /* The total amount of padding */ { @@ -239,8 +240,8 @@ Tk_PackObjCmd( } prevPtr = GetPacker(tkwin2); if (prevPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } @@ -273,8 +274,8 @@ Tk_PackObjCmd( } packPtr = GetPacker(tkwin2); if (packPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } @@ -296,8 +297,8 @@ Tk_PackObjCmd( } case PACK_CONFIGURE: if (argv2[0] != '.') { - Tcl_AppendResult(interp, "bad argument \"", argv2, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", argv2)); Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", NULL); return TCL_ERROR; } @@ -337,8 +338,8 @@ Tk_PackObjCmd( } slavePtr = GetPacker(slave); if (slavePtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } @@ -1101,9 +1102,9 @@ PackAfter( for ( ; objc > 0; objc -= 2, objv += 2, prevPtr = packPtr) { if (objc < 2) { - Tcl_AppendResult(interp, "wrong # args: window \"", - Tcl_GetString(objv[0]), "\" should be followed by options", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: \"%s\" should be followed by options", + Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -1126,8 +1127,9 @@ PackAfter( } if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) { badWindow: - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[0]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[0]), + Tk_PathName(masterPtr->tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } @@ -1186,9 +1188,9 @@ PackAfter( } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) { if (optionCount < (index+2)) { missingPad: - Tcl_AppendResult(interp, "wrong # args: \"", curOpt, - "\" option must be followed by screen distance", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: window \"%s\" option must be" + " followed by screen distance", curOpt)); Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; @@ -1216,8 +1218,9 @@ PackAfter( } else if ((c == 'f') && (length > 1) && (strncmp(curOpt, "frame", (size_t) length) == 0)) { if (optionCount < (index+2)) { - Tcl_AppendResult(interp, "wrong # args: \"frame\" ", - "option must be followed by anchor point", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args: \"frame\"" + " option must be followed by anchor point", -1)); Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; @@ -1228,9 +1231,10 @@ PackAfter( } index++; } else { - Tcl_AppendResult(interp, "bad option \"", curOpt, - "\": should be top, bottom, left, right, expand, ", - "fill, fillx, filly, padx, pady, or frame", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": should be top, bottom, left," + " right, expand, fill, fillx, filly, padx, pady, or" + " frame", curOpt)); Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; @@ -1238,7 +1242,6 @@ PackAfter( } if (packPtr != prevPtr) { - /* * Unpack this window if it's currently packed. */ @@ -1547,8 +1550,9 @@ ConfigureSlaves( return TCL_ERROR; } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't pack \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -1572,9 +1576,9 @@ ConfigureSlaves( for (i = numWindows; i < objc; i+=2) { if ((i+2) > objc) { - Tcl_AppendResult(interp, "extra option \"", - Tcl_GetString(objv[i]), - "\" (option with no value?)", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "extra option \"%s\" (option with no value?)", + Tcl_GetString(objv[i]))); Tcl_SetErrorCode(interp, "TK", "PACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -1593,9 +1597,9 @@ ConfigureSlaves( prevPtr = GetPacker(other); if (prevPtr->masterPtr == NULL) { notPacked: - Tcl_AppendResult(interp, "window \"", - Tcl_GetString(objv[i+1]), "\" isn't packed", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", + Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; @@ -1652,8 +1656,9 @@ ConfigureSlaves( } else if (strcmp(string, "both") == 0) { slavePtr->flags |= FILLX|FILLY; } else { - Tcl_AppendResult(interp, "bad fill style \"", string, - "\": must be none, x, y, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad fill style \"%s\": must be " + "none, x, y, or both", string)); Tcl_SetErrorCode(interp, "TK", "VALUE", "FILL", NULL); return TCL_ERROR; } @@ -1676,12 +1681,10 @@ ConfigureSlaves( break; case CONF_IPADX: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } @@ -1689,12 +1692,10 @@ ConfigureSlaves( break; case CONF_IPADY: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } @@ -1772,15 +1773,16 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } if (slave == masterPtr->tkwin) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside itself", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside itself", Tcl_GetString(objv[j]))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 23ecf5d..b6080b1 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -658,10 +658,12 @@ PanedWindowWidgetObjCmd( objv[3], tkwin); } } - if (i == pwPtr->numSlaves) { - Tcl_SetResult(interp, "not managed by this window", TCL_STATIC); - } if (resultObj == NULL) { + if (i == pwPtr->numSlaves) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not managed by this window", -1)); + Tcl_SetErrorCode(interp, "TK", "PANEDWIN", "UNMANAGED", NULL); + } result = TCL_ERROR; } else { Tcl_SetObjResult(interp, resultObj); @@ -700,15 +702,11 @@ PanedWindowWidgetObjCmd( case PW_PANES: resultObj = Tcl_NewObj(); - - Tcl_IncrRefCount(resultObj); - for (i = 0; i < pwPtr->numSlaves; i++) { - Tcl_ListObjAppendElement(interp, resultObj, - Tcl_NewStringObj(Tk_PathName(pwPtr->slaves[i]->tkwin),-1)); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj(pwPtr->slaves[i]->tkwin)); } Tcl_SetObjResult(interp, resultObj); - Tcl_DecrRefCount(resultObj); break; case PW_PROXY: @@ -778,18 +776,19 @@ ConfigureSlaves( * A panedwindow cannot manage itself. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to itself", arg)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } else if (Tk_IsTopLevel(tkwin)) { /* * A panedwindow cannot manage a toplevel. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add toplevel ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add toplevel %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } else { /* @@ -803,9 +802,11 @@ ConfigureSlaves( break; } if (Tk_IsTopLevel(ancestor)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); return TCL_ERROR; } } @@ -862,9 +863,10 @@ ConfigureSlaves( */ if (haveLoc && index == -1) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkwin), - "\" is not managed by ", Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not managed by %s", + Tk_PathName(tkwin), Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", NULL); Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin); return TCL_ERROR; @@ -1086,7 +1088,6 @@ PanedWindowSashCommand( return TCL_ERROR; } - Tcl_ResetResult(interp); switch ((enum sashOptions) index) { case SASH_COORD: if (objc != 4) { @@ -1099,8 +1100,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_IDX", NULL); return TCL_ERROR; } slavePtr = pwPtr->slaves[sash]; @@ -1121,8 +1123,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_IDX", NULL); return TCL_ERROR; } @@ -1156,8 +1159,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_IDX", NULL); return TCL_ERROR; } @@ -2398,10 +2402,11 @@ SetSticky( case ' ': case ',': case '\t': case '\r': case '\n': break; default: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(*value), "\": must be a string ", - "containing zero or more of n, e, s, and w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be a string" + " containing zero or more of n, e, s, and w", + Tcl_GetString(*value))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } } @@ -2654,7 +2659,7 @@ MoveSash( * None. * * Side effects: - * When the window gets deleted, internal structures get cleaned up. Whena + * When the window gets deleted, internal structures get cleaned up. When * it gets exposed, it is redisplayed. * *-------------------------------------------------------------- @@ -2958,10 +2963,8 @@ PanedWindowIdentifyCoords( Tcl_Interp *interp, /* Interpreter in which to store result. */ int x, int y) /* Coordinates of the point to identify. */ { - Tcl_Obj *list; int i, sashHeight, sashWidth, thisx, thisy; int found, isHandle, lpad, rpad, tpad, bpad; - list = Tcl_NewObj(); if (pwPtr->orient == ORIENT_HORIZONTAL) { if (Tk_IsMapped(pwPtr->tkwin)) { @@ -3036,16 +3039,17 @@ PanedWindowIdentifyCoords( } /* - * Set results. + * Set results. Note that the empty string is the default (this function + * is called inside the implementation of a command). */ if (found != -1) { - Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(found)); - Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj( - (isHandle ? "handle" : "sash"), -1)); - } + Tcl_Obj *list[2]; - Tcl_SetObjResult(interp, list); + list[0] = Tcl_NewIntObj(found); + list[1] = Tcl_NewStringObj((isHandle ? "handle" : "sash"), -1); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, list)); + } return TCL_OK; } diff --git a/generic/tkPlace.c b/generic/tkPlace.c index a0d3562..8fe2bd1 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -619,8 +619,9 @@ ConfigureSlave( Tk_Window masterWin = (Tk_Window) NULL; if (Tk_TopWinHierarchy(tkwin)) { - Tcl_AppendResult(interp, "can't use placer on top-level window \"", - Tk_PathName(tkwin), "\"; use wm command instead", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use placer on top-level window \"%s\"; use " + "wm command instead", Tk_PathName(tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -679,17 +680,17 @@ ConfigureSlave( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to ", - Tk_PathName(tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to %s", + Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } if (slavePtr->tkwin == tkwin) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to itself", + Tk_PathName(slavePtr->tkwin))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index c41387c..2dadf29 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -318,17 +318,13 @@ RectOvalCoords( */ if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[0])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[1])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[2])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[3])); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *bbox[4]; + + bbox[0] = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]); + bbox[1] = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]); + bbox[2] = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]); + bbox[3] = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); return TCL_OK; } @@ -350,6 +346,9 @@ RectOvalCoords( if (objc != 4) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 0 or 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", + (rectOvalPtr->header.typePtr == &tkRectangleType + ? "RECTANGLE" : "OVAL"), NULL); return TCL_ERROR; } @@ -513,9 +512,10 @@ ConfigureRectOval( } #ifdef MAC_OSX_TK /* - * Mac OS X CG drawing needs access to the outline linewidth - * even for fills (as linewidth controls antialiasing). + * Mac OS X CG drawing needs access to the outline linewidth even for + * fills (as linewidth controls antialiasing). */ + gcValues.line_width = rectOvalPtr->outline.gc != None ? rectOvalPtr->outline.gc->line_width : 0; mask |= GCLineWidth; @@ -675,7 +675,7 @@ ComputeRectOvalBbox( bloat = 1; #else bloat = 0; -#endif +#endif /* __WIN32__ */ } else { #ifdef MAC_OSX_TK /* @@ -687,7 +687,7 @@ ComputeRectOvalBbox( bloat = (int) (width+1.5)/2; #else bloat = (int) (width+1)/2; -#endif +#endif /* MAC_OSX_TK */ } /* @@ -755,9 +755,9 @@ DisplayRectOval( * will die if it isn't. */ - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0],rectOvalPtr->bbox[1], &x1, &y1); - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2],rectOvalPtr->bbox[3], &x2, &y2); if (x2 <= x1) { x2 = x1+1; diff --git a/generic/tkScale.c b/generic/tkScale.c index 5e577e9..3ca4a67 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -376,6 +376,7 @@ ScaleWidgetObjCmd( case COMMAND_COORDS: { int x, y; double value; + Tcl_Obj *coords[2]; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); @@ -397,7 +398,9 @@ ScaleWidgetObjCmd( y = scalePtr->horizTroughY + scalePtr->width/2 + scalePtr->borderWidth; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", x, y)); + coords[0] = Tcl_NewIntObj(x); + coords[1] = Tcl_NewIntObj(y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); break; } case COMMAND_GET: { @@ -421,7 +424,8 @@ ScaleWidgetObjCmd( break; } case COMMAND_IDENTIFY: { - int x, y, thing; + int x, y; + const char *zone = ""; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); @@ -431,18 +435,12 @@ ScaleWidgetObjCmd( || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScaleElement(scalePtr, x,y); - switch (thing) { - case TROUGH1: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case TROUGH2: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; + switch (TkpScaleElement(scalePtr, x, y)) { + case TROUGH1: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case TROUGH2: zone = "trough2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); break; } case COMMAND_SET: { diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 49ddca0..fb06093 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -12,6 +12,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +/* + * TODO: Convert scrollbars to the Tcl_Obj API. + */ + #include "tkInt.h" #include "tkScrollbar.h" #include "default.h" @@ -132,8 +136,10 @@ Tk_ScrollbarCmd( Tk_Window newWin; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?-option value ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s pathName ?-option value ...?\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -230,8 +236,9 @@ ScrollbarWidgetCmd( int c; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s option ?arg ...?\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } Tcl_Preserve(scrollPtr); @@ -239,23 +246,23 @@ ScrollbarWidgetCmd( length = strlen(argv[1]); if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { int oldActiveField; + if (argc == 2) { + const char *zone = ""; + switch (scrollPtr->activeField) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + case TOP_ARROW: zone = "arrow1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); goto done; } if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " activate element\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s activate element\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } c = argv[2][0]; @@ -276,9 +283,9 @@ ScrollbarWidgetCmd( } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) && (length >= 2)) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " cget option\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s cget option\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } result = Tk_ConfigureValue(interp, scrollPtr->tkwin, @@ -300,8 +307,10 @@ ScrollbarWidgetCmd( double fraction; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delta xDelta yDelta\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s delta xDelta yDelta\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK) @@ -328,8 +337,9 @@ ScrollbarWidgetCmd( double fraction; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " fraction x y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s fraction x y\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) @@ -357,20 +367,19 @@ ScrollbarWidgetCmd( } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + Tcl_Obj *resObjs[4]; + if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s get\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if (scrollPtr->flags & NEW_STYLE_COMMANDS) { - Tcl_Obj *resObjs[2]; - resObjs[0] = Tcl_NewDoubleObj(scrollPtr->firstFraction); resObjs[1] = Tcl_NewDoubleObj(scrollPtr->lastFraction); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resObjs)); } else { - Tcl_Obj *resObjs[4]; - resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits); resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits); resObjs[2] = Tcl_NewIntObj(scrollPtr->firstUnit); @@ -378,35 +387,27 @@ ScrollbarWidgetCmd( Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs)); } } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { - int x, y, thing; + int x, y; + const char *zone = ""; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " identify x y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s identify x y\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScrollbarPosition(scrollPtr, x,y); - switch (thing) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case TOP_GAP: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_GAP: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + switch (TkpScrollbarPosition(scrollPtr, x, y)) { + case TOP_ARROW: zone = "arrow1"; break; + case TOP_GAP: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_GAP: zone = "trough2"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { int totalUnits, windowUnits, firstUnit, lastUnit; @@ -473,18 +474,22 @@ ScrollbarWidgetCmd( } scrollPtr->flags &= ~NEW_STYLE_COMMANDS; } else { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " set firstFraction lastFraction\" or \"", - argv[0], - " set totalUnits windowUnits firstUnit lastUnit\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be " + "\"%s set firstFraction lastFraction\" or " + "\"%s set totalUnits windowUnits firstUnit lastUnit\"", + argv[0], argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } TkpComputeScrollbarGeometry(scrollPtr); TkScrollbarEventuallyRedraw(scrollPtr); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be activate, cget, configure, delta, fraction, ", - "get, identify, or set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be activate, cget, configure," + " delta, fraction, get, identify, or set", argv[1])); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + argv[1], NULL); goto error; } @@ -538,7 +543,7 @@ ConfigureScrollbar( */ if (scrollPtr->command != NULL) { - scrollPtr->commandSize = (int)strlen(scrollPtr->command); + scrollPtr->commandSize = (int) strlen(scrollPtr->command); } else { scrollPtr->commandSize = 0; } @@ -602,8 +607,7 @@ TkScrollbarEventProc( * Tk_FreeOptions handle all the standard option-related stuff. */ - Tk_FreeOptions(configSpecs, (char *) scrollPtr, - scrollPtr->display, 0); + Tk_FreeOptions(configSpecs, (char*) scrollPtr, scrollPtr->display, 0); Tcl_EventuallyFree(scrollPtr, TCL_DYNAMIC); } else if (eventPtr->type == ConfigureNotify) { TkpComputeScrollbarGeometry(scrollPtr); diff --git a/generic/tkSelect.c b/generic/tkSelect.c index ee52ba1..2414b3d 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -638,9 +638,10 @@ Tk_GetSelection( clientData); cantget: - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), + Tk_GetAtomName(tkwin, target))); return TCL_ERROR; } @@ -708,8 +709,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -767,8 +769,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -844,8 +847,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -868,7 +872,8 @@ Tk_SelectionObjCmd( } if ((count < 2) || (count > 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? window command"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? window command"); return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin); @@ -929,8 +934,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -972,7 +978,7 @@ Tk_SelectionObjCmd( if (tkwin == NULL) { return TCL_ERROR; } - winPtr = (TkWindow *)tkwin; + winPtr = (TkWindow *) tkwin; for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->selection == selection) { @@ -986,7 +992,7 @@ Tk_SelectionObjCmd( if ((infoPtr != NULL) && (infoPtr->owner != winPtr->dispPtr->clipWindow)) { - Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner)); } return TCL_OK; } @@ -1285,7 +1291,7 @@ SelGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - const char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend(clientData, portion, -1); return TCL_OK; @@ -1320,13 +1326,11 @@ HandleTclCommand( int maxBytes) /* Maximum # of bytes to store at buffer. */ { CommandInfo *cmdInfoPtr = clientData; - int spaceNeeded, length; -#define MAX_STATIC_SIZE 100 - char staticSpace[MAX_STATIC_SIZE]; - char *command; + int length; + Tcl_Obj *command; const char *string; Tcl_Interp *interp = cmdInfoPtr->interp; - Tcl_DString oldResult; + Tcl_InterpState savedState; int extraBytes, charOffset, count, numChars, code; const char *p; @@ -1363,23 +1367,23 @@ HandleTclCommand( * the offset and maximum # of bytes. */ - spaceNeeded = cmdInfoPtr->cmdLength + 30; - if (spaceNeeded < MAX_STATIC_SIZE) { - command = staticSpace; - } else { - command = ckalloc(spaceNeeded); - } - sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes); + command = Tcl_ObjPrintf("%s %d %d", + cmdInfoPtr->command, charOffset, maxBytes); + Tcl_IncrRefCount(command); /* * Execute the command. Be sure to restore the state of the interpreter * after executing the command. */ - Tcl_DStringInit(&oldResult); - Tcl_DStringGetResult(interp, &oldResult); - code = Tcl_EvalEx(interp, command, -1, TCL_EVAL_GLOBAL); + savedState = Tcl_SaveInterpState(interp, TCL_OK); + code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(command); if (code == TCL_OK) { + /* + * TODO: This assumes that bytes are characters; that's not true! + */ + string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); count = (length > maxBytes) ? maxBytes : length; memcpy(buffer, string, (size_t) count); @@ -1424,11 +1428,7 @@ HandleTclCommand( } count = -1; } - Tcl_DStringResult(interp, &oldResult); - - if (command != staticSpace) { - ckfree(command); - } + (void) Tcl_RestoreInterpState(interp, savedState); Tcl_Release(clientData); Tcl_Release(interp); @@ -1498,6 +1498,7 @@ TkSelDefaultSelection( && (selPtr->target != dispPtr->windowAtom)) { const char *atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target); + Tcl_DStringAppendElement(&ds, atomString); } } @@ -1564,11 +1565,10 @@ LostSelection( ClientData clientData) /* Pointer to LostCommand structure. */ { LostCommand *lostPtr = clientData; - Tcl_Obj *objPtr; - Tcl_Interp *interp; + Tcl_Interp *interp = lostPtr->interp; + Tcl_InterpState savedState; int code; - interp = lostPtr->interp; Tcl_Preserve(interp); /* @@ -1576,19 +1576,13 @@ LostSelection( * it after executing the command. */ - objPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(objPtr); + savedState = Tcl_SaveInterpState(interp, TCL_OK); Tcl_ResetResult(interp); - code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } - - Tcl_SetObjResult(interp, objPtr); - Tcl_DecrRefCount(objPtr); - - Tcl_Release(interp); + (void) Tcl_RestoreInterpState(interp, savedState); /* * Free the storage for the command, since we're done with it now. @@ -1596,6 +1590,7 @@ LostSelection( Tcl_DecrRefCount(lostPtr->cmdObj); ckfree(lostPtr); + Tcl_Release(interp); } /* diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index 53f177d..b4063b5 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -124,9 +124,8 @@ Tk_InitStubs( } if (!stubsPtr) { - Tcl_SetResult(interp, - "This implementation of Tk does not support stubs", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this implementation of Tk does not support stubs", -1)); return NULL; } diff --git a/generic/tkStyle.c b/generic/tkStyle.c index 965230e..d5e1407 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -1356,8 +1356,8 @@ Tk_GetStyle( entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name!=NULL?name:"")); if (entryPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "style \"%s\" doesn't exist", name)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "STYLE", name, NULL); } return (Tk_Style) NULL; diff --git a/generic/tkText.c b/generic/tkText.c index 56a98e7..7978793 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -760,13 +760,13 @@ TextWidgetObjCmd( } else { Tcl_Obj *objPtr = Tk_GetOptionValue(interp, (char *) textPtr, textPtr->optionTable, objv[2], textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } break; case TEXT_COMPARE: { @@ -792,12 +792,7 @@ TextWidgetObjCmd( if ((p[1] == '=') && (p[2] == 0)) { value = (relation <= 0); } else if (p[1] != 0) { - compareError: - Tcl_AppendResult(interp, "bad comparison operator \"", - Tcl_GetString(objv[3]), - "\": must be <, <=, ==, >=, >, or !=", NULL); - result = TCL_ERROR; - goto done; + goto compareError; } } else if (p[0] == '>') { value = (relation > 0); @@ -815,18 +810,26 @@ TextWidgetObjCmd( } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); break; + + compareError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad comparison operator \"%s\": must be" + " <, <=, ==, >=, >, or !=", Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COMPARISON", NULL); + result = TCL_ERROR; + goto done; } case TEXT_CONFIGURE: if (objc <= 3) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) textPtr, textPtr->optionTable, ((objc == 3) ? objv[2] : NULL), textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureText(interp, textPtr, objc-2, objv+2); } @@ -837,7 +840,8 @@ TextWidgetObjCmd( Tcl_Obj *objPtr = NULL; if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? index1 index2"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? index1 index2"); result = TCL_ERROR; goto done; } @@ -859,15 +863,7 @@ TextWidgetObjCmd( char c; if (length < 2 || option[0] != '-') { - badOption: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad option \"", - Tcl_GetString(objv[i]), - "\" must be -chars, -displaychars, -displayindices, ", - "-displaylines, -indices, -lines, -update, ", - "-xpixels, or -ypixels", NULL); - result = TCL_ERROR; - goto done; + goto badOption; } c = option[1]; if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) { @@ -1037,6 +1033,15 @@ TextWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); } break; + + badOption: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\" must be -chars, -displaychars, " + "-displayindices, -displaylines, -indices, -lines, -update, " + "-xpixels, or -ypixels", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INDEXOPT", NULL); + result = TCL_ERROR; + goto done; } case TEXT_DEBUG: if (objc > 3) { @@ -1395,9 +1400,10 @@ TextWidgetObjCmd( goto done; } if (TkTextIndexCmp(indexFromPtr, indexToPtr) > 0) { - Tcl_AppendResult(interp, "Index \"", Tcl_GetString(objv[3]), - "\" before \"", Tcl_GetString(objv[2]), - "\" in the text", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" before \"%s\" in the text", + Tcl_GetString(objv[3]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEXORDER", NULL); result = TCL_ERROR; goto done; } @@ -2054,9 +2060,9 @@ ConfigureText( end = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL); } if (start > end) { - Tcl_AppendResult(interp, - "-startline must be less than or equal to -endline", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-startline must be less than or equal to -endline", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEXORDER", NULL); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -2089,6 +2095,7 @@ ConfigureText( /* Nothing tagged with "sel" */ } else { int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr); + if (line < start) { selChanged = 1; } else { @@ -3657,13 +3664,14 @@ TextSearchCmd( SearchSpec searchSpec; static const char *const switchStrings[] = { + "-hidden", "--", "-all", "-backwards", "-count", "-elide", "-exact", "-forwards", - "-hidden", "-nocase", "-nolinestop", "-overlap", "-regexp", - "-strictlimits", NULL + "-nocase", "-nolinestop", "-overlap", "-regexp", "-strictlimits", NULL }; enum SearchSwitches { + SEARCH_HIDDEN, SEARCH_END, SEARCH_ALL, SEARCH_BACK, SEARCH_COUNT, SEARCH_ELIDE, - SEARCH_EXACT, SEARCH_FWD, SEARCH_HIDDEN, SEARCH_NOCASE, + SEARCH_EXACT, SEARCH_FWD, SEARCH_NOCASE, SEARCH_NOLINESTOP, SEARCH_OVERLAP, SEARCH_REGEXP, SEARCH_STRICTLIMITS }; @@ -3696,21 +3704,20 @@ TextSearchCmd( for (i=2 ; i<objc ; i++) { int index; + if (Tcl_GetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], switchStrings, "switch", 0, + if (Tcl_GetIndexFromObj(NULL, objv[i], switchStrings, "switch", 0, &index) != TCL_OK) { /* - * Hide the -hidden option. + * Hide the -hidden option, generating the error description with + * the side effects of T_GIFO. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad switch \"", Tcl_GetString(objv[i]), - "\": must be --, -all, -backward, -count, -elide, ", - "-exact, -forward, -nocase, -nolinestop, -overlap, ", - "-regexp, or -strictlimits", NULL); + (void) Tcl_GetIndexFromObj(interp, objv[i], switchStrings+1, + "switch", 0, &index); return TCL_ERROR; } @@ -3726,8 +3733,9 @@ TextSearchCmd( break; case SEARCH_COUNT: if (i >= objc-1) { - Tcl_SetResult(interp, "no value given for \"-count\" option", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no value given for \"-count\" option", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "VALUE", NULL); return TCL_ERROR; } i++; @@ -3778,14 +3786,18 @@ TextSearchCmd( } if (searchSpec.noLineStop && searchSpec.exact) { - Tcl_SetResult(interp, "the \"-nolinestop\" option requires the " - "\"-regexp\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-nolinestop\" option requires the \"-regexp\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } if (searchSpec.overlap && !searchSpec.all) { - Tcl_SetResult(interp, "the \"-overlap\" option requires the " - "\"-all\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-overlap\" option requires the \"-all\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } @@ -4402,8 +4414,10 @@ TkTextGetTabs( } if (tabPtr->location <= 0) { - Tcl_AppendResult(interp, "tab stop \"", Tcl_GetString(objv[i]), - "\" is not at a positive distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab stop \"%s\" is not at a positive distance", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TABSTOP", NULL); goto error; } @@ -4433,11 +4447,11 @@ TkTextGetTabs( } lastStop = tabPtr->location; #else - Tcl_AppendResult(interp, - "tabs must be monotonically increasing, but \"", - Tcl_GetString(objv[i]), - "\" is smaller than or equal to the previous tab", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tabs must be monotonically increasing, but \"%s\" is " + "smaller than or equal to the previous tab", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TABSTOP", NULL); goto error; #endif /* _TK_ALLOW_DECREASING_TABS */ } @@ -4568,10 +4582,7 @@ TextDumpCmd( case DUMP_CMD: arg++; if (arg >= objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); - return TCL_ERROR; + goto wrongArgs; } command = objv[arg]; break; @@ -4580,9 +4591,11 @@ TextDumpCmd( } } if (arg >= objc || arg+2 < objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); + wrongArgs: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Usage: %s dump ?-all -image -text -mark -tag -window? " + "?-command script? index ?index2?", Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (what == 0) { @@ -4748,8 +4761,7 @@ DumpLine( int length = last - first; char *range = ckalloc(length + 1); - memcpy(range, segPtr->body.chars + first, - length * sizeof(char)); + memcpy(range, segPtr->body.chars + first, length); range[length] = '\0'; TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, @@ -5122,7 +5134,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditRedo(textPtr)) { - Tcl_AppendResult(interp, "nothing to redo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL); return TCL_ERROR; } break; @@ -5146,7 +5159,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditUndo(textPtr)) { - Tcl_AppendResult(interp, "nothing to undo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL); return TCL_ERROR; } break; diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 1b41e31..d75f61c 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -5987,8 +5987,11 @@ TkTextScanCmd( dInfoPtr->scanTotalYScroll = 0; dInfoPtr->scanMarkY = y; } else { - Tcl_AppendResult(interp, "bad scan option \"", Tcl_GetString(objv[2]), - "\": must be mark or dragto", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } return TCL_OK; @@ -7299,7 +7302,7 @@ CharChunkMeasureChars( return MeasureChars(tkfont, chars, charsLen, start, end-start, startX, maxX, flags, nextXPtr); -#else +#else /* TK_LAYOUT_WITH_BASE_CHUNKS */ { int xDisplacement; int fit, bstart = start, bend = end; @@ -7339,7 +7342,7 @@ CharChunkMeasureChars( return fit - bstart; } } -#endif +#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ } /* diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index 47ee49a..0bb8f41 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -155,8 +155,10 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } objPtr = Tk_GetOptionValue(interp, (char *) &eiPtr->body.ei, @@ -178,14 +180,17 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } if (objc <= 5) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, (objc == 5) ? objv[4] : NULL, textPtr->tkwin); + if (objPtr == NULL) { return TCL_ERROR; } else { @@ -323,11 +328,12 @@ EmbImageConfigure( Tcl_HashEntry *hPtr; Tcl_HashSearch search; char *name; + int dummy; int count = 0; /* The counter for picking a unique name */ int conflict = 0; /* True if we have a name conflict */ - size_t len; /* length of image name */ + size_t len; /* length of image name */ - if (Tk_SetOptions(textPtr->interp, (char*)&eiPtr->body.ei, + if (Tk_SetOptions(textPtr->interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, objc, objv, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; @@ -369,9 +375,11 @@ EmbImageConfigure( name = eiPtr->body.ei.imageString; } if (name == NULL) { - Tcl_AppendResult(textPtr->interp, "Either a \"-name\" ", - "or a \"-image\" argument must be provided ", - "to the \"image create\" subcommand.", NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj( + "Either a \"-name\" or a \"-image\" argument must be" + " provided to the \"image create\" subcommand", -1)); + Tcl_SetErrorCode(textPtr->interp, "TK", "TEXT", "IMAGE_CREATE_USAGE", + NULL); return TCL_ERROR; } len = strlen(name); @@ -403,14 +411,10 @@ EmbImageConfigure( Tcl_DStringAppend(&newName, buf, -1); } name = Tcl_DStringValue(&newName); - { - int dummy; - - hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, - &dummy); - } + hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, + &dummy); Tcl_SetHashValue(hPtr, eiPtr); - Tcl_AppendResult(textPtr->interp, name, NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj(name, -1)); eiPtr->body.ei.name = ckalloc(Tcl_DStringLength(&newName) + 1); strcpy(eiPtr->body.ei.name, name); Tcl_DStringFree(&newName); diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index c11ce0b..4fe97eb 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -84,6 +84,7 @@ FreeTextIndexInternalRep( * free. */ { TkTextIndex *indexPtr = GET_TEXTINDEX(indexObjPtr); + if (indexPtr->textPtr != NULL) { if (--indexPtr->textPtr->refCount == 0) { /* @@ -133,7 +134,6 @@ UpdateStringOfTextIndex( { char buffer[TK_POS_CHARS]; register int len; - const TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); len = TkTextPrintIndex(indexPtr->textPtr, indexPtr, buffer); @@ -148,8 +148,10 @@ SetTextIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_AppendResult(interp, "can't convert value to textindex except " - "via TkTextGetIndexFromObj API", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't convert value to textindex except via" + " TkTextGetIndexFromObj API", -1)); + Tcl_SetErrorCode(interp, "TK", "ILLEGAL_API_USAGE", NULL); return TCL_ERROR; } @@ -835,10 +837,10 @@ GetIndex( tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr); } } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "text doesn't contain any characters tagged with \"", - tagName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "text doesn't contain any characters tagged with \"%s\"", + tagName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_INDEX", NULL); Tcl_DStringFree(©); return TCL_ERROR; } @@ -1001,8 +1003,8 @@ GetIndex( error: Tcl_DStringFree(©); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad text index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad text index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "BAD_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 76ab1a9..52df787 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -26,6 +26,7 @@ * Forward references for functions defined in this file: */ +static Tcl_Obj * GetMarkName(TkText *textPtr, TkTextSegment *segPtr); static void InsertUndisplayProc(TkText *textPtr, TkTextDispChunk *chunkPtr); static int MarkDeleteProc(TkTextSegment *segPtr, @@ -140,18 +141,23 @@ TkTextMarkCmd( } else { hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, str); if (hPtr == NULL) { - Tcl_AppendResult(interp, "there is no mark named \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "there is no mark named \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_MARK", NULL); return TCL_ERROR; } markPtr = Tcl_GetHashValue(hPtr); } if (objc == 4) { + const char *typeStr; + if (markPtr->typePtr == &tkTextRightMarkType) { - Tcl_SetResult(interp, "right", TCL_STATIC); + typeStr = "right"; } else { - Tcl_SetResult(interp, "left", TCL_STATIC); + typeStr = "left"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); return TCL_OK; } str = Tcl_GetStringFromObj(objv[4],&length); @@ -162,8 +168,9 @@ TkTextMarkCmd( (strncmp(str, "right", (unsigned) length) == 0)) { newTypePtr = &tkTextRightMarkType; } else { - Tcl_AppendResult(interp, "bad mark gravity \"", str, - "\": must be left or right", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mark gravity \"%s\": must be left or right", str)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MARK_GRAVITY", NULL); return TCL_ERROR; } TkTextMarkSegToIndex(textPtr, markPtr, &index); @@ -843,28 +850,12 @@ MarkFindNext( for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) { if (segPtr->typePtr == &tkTextRightMarkType || segPtr->typePtr == &tkTextLeftMarkType) { - if (segPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - } else if (segPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - } else if (segPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - continue; - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - segPtr->body.mark.hPtr), TCL_STATIC); + Tcl_Obj *markName = GetMarkName(textPtr, segPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } - return TCL_OK; } } index.linePtr = TkBTreeNextLine(textPtr, index.linePtr); @@ -962,28 +953,11 @@ MarkFindPrev( } } if (prevPtr != NULL) { - if (prevPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - return TCL_OK; - } else if (prevPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - return TCL_OK; - } else if (prevPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - prevPtr->body.mark.hPtr), TCL_STATIC); - return TCL_OK; + Tcl_Obj *markName = GetMarkName(textPtr, prevPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } } index.linePtr = TkBTreePreviousLine(textPtr, index.linePtr); @@ -995,6 +969,46 @@ MarkFindPrev( } /* + * ------------------------------------------------------------------------ + * + * GetMarkName -- + * Returns the name of the mark that is the given text segment, or NULL + * if it is unnamed (i.e., a widget-specific mark that isn't "current" or + * "insert"). + * + * ------------------------------------------------------------------------ + */ + +static Tcl_Obj * +GetMarkName( + TkText *textPtr, + TkTextSegment *segPtr) +{ + const char *markName; + + if (segPtr == textPtr->currentMarkPtr) { + markName = "current"; + } else if (segPtr == textPtr->insertMarkPtr) { + markName = "insert"; + } else if (segPtr->body.mark.hPtr == NULL) { + /* + * Ignore widget-specific marks for the other widgets. This is either + * an insert or a current mark (markPtr->body.mark.hPtr actually + * receives NULL for these marks in TkTextSetMark). The insert and + * current marks for textPtr having already been tested above, the + * current segment is an insert or current mark from a peer of + * textPtr, which we don't want to return. + */ + + return NULL; + } else { + markName = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, + segPtr->body.mark.hPtr); + } + return Tcl_NewStringObj(markName, -1); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 9afda0a..b3160b8 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -276,10 +276,10 @@ TkTextTagCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable, (ClientData) tagPtr->name, Tcl_GetString(objv[4])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual ", - "events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL); return TCL_ERROR; } } else if (objc == 5) { @@ -302,7 +302,7 @@ TkTextTagCmd( } Tcl_ResetResult(interp); } else { - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } } else { Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable, @@ -879,12 +879,12 @@ TkTextTagCmd( 0, &last); TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); if (TkBTreeCharTagged(&first, tagPtr)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &first)); count++; } while (TkBTreeNextTag(&tSearch)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &tSearch.curIndex)); count++; } @@ -895,7 +895,7 @@ TkTextTagCmd( * closed. In this case we add the end of the range. */ - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &last)); } Tcl_SetObjResult(interp, listObj); @@ -1050,7 +1050,7 @@ FindTag( const char *str; str = Tcl_GetStringFromObj(tagName, &len); - if (len == 3 && !strcmp(str,"sel")) { + if (len == 3 && !strcmp(str, "sel")) { return textPtr->selTagPtr; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable, @@ -1059,8 +1059,10 @@ FindTag( return Tcl_GetHashValue(hPtr); } if (interp != NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(tagName), - "\" isn't defined in text widget", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tag \"%s\" isn't defined in text widget", + Tcl_GetString(tagName))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_TAG", NULL); } return NULL; } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index 58d3198..d9dcecf 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -173,8 +173,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } @@ -210,8 +212,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } if (objc <= 5) { @@ -436,9 +440,12 @@ EmbWinConfigure( } if (Tk_TopWinHierarchy(ancestor)) { badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " in ", - Tk_PathName(textPtr->tkwin), NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s in %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); ewPtr->body.ew.tkwin = NULL; if (client != NULL) { client->tkwin = NULL; @@ -846,7 +853,8 @@ EmbWinLayoutProc( Tk_Window ancestor; Tcl_HashEntry *hPtr; const char *before, *string; - Tcl_DString name, buf, *dsPtr = NULL; + Tcl_DString buf, *dsPtr = NULL; + Tcl_Obj *nameObj; before = ewPtr->body.ew.create; @@ -905,36 +913,40 @@ EmbWinLayoutProc( code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create); } if (code != TCL_OK) { - createError: Tcl_BackgroundException(textPtr->interp, code); goto gotWindow; } - Tcl_DStringInit(&name); - Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1); + nameObj = Tcl_GetObjResult(textPtr->interp); + Tcl_IncrRefCount(nameObj); Tcl_ResetResult(textPtr->interp); ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp, - Tcl_DStringValue(&name), textPtr->tkwin); - Tcl_DStringFree(&name); + Tcl_GetString(nameObj), textPtr->tkwin); + Tcl_DecrRefCount(nameObj); if (ewPtr->body.ew.tkwin == NULL) { - goto createError; + Tcl_BackgroundError(textPtr->interp); + goto gotWindow; } + for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { - badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " relative to ", - Tk_PathName(textPtr->tkwin), NULL); - Tcl_BackgroundError(textPtr->interp); - ewPtr->body.ew.tkwin = NULL; - goto gotWindow; + goto badMaster; } } if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin) || (textPtr->tkwin == ewPtr->body.ew.tkwin)) { - goto badMaster; + badMaster: + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s relative to %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", "HIERARCHY", + NULL); + Tcl_BackgroundError(textPtr->interp); + ewPtr->body.ew.tkwin = NULL; + goto gotWindow; } if (client == NULL) { diff --git a/generic/tkUtil.c b/generic/tkUtil.c index b0ea2ea..6095054 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -84,15 +84,16 @@ TkStateParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", - " value \"", value, "\": must be normal", NULL); - if (flags&1) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value \"%s\": must be normal", + ((flags & 4) ? "-default" : "state"), value)); + if (flags & 1) { Tcl_AppendResult(interp, ", active", NULL); } - if (flags&2) { + if (flags & 2) { Tcl_AppendResult(interp, ", hidden", NULL); } - if (flags&3) { + if (flags & 3) { Tcl_AppendResult(interp, ",", NULL); } Tcl_AppendResult(interp, " or disabled", NULL); @@ -196,8 +197,9 @@ TkOrientParseProc( *orientPtr = 1; return TCL_OK; } - Tcl_AppendResult(interp, "bad orientation \"", value, - "\": must be vertical or horizontal", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad orientation \"%s\": must be vertical or horizontal", + value)); Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL); *orientPtr = 0; return TCL_ERROR; @@ -378,8 +380,8 @@ TkOffsetParseProc( return TCL_OK; badTSOffset: - Tcl_AppendResult(interp, "bad offset \"", value, - "\": expected \"x,y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad offset \"%s\": expected \"x,y\"", value)); if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { Tcl_AppendResult(interp, ", \"#x,y\"", NULL); } @@ -484,7 +486,8 @@ TkPixelParseProc( result = TkGetDoublePixels(interp, tkwin, value, doublePtr); if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { - Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", value)); Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); return TCL_ERROR; } @@ -648,8 +651,9 @@ Tk_GetScrollInfo( if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " moveto fraction\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "moveto fraction")); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } @@ -660,8 +664,9 @@ Tk_GetScrollInfo( } else if ((c == 's') && (strncmp(argv[2], "scroll", length) == 0)) { if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " scroll number units|pages\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "scroll number units|pages")); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } @@ -676,13 +681,13 @@ Tk_GetScrollInfo( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", argv[4], - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", argv[4])); Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", argv[2], - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", argv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2], NULL); return TK_SCROLL_ERROR; @@ -753,13 +758,13 @@ Tk_GetScrollInfoObj( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", arg, - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", arg)); Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", arg, - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", arg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL); return TK_SCROLL_ERROR; } @@ -925,8 +930,9 @@ TkFindStateNum( if (interp != NULL) { mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, - "\": must be ", mPtr->strKey, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + option, strKey, mPtr->strKey)); Tcl_SetErrorCode(interp, "TK", "VALUE", option, NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, @@ -982,8 +988,9 @@ TkFindStateNumObj( if (interp != NULL) { mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), - " value \"", key, "\": must be ", mPtr->strKey, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + Tcl_GetString(optionPtr), key, mPtr->strKey)); Tcl_SetErrorCode(interp, "TK", "VALUE", Tcl_GetString(optionPtr), NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { @@ -1021,24 +1028,15 @@ TkBackgroundEvalObjv( Tcl_Obj *const *objv, int flags) { - Tcl_DString errorInfo, errorCode; - Tcl_SavedResult state; + Tcl_InterpState state; int n, r = TCL_OK; - Tcl_DStringInit(&errorInfo); - Tcl_DStringInit(&errorCode); - - Tcl_Preserve(interp); - /* - * Record the state of the interpreter + * Record the state of the interpreter. */ - Tcl_SaveResult(interp, &state); - Tcl_DStringAppend(&errorInfo, - Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); - Tcl_DStringAppend(&errorCode, - Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); + Tcl_Preserve(interp); + state = Tcl_SaveInterpState(interp, TCL_OK); /* * Evaluate the command and handle any error. @@ -1056,24 +1054,12 @@ TkBackgroundEvalObjv( Tcl_BackgroundException(interp, r); } - Tcl_Release(interp); - /* - * Restore the state of the interpreter + * Restore the state of the interpreter. */ - Tcl_SetVar(interp, "errorInfo", - Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "errorCode", - Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); - Tcl_RestoreResult(interp, &state); - - /* - * Clean up references. - */ - - Tcl_DStringFree(&errorInfo); - Tcl_DStringFree(&errorCode); + (void) Tcl_RestoreInterpState(interp, state); + Tcl_Release(interp); return r; } diff --git a/generic/tkVisual.c b/generic/tkVisual.c index b19e78c..5f03f39 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -20,7 +20,7 @@ */ typedef struct VisualDictionary { - const char *name; /* Textual name of class. */ + const char *name; /* Textual name of class. */ int minLength; /* Minimum # characters that must be specified * for an unambiguous match. */ int class; /* X symbol for class. */ @@ -173,9 +173,8 @@ Tk_GetVisual( */ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad X identifier for visual: \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad X identifier for visual: \"%s\"", string)); Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL); return NULL; } @@ -203,8 +202,9 @@ Tk_GetVisual( } } if (template.class == -1) { - Tcl_AppendResult(interp, "unknown or ambiguous visual name \"", - string, "\": class must be ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown or ambiguous visual name \"%s\": class must be ", + string)); Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUAL", NULL); for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { Tcl_AppendResult(interp, dictPtr->name, ", ", NULL); @@ -217,10 +217,8 @@ Tk_GetVisual( } if (*p == 0) { template.depth = 10000; - } else { - if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { - return NULL; - } + } else if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { + return NULL; } if (c == 'b') { mask = 0; @@ -239,8 +237,8 @@ Tk_GetVisual( visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template, &numVisuals); if (visInfoList == NULL) { - Tcl_SetResult(interp, "couldn't find an appropriate visual", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find an appropriate visual", -1)); Tcl_SetErrorCode(interp, "TK", "VISUAL", "INAPPROPRIATE", NULL); return NULL; } @@ -406,14 +404,14 @@ Tk_GetColormap( return None; } if (Tk_Screen(other) != Tk_Screen(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": not on same screen", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: not on same screen", string)); Tcl_SetErrorCode(interp, "TK", "COLORMAP", "SCREEN", NULL); return None; } if (Tk_Visual(other) != Tk_Visual(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": incompatible visuals", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: incompatible visuals", string)); Tcl_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", NULL); return None; } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 27fba69..8b39da1 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -471,9 +471,8 @@ GetScreen( screenName = TkGetDefaultScreenName(interp, screenName); if (screenName == NULL) { - Tcl_SetResult(interp, - "no display name and no $DISPLAY environment variable", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no display name and no $DISPLAY environment variable", -1)); Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL); return NULL; } @@ -502,10 +501,9 @@ GetScreen( dispPtr = TkpOpenDisplay(screenName); if (dispPtr == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't connect to display \"", - screenName, "\"", NULL); - Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECTION", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't connect to display \"%s\"", screenName)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL); return NULL; } dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */ @@ -784,9 +782,9 @@ NameWindow( */ if (isupper(UCHAR(name[0]))) { - Tcl_AppendResult(interp, - "window name starts with an upper-case letter: \"", - name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name starts with an upper-case letter: \"%s\"", + name)); Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL); return TCL_ERROR; } @@ -824,8 +822,8 @@ NameWindow( ckfree(pathName); } if (!isNew) { - Tcl_AppendResult(interp, "window name \"", name, - "\" already exists in parent", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name \"%s\" already exists in parent", name)); Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL); return TCL_ERROR; } @@ -1037,14 +1035,14 @@ Tk_CreateWindow( if (parentPtr) { if (parentPtr->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't create window: its parent has -container = yes", - NULL); + -1)); Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { @@ -1101,14 +1099,14 @@ Tk_CreateAnonymousWindow( if (parentPtr) { if (parentPtr->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't create window: its parent has -container = yes", - NULL); + -1)); Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { @@ -1185,8 +1183,8 @@ Tk_CreateWindowFromPath( p = strrchr(pathName, '.'); if (p == NULL) { - Tcl_AppendResult(interp, "bad window path name \"", pathName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOWPATH", NULL); return NULL; } @@ -1216,14 +1214,14 @@ Tk_CreateWindowFromPath( return NULL; } if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } if (((TkWindow *) parent)->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, - "can't create window: its parent has -container = yes", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", -1)); Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } @@ -2341,7 +2339,7 @@ Tk_NameToWindow( */ if (interp != NULL) { - Tcl_SetResult(interp, "NULL main window", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1)); Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); } return NULL; @@ -2351,8 +2349,8 @@ Tk_NameToWindow( pathName); if (hPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad window path name \"", - pathName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOWNAME", NULL); } return NULL; @@ -2666,7 +2664,8 @@ Tk_MainWindow( return (Tk_Window) mainPtr->winPtr; } } - Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this isn't a Tk application", -1)); Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return NULL; } @@ -3102,8 +3101,9 @@ Initialize( while (1) { master = Tcl_GetMaster(master); if (master == NULL) { - Tcl_AppendResult(interp, "NULL master", NULL); - Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no controlling master interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL); code = TCL_ERROR; goto done; } @@ -3119,7 +3119,8 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { - Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error in Tcl_GetInterpPath", -1)); Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } @@ -3145,8 +3146,8 @@ Initialize( */ Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "not allowed to start Tk by master's safe::TkInit", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not allowed to start Tk by master's safe::TkInit", -1)); Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index 6eccf51..ed779dd 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -1452,7 +1452,7 @@ EntryGetCommand( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetResult(interp, entryPtr->entry.string, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->entry.string, -1)); return TCL_OK; } diff --git a/generic/ttk/ttkImage.c b/generic/ttk/ttkImage.c index 0de5fc0..3363e4c 100644 --- a/generic/ttk/ttkImage.c +++ b/generic/ttk/ttkImage.c @@ -59,9 +59,9 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr) if ((objc % 2) != 1) { if (interp) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "image specification must contain an odd number of elements", - TCL_STATIC); + -1)); } goto error; } diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c index a71ae21..ab2b7ed 100644 --- a/generic/ttk/ttkState.c +++ b/generic/ttk/ttkState.c @@ -241,9 +241,8 @@ Ttk_StateMap Ttk_GetStateMapFromObj( if (nSpecs % 2 != 0) { if (interp) - Tcl_SetResult(interp, - "State map must have an even number of elements", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "State map must have an even number of elements", -1)); return 0; } diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c index d5e0484..016653d 100644 --- a/generic/ttk/ttkWidget.c +++ b/generic/ttk/ttkWidget.c @@ -440,7 +440,8 @@ int TtkWidgetConstructorObjCmd( error: if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); } else { Tk_DestroyWindow(tkwin); } @@ -634,8 +635,8 @@ int TtkWidgetConfigureCommand( return status; if (mask & READONLY_OPTION) { - Tcl_SetResult(interp, - "Attempt to change read-only option", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to change read-only option", -1)); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -649,7 +650,8 @@ int TtkWidgetConfigureCommand( status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask); if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); status = TCL_ERROR; } if (status != TCL_OK) { |