summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-07-23 13:59:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-07-23 13:59:40 (GMT)
commit571fd220b0be2da05b1a6e8bb32e0b9a447ed288 (patch)
tree46a3064598e4a36c7ca561f9c08f5d22de4b2b9e
parented7fb54396eee6e5122bfe611b2a14cf422970fa (diff)
downloadtk-571fd220b0be2da05b1a6e8bb32e0b9a447ed288.zip
tk-571fd220b0be2da05b1a6e8bb32e0b9a447ed288.tar.gz
tk-571fd220b0be2da05b1a6e8bb32e0b9a447ed288.tar.bz2
Much more cleaning up of result handling.
-rw-r--r--carbon/tkMacOSXWm.c108
-rw-r--r--generic/tkBind.c41
-rw-r--r--generic/tkBitmap.c4
-rw-r--r--generic/tkCanvBmap.c6
-rw-r--r--generic/tkCanvPs.c8
-rw-r--r--generic/tkCanvText.c6
-rw-r--r--generic/tkCanvas.c45
-rw-r--r--generic/tkClipboard.c23
-rw-r--r--generic/tkCmds.c117
-rw-r--r--generic/tkColor.c8
-rw-r--r--generic/tkConfig.c12
-rw-r--r--generic/tkConsole.c8
-rw-r--r--generic/tkCursor.c8
-rw-r--r--generic/tkEntry.c90
-rw-r--r--generic/tkFileFilter.c16
-rw-r--r--generic/tkFocus.c17
-rw-r--r--generic/tkFont.c36
-rw-r--r--generic/tkFrame.c54
-rw-r--r--generic/tkGeometry.c17
-rw-r--r--generic/tkGet.c44
-rw-r--r--generic/tkGrab.c47
-rw-r--r--generic/tkGrid.c202
-rw-r--r--generic/tkImage.c34
-rw-r--r--generic/tkImgBmap.c32
-rw-r--r--generic/tkImgGIF.c69
-rw-r--r--generic/tkImgPNG.c214
-rw-r--r--generic/tkImgPPM.c53
-rw-r--r--generic/tkImgPhoto.c201
-rw-r--r--generic/tkListbox.c31
-rw-r--r--generic/tkMenu.c25
-rw-r--r--generic/tkMenubutton.c4
-rw-r--r--generic/tkMessage.c6
-rw-r--r--generic/tkObj.c28
-rw-r--r--generic/tkOldConfig.c24
-rw-r--r--generic/tkOption.c30
-rw-r--r--generic/tkPack.c100
-rw-r--r--generic/tkPanedWindow.c86
-rw-r--r--generic/tkPlace.c17
-rw-r--r--generic/tkRectOval.c34
-rw-r--r--generic/tkScale.c24
-rw-r--r--generic/tkScrollbar.c120
-rw-r--r--generic/tkSelect.c87
-rw-r--r--generic/tkStubLib.c5
-rw-r--r--generic/tkStyle.c4
-rw-r--r--generic/tkText.c136
-rw-r--r--generic/tkTextDisp.c11
-rw-r--r--generic/tkTextImage.c36
-rw-r--r--generic/tkTextIndex.c20
-rw-r--r--generic/tkTextMark.c112
-rw-r--r--generic/tkTextTag.c24
-rw-r--r--generic/tkTextWind.c56
-rw-r--r--generic/tkUtil.c94
-rw-r--r--generic/tkVisual.c30
-rw-r--r--generic/tkWindow.c71
-rw-r--r--generic/ttk/ttkEntry.c2
-rw-r--r--generic/ttk/ttkImage.c4
-rw-r--r--generic/ttk/ttkState.c5
-rw-r--r--generic/ttk/ttkWidget.c10
-rw-r--r--macosx/tkMacOSXWm.c26
-rw-r--r--tests/embed.test2
-rw-r--r--tests/font.test2
-rw-r--r--tests/frame.test2
-rw-r--r--tests/grid.test38
-rw-r--r--tests/text.test6
-rw-r--r--unix/tkUnixCursor.c49
-rw-r--r--unix/tkUnixSelect.c72
-rw-r--r--unix/tkUnixSend.c29
-rw-r--r--unix/tkUnixWm.c223
-rw-r--r--win/tkWinDialog.c146
-rw-r--r--win/tkWinWm.c34
70 files changed, 1864 insertions, 1521 deletions
diff --git a/carbon/tkMacOSXWm.c b/carbon/tkMacOSXWm.c
index 0ec8d74..5d60aa5 100644
--- a/carbon/tkMacOSXWm.c
+++ b/carbon/tkMacOSXWm.c
@@ -591,7 +591,7 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(wmTracing));
return TCL_OK;
}
return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing);
@@ -723,12 +723,13 @@ WmAspectCmd(
}
if (objc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- char buf[TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *aspect[4];
- sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
- wmPtr->minAspect.y, wmPtr->maxAspect.x,
- wmPtr->maxAspect.y);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ aspect[0] = wmPtr->minAspect.x;
+ aspect[1] = wmPtr->minAspect.y;
+ aspect[2] = wmPtr->maxAspect.x;
+ aspect[3] = wmPtr->maxAspect.y;
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, aspect));
}
return TCL_OK;
}
@@ -743,7 +744,8 @@ WmAspectCmd(
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "aspect number can't be <= 0", -1));
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -1115,7 +1117,8 @@ WmClientCmd(
}
if (objc == 3) {
if (wmPtr->clientMachine != NULL) {
- Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(wmPtr->clientMachine, -1));
}
return TCL_OK;
}
@@ -1258,8 +1261,8 @@ WmCommandCmd(
}
if (objc == 3) {
if (wmPtr->cmdArgv != NULL) {
- argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- Tcl_SetResult(interp, argv3, TCL_VOLATILE);
+ argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(argv3, -1));
ckfree(argv3);
}
return TCL_OK;
@@ -1366,8 +1369,8 @@ WmFocusmodelCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ wmPtr->hints.input ? "passive" : "active", -1));
return TCL_OK;
}
@@ -1472,7 +1475,6 @@ WmFrameCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
Window window;
- char buf[TCL_INTEGER_SPACE];
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window");
@@ -1482,8 +1484,7 @@ WmFrameCmd(
if (window == None) {
window = Tk_WindowId((Tk_Window) winPtr);
}
- sprintf(buf, "0x%x", (unsigned) window);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) window));
return TCL_OK;
}
@@ -1522,8 +1523,6 @@ WmGeometryCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[16 + TCL_INTEGER_SPACE * 4];
-
xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
if (wmPtr->gridWin != NULL) {
@@ -1535,9 +1534,8 @@ WmGeometryCmd(
width = winPtr->changes.width;
height = winPtr->changes.height;
}
- sprintf(buf, "%dx%d%c%d%c%d",
- width, height, xSign, wmPtr->x, ySign, wmPtr->y);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d",
+ width, height, xSign, wmPtr->x, ySign, wmPtr->y));
return TCL_OK;
}
argv3 = Tcl_GetString(objv[3]);
@@ -1585,12 +1583,13 @@ WmGridCmd(
}
if (objc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- char buf[TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *grid[4];
- sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
- wmPtr->reqGridHeight, wmPtr->widthInc,
- wmPtr->heightInc);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ grid[0] = Tcl_NewIntObj(wmPtr->reqGridWidth);
+ grid[1] = Tcl_NewIntObj(wmPtr->reqGridHeight);
+ grid[2] = Tcl_NewIntObj(wmPtr->widthInc);
+ grid[3] = Tcl_NewIntObj(wmPtr->heightInc);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, grid));
}
return TCL_OK;
}
@@ -1676,7 +1675,7 @@ WmGroupCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & WindowGroupHint) {
- Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1));
}
return TCL_OK;
}
@@ -1739,8 +1738,9 @@ WmIconbitmapCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconPixmapHint) {
- Tcl_SetResult(interp, (char*)Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_pixmap), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tk_NameOfBitmap(winPtr->display,
+ wmPtr->hints.icon_pixmap), -1));
}
return TCL_OK;
}
@@ -1860,8 +1860,9 @@ WmIconmaskCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_mask), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tk_NameOfBitmap(winPtr->display,
+ wmPtr->hints.icon_mask), -1));
}
return TCL_OK;
}
@@ -2034,11 +2035,11 @@ WmIconpositionCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *pos[2];
- sprintf(buf, "%d %d", wmPtr->hints.icon_x,
- wmPtr->hints.icon_y);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ pos[0] = Tcl_NewIntObj(wmPtr->hints.icon_x);
+ pos[1] = Tcl_NewIntObj(wmPtr->hints.icon_y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, pos));
}
return TCL_OK;
}
@@ -2091,7 +2092,7 @@ WmIconwindowCmd(
}
if (objc == 3) {
if (wmPtr->icon != NULL) {
- Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon));
}
return TCL_OK;
}
@@ -2240,15 +2241,16 @@ WmMaxsizeCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *size[2];
GetMaxSize(winPtr, &width, &height);
- sprintf(buf, "%d %d", width, height);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ size[0] = Tcl_NewIntObj(width);
+ size[1] = Tcl_NewIntObj(height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(2, size));
return TCL_OK;
}
if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
- || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
+ || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) {
return TCL_ERROR;
}
wmPtr->maxWidth = width;
@@ -2291,11 +2293,12 @@ WmMinsizeCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *size[2];
GetMinSize(winPtr, &width, &height);
- sprintf(buf, "%d %d", width, height);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ size[0] = Tcl_NewIntObj(width);
+ size[1] = Tcl_NewIntObj(height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(2, size));
return TCL_OK;
}
if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK)
@@ -2475,7 +2478,8 @@ WmProtocolCmd(
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(protPtr->command, -1));
return TCL_OK;
}
}
@@ -2545,16 +2549,15 @@ WmResizableCmd(
return TCL_ERROR;
}
if (objc == 3) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *resize[2];
- sprintf(buf, "%d %d",
- (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
- (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ resize[0] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE));
+ resize[1] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, resize));
return TCL_OK;
}
if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK)
- || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) {
+ || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) {
return TCL_ERROR;
}
if (width) {
@@ -2908,8 +2911,8 @@ WmTitleCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp, (char *)((wmPtr->titleUid != NULL) ?
- wmPtr->titleUid : winPtr->nameUid), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ wmPtr->titleUid ? wmPtr->titleUid : winPtr->nameUid, -1));
return TCL_OK;
}
argv3 = Tcl_GetStringFromObj(objv[3], &length);
@@ -2957,7 +2960,8 @@ WmTransientCmd(
}
if (objc == 3) {
if (wmPtr->master != None) {
- Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(wmPtr->masterWindowName, -1));
}
return TCL_OK;
}
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(&copy);
return TCL_ERROR;
}
@@ -1001,8 +1003,8 @@ GetIndex(
error:
Tcl_DStringFree(&copy);
- 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) {
diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c
index 44b88f2..1131ccc 100644
--- a/macosx/tkMacOSXWm.c
+++ b/macosx/tkMacOSXWm.c
@@ -1030,7 +1030,8 @@ WmAspectCmd(
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "aspect number can't be <= 0", -1));
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -1340,7 +1341,8 @@ WmClientCmd(
}
if (objc == 3) {
if (wmPtr->clientMachine != NULL) {
- Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(wmPtr->clientMachine, -1));
}
return TCL_OK;
}
@@ -1951,9 +1953,9 @@ WmIconbitmapCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconPixmapHint) {
- Tcl_SetResult(interp, (char *)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
Tk_NameOfBitmap(winPtr->display,wmPtr->hints.icon_pixmap),
- TCL_STATIC);
+ -1));
}
return TCL_OK;
}
@@ -2073,9 +2075,9 @@ WmIconmaskCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- Tcl_SetResult(interp, (char *)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
- TCL_STATIC);
+ -1));
}
return TCL_OK;
}
@@ -2305,7 +2307,7 @@ WmIconwindowCmd(
}
if (objc == 3) {
if (wmPtr->icon != NULL) {
- Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon));
}
return TCL_OK;
}
@@ -2686,7 +2688,8 @@ WmProtocolCmd(
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(protPtr->command, -1));
return TCL_OK;
}
}
@@ -3118,8 +3121,8 @@ WmTitleCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp, (char *)((wmPtr->titleUid != NULL) ?
- wmPtr->titleUid : winPtr->nameUid), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ wmPtr->titleUid ? wmPtr->titleUid : winPtr->nameUid, -1));
return TCL_OK;
}
argv3 = Tcl_GetStringFromObj(objv[3], &length);
@@ -3167,7 +3170,8 @@ WmTransientCmd(
}
if (objc == 3) {
if (wmPtr->master != None) {
- Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(wmPtr->masterWindowName, -1));
}
return TCL_OK;
}
diff --git a/tests/embed.test b/tests/embed.test
index 8a29862..1fe73ef 100644
--- a/tests/embed.test
+++ b/tests/embed.test
@@ -33,7 +33,7 @@ test embed-1.3 {CreateFrame procedure, both -use and -container is invalid} -set
toplevel .t -use [winfo id .container] -container 1
} -cleanup {
deleteWindows
-} -returnCodes error -result {A window cannot have both the -use and the -container option set.}
+} -returnCodes error -result {windows cannot have both the -use and the -container option set}
# testing window embedding for win platforms
test embed-1.4.win {TkpUseWindow procedure, -container must be set} -constraints {
diff --git a/tests/font.test b/tests/font.test
index 3a2568c..dff9fc9 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -76,7 +76,7 @@ test font-2.1 {TkFontPkgFree} -setup {
lappend x [foo eval {catch {font families} msg; set msg}]
} -cleanup {
interp delete foo
-} -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}}
+} -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}}
test font-3.1 {font command: general} -body {
diff --git a/tests/frame.test b/tests/frame.test
index 35b9605..c7b0ed8 100644
--- a/tests/frame.test
+++ b/tests/frame.test
@@ -468,7 +468,7 @@ test frame-2.18 {toplevel configuration options} -setup {
toplevel .x -container 1 -use [winfo id .t]
} -cleanup {
deleteWindows
-} -returnCodes error -result {A window cannot have both the -use and the -container option set.}
+} -returnCodes error -result {windows cannot have both the -use and the -container option set}
test frame-2.19 {toplevel configuration options} -setup {
deleteWindows
set opts {}
diff --git a/tests/grid.test b/tests/grid.test
index b27318e..0f0feeb 100644
--- a/tests/grid.test
+++ b/tests/grid.test
@@ -59,7 +59,7 @@ test grid-1.4 {basic argument checking} -body {
grid configure .b - foo
} -cleanup {
grid_reset 1.4
-} -returnCodes error -result {unexpected parameter, "foo", in configure list. Should be window name or option}
+} -returnCodes error -result {unexpected parameter "foo" in configure list: should be window name or option}
test grid-1.5 {basic argument checking} -body {
grid .
} -returnCodes error -result {can't manage ".": it's a top-level window}
@@ -546,7 +546,7 @@ test grid-9.5 {slaves} -body {
} -returnCodes error -result {expected integer but got "x"}
test grid-9.6 {slaves} -body {
grid slaves . -row -3
-} -returnCodes error -result {-row is an invalid value: should NOT be < 0}
+} -returnCodes error -result {-3 is an invalid value: should NOT be < 0}
test grid-9.7 {slaves} -body {
grid slaves . -foo 3
} -returnCodes error -result {bad option "-foo": must be -column or -row}
@@ -865,12 +865,12 @@ test grid-10.35 {column/row configure} -body {
lappend res [catch {grid .f -row 9998 -rowspan 2} msg] $msg ; update
set res
} -cleanup {destroy .f} -result [lrange {
- 1 {Column out of bounds}
- 1 {Row out of bounds}
- 1 {Column out of bounds}
- 1 {Row out of bounds}
- 1 {Column out of bounds}
- 1 {Row out of bounds}
+ 1 {column out of bounds}
+ 1 {row out of bounds}
+ 1 {column out of bounds}
+ 1 {row out of bounds}
+ 1 {column out of bounds}
+ 1 {row out of bounds}
} 0 end]
grid_reset 10.38
@@ -889,10 +889,10 @@ test grid-10.36 {column/row configure} -body {
update
set res
} -cleanup {destroy .f .g} -result [lrange {
- 1 {Row out of bounds}
- 1 {Row out of bounds}
- 1 {Column out of bounds}
- 1 {Column out of bounds}
+ 1 {row out of bounds}
+ 1 {row out of bounds}
+ 1 {column out of bounds}
+ 1 {column out of bounds}
} 0 end]
grid_reset 10.39
@@ -909,7 +909,7 @@ test grid-11.2 {default widget placement} -body {
grid .b ^
} -cleanup {
grid_reset 11.2
-} -returnCodes error -result {can't find slave to extend with "^".}
+} -returnCodes error -result {can't find slave to extend with "^"}
test grid-11.3 {default widget placement} -body {
button .b
@@ -930,7 +930,7 @@ test grid-11.5 {default widget placement} -body {
grid .b - x -
} -cleanup {
grid_reset 11.5
-} -returnCodes error -result {Must specify window before shortcut '-'.}
+} -returnCodes error -result {must specify window before shortcut '-'}
test grid-11.6 {default widget placement} -body {
foreach i {1 2 3 4 5 6} {
@@ -955,7 +955,7 @@ test grid-11.7 {default widget placement} -body {
grid .f x -
} -cleanup {
grid_reset 11.7
-} -returnCodes error -result {Must specify window before shortcut '-'.}
+} -returnCodes error -result {must specify window before shortcut '-'}
test grid-11.8 {default widget placement} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
@@ -963,7 +963,7 @@ test grid-11.8 {default widget placement} -body {
grid .f ^ -
} -cleanup {
grid_reset 11.8
-} -returnCodes error -result {Must specify window before shortcut '-'.}
+} -returnCodes error -result {must specify window before shortcut '-'}
test grid-11.9 {default widget placement} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
@@ -971,7 +971,7 @@ test grid-11.9 {default widget placement} -body {
grid .f x ^
} -cleanup {
grid_reset 11.9
-} -returnCodes error -result {can't find slave to extend with "^".}
+} -returnCodes error -result {can't find slave to extend with "^"}
test grid-11.10 {default widget placement} -body {
foreach i {1 2 3} {
@@ -1210,7 +1210,7 @@ test grid-13.1 {-in} -body {
grid .f -in .f
} -cleanup {
grid_reset 13.1
-} -returnCodes error -result {Window can't be managed in itself}
+} -returnCodes error -result {window can't be managed in itself}
test grid-13.2 {-in} -body {
frame .f -bg red
@@ -1219,7 +1219,7 @@ test grid-13.2 {-in} -body {
[winfo manager .f]
} -cleanup {
grid_reset 13.1.1
-} -result {{} 1 {Window can't be managed in itself} {}}
+} -result {{} 1 {window can't be managed in itself} {}}
test grid-13.3 {-in} -body {
frame .f -bg red
diff --git a/tests/text.test b/tests/text.test
index f8cb3d7..5089bb1 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -1397,7 +1397,7 @@ abcdefghijklm
.t replace 3.1 2.3 foo
} -cleanup {
destroy .t
-} -returnCodes {error} -result {Index "2.3" before "3.1" in the text}
+} -returnCodes {error} -result {index "2.3" before "3.1" in the text}
test text-8.20 {TextWidgetCmd procedure, "replace" option} -setup {
text .t
} -body {
@@ -3705,7 +3705,7 @@ test text-22.1 {TextSearchCmd procedure, argument parsing} -body {
.t search -
} -cleanup {
destroy .t
-} -returnCodes {error} -result {bad switch "-": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}
+} -returnCodes error -result {ambiguous switch "-": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}
test text-22.2 {TextSearchCmd procedure, -backwards option} -body {
text .t
.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
@@ -3769,7 +3769,7 @@ test text-22.10 {TextSearchCmd procedure, -n ambiguous option} -body {
.t search -n BaR 1.1
} -cleanup {
destroy .t
-} -returnCodes {error} -result {bad switch "-n": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}
+} -returnCodes error -result {ambiguous switch "-n": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}
test text-22.11 {TextSearchCmd procedure, -nocase option} -body {
text .t
.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
diff --git a/unix/tkUnixCursor.c b/unix/tkUnixCursor.c
index bbf5206..145530a 100644
--- a/unix/tkUnixCursor.c
+++ b/unix/tkUnixCursor.c
@@ -275,8 +275,9 @@ TkGetCursorByName(
bg.red = bg.green = bg.blue = 65535;
} else {
if (TkParseColor(display, Tk_Colormap(tkwin), argv[1], &fg) == 0) {
- Tcl_AppendResult(interp, "invalid color name \"", argv[1],
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", argv[1]));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "FGCOL", NULL);
goto cleanup;
}
if (argc == 2) {
@@ -284,8 +285,9 @@ TkGetCursorByName(
maskIndex = namePtr->shape;
} else if (TkParseColor(display, Tk_Colormap(tkwin), argv[2],
&bg) == 0) {
- Tcl_AppendResult(interp, "invalid color name \"", argv[2],
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", argv[2]));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "BGCOL", NULL);
goto cleanup;
}
}
@@ -293,7 +295,9 @@ TkGetCursorByName(
if (dispPtr->cursorFont == None) {
dispPtr->cursorFont = XLoadFont(display, CURSORFONT);
if (dispPtr->cursorFont == None) {
- Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't load cursor font", -1));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "FONT", NULL);
goto cleanup;
}
}
@@ -306,8 +310,10 @@ TkGetCursorByName(
*/
if (!inTkTable && Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "can't get cursor from a file in",
- " a safe interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't get cursor from a file in a safe interpreter",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "SAFE", NULL);
cursorPtr = NULL;
goto cleanup;
}
@@ -347,7 +353,8 @@ TkGetCursorByName(
if (argv) {
ckfree(argv);
}
- Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad cursor spec \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL);
return NULL;
}
@@ -444,6 +451,7 @@ CreateCursorFromTableOrFile(
Tcl_AppendResult(interp, "bad hot spot in bitmap file \"",
&argv[0][1], "\"", NULL);
}
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "HOTSPOT", NULL);
goto cleanup;
}
@@ -476,13 +484,15 @@ CreateCursorFromTableOrFile(
bgColor = argv[3];
}
if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) {
- Tcl_AppendResult(interp, "invalid color name \"",
- fgColor, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", fgColor));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "FGCOL", NULL);
goto cleanup;
}
if (TkParseColor(display, Tk_Colormap(tkwin), bgColor, &bg) == 0) {
- Tcl_AppendResult(interp, "invalid color name \"",
- bgColor, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid color name \"%s\"", bgColor));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "BGCOL", NULL);
goto cleanup;
}
}
@@ -511,8 +521,9 @@ CreateCursorFromTableOrFile(
data = TkGetBitmapData(NULL, tkCursorPtr->mask, NULL,
&maskWidth, &maskHeight, &dummy1, &dummy2);
if (data == NULL) {
- Tcl_AppendResult(interp, "error reading bitmap mask data for \"",
- argv[0], "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading bitmap mask data for \"%s\"", argv[0]));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "READ", -1);
goto cleanup;
}
@@ -524,15 +535,17 @@ CreateCursorFromTableOrFile(
if (TkReadBitmapFile(display, drawable, argv[1],
(unsigned int *) &maskWidth, (unsigned int *) &maskHeight,
&mask, &dummy1, &dummy2) != BitmapSuccess) {
- Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
- argv[1], "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cleanup reading bitmap file \"%s\"", argv[1]));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "READ", -1);
goto cleanup;
}
}
if ((maskWidth != width) || (maskHeight != height)) {
- Tcl_SetResult(interp, "source and mask bitmaps have different sizes",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "source and mask bitmaps have different sizes", -1));
+ Tcl_SetErrorCode(interp, "TK", "CURSOR", "SIZE_MATCH", -1);
goto cleanup;
}
diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c
index a67e75e..4bb462e 100644
--- a/unix/tkUnixSelect.c
+++ b/unix/tkUnixSelect.c
@@ -243,7 +243,7 @@ TkSelPropProc(
long buffer[TK_SEL_WORDS_AT_ONCE];
TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display);
Tk_ErrorHandler errorHandler;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
@@ -552,12 +552,12 @@ TkSelEventProc(
break;
}
if (eventPtr->xselection.property == None) {
- Tcl_SetResult(retrPtr->interp, NULL, TCL_STATIC);
- Tcl_AppendResult(retrPtr->interp,
+ Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
+ "%s selection doesn't exist or form \"%s\" not defined",
Tk_GetAtomName(tkwin, retrPtr->selection),
- " selection doesn't exist or form \"",
- Tk_GetAtomName(tkwin, retrPtr->target),
- "\" not defined", NULL);
+ Tk_GetAtomName(tkwin, retrPtr->target)));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION",
+ "NONE", NULL);
retrPtr->result = TCL_ERROR;
return;
}
@@ -574,8 +574,9 @@ TkSelEventProc(
return;
}
if (bytesAfter != 0) {
- Tcl_SetResult(retrPtr->interp, "selection property too large",
- TCL_STATIC);
+ Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj(
+ "selection property too large", -1));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE",NULL);
retrPtr->result = TCL_ERROR;
XFree(propInfo);
return;
@@ -588,6 +589,8 @@ TkSelEventProc(
Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
"bad format for string selection: wanted \"8\", got \"%d\"",
format));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
+ NULL);
retrPtr->result = TCL_ERROR;
return;
}
@@ -632,6 +635,8 @@ TkSelEventProc(
Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
"bad format for string selection: wanted \"8\", got \"%d\"",
format));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
+ NULL);
retrPtr->result = TCL_ERROR;
return;
}
@@ -671,6 +676,8 @@ TkSelEventProc(
Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
"bad format for selection: wanted \"32\" or "
"\"8\", got \"%d\"", format));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
+ NULL);
retrPtr->result = TCL_ERROR;
return;
}
@@ -728,7 +735,7 @@ static void
SelTimeoutProc(
ClientData clientData) /* Information about retrieval in progress. */
{
- register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+ register TkSelRetrievalInfo *retrPtr = clientData;
/*
* Make sure that the retrieval is still in progress. Then see how long
@@ -746,8 +753,9 @@ SelTimeoutProc(
* selection return.
*/
- Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
- TCL_STATIC);
+ Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj(
+ "selection owner didn't respond", -1));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "IGNORED", NULL);
retrPtr->result = TCL_ERROR;
} else {
retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
@@ -798,7 +806,7 @@ ConvertSelection(
Tk_ErrorHandler errorHandler;
TkSelectionInfo *infoPtr;
TkSelInProgress ip;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
@@ -867,7 +875,7 @@ ConvertSelection(
}
goto refuse;
}
- incr.numConversions /= 2; /* Two atoms per conversion. */
+ incr.numConversions /= 2; /* Two atoms per conversion. */
}
/*
@@ -960,8 +968,9 @@ ConvertSelection(
* allows us to pass our utf-8 information untouched.
*/
- XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type, 8,
- PropModeReplace, (unsigned char *) buffer, numItems);
+ XChangeProperty(reply.xsel.display, reply.xsel.requestor,
+ property, type, 8, PropModeReplace,
+ (unsigned char *) buffer, numItems);
} else if ((type == XA_STRING)
|| (type == winPtr->dispPtr->compoundTextAtom)) {
Tcl_DString ds;
@@ -979,8 +988,9 @@ ConvertSelection(
encoding = Tcl_GetEncoding(NULL, "iso2022");
}
Tcl_UtfToExternalDString(encoding, (char *) buffer, -1, &ds);
- XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type, 8,
- PropModeReplace, (unsigned char *) Tcl_DStringValue(&ds),
+ XChangeProperty(reply.xsel.display, reply.xsel.requestor,
+ property, type, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
if (encoding) {
Tcl_FreeEncoding(encoding);
@@ -993,9 +1003,9 @@ ConvertSelection(
goto refuse;
}
format = 32;
- XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type,
- format, PropModeReplace, (unsigned char *) propPtr,
- numItems);
+ XChangeProperty(reply.xsel.display, reply.xsel.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
ckfree(propPtr);
}
}
@@ -1007,7 +1017,8 @@ ConvertSelection(
*/
if (incr.numIncrs > 0) {
- XSelectInput(reply.xsel.display, reply.xsel.requestor, PropertyChangeMask);
+ XSelectInput(reply.xsel.display, reply.xsel.requestor,
+ PropertyChangeMask);
incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, &incr);
incr.idleTime = 0;
incr.reqWindow = reply.xsel.requestor;
@@ -1016,8 +1027,8 @@ ConvertSelection(
tsdPtr->pendingIncrs = &incr;
}
if (multiple) {
- XChangeProperty(reply.xsel.display, reply.xsel.requestor, reply.xsel.property,
- XA_ATOM, 32, PropModeReplace,
+ XChangeProperty(reply.xsel.display, reply.xsel.requestor,
+ reply.xsel.property, XA_ATOM, 32, PropModeReplace,
(unsigned char *) incr.multAtoms,
(int) incr.numConversions*2);
} else {
@@ -1045,7 +1056,7 @@ ConvertSelection(
}
Tcl_DeleteTimerHandler(incr.timeout);
errorHandler = Tk_CreateErrorHandler(winPtr->display,
- -1, -1,-1, (int (*)()) NULL, NULL);
+ -1, -1, -1, (int (*)()) NULL, NULL);
XSelectInput(reply.xsel.display, reply.xsel.requestor, 0L);
Tk_DeleteErrorHandler(errorHandler);
if (tsdPtr->pendingIncrs == &incr) {
@@ -1107,7 +1118,7 @@ SelRcvIncrProc(
ClientData clientData, /* Information about retrieval. */
register XEvent *eventPtr) /* X PropertyChange event. */
{
- register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+ register TkSelRetrievalInfo *retrPtr = clientData;
char *propInfo, **propInfoPtr = &propInfo;
Atom type;
int format, result;
@@ -1128,8 +1139,9 @@ SelRcvIncrProc(
return;
}
if (bytesAfter != 0) {
- Tcl_SetResult(retrPtr->interp, "selection property too large",
- TCL_STATIC);
+ Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj(
+ "selection property too large", -1));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE", NULL);
retrPtr->result = TCL_ERROR;
goto done;
}
@@ -1146,6 +1158,8 @@ SelRcvIncrProc(
Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
"bad format for string selection: wanted \"8\", got \"%d\"",
format));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
+ NULL);
retrPtr->result = TCL_ERROR;
goto done;
}
@@ -1250,6 +1264,8 @@ SelRcvIncrProc(
Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
"bad format for selection: wanted \"32\" or "
"\"8\", got \"%d\"", format));
+ Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
+ NULL);
retrPtr->result = TCL_ERROR;
goto done;
}
@@ -1350,7 +1366,7 @@ IncrTimeoutProc(
* retrieval for which we are selection
* owner. */
{
- register IncrInfo *incrPtr = (IncrInfo *) clientData;
+ register IncrInfo *incrPtr = clientData;
incrPtr->idleTime++;
if (incrPtr->idleTime >= 5) {
diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c
index be53ec6..3bd1c1b 100644
--- a/unix/tkUnixSend.c
+++ b/unix/tkUnixSend.c
@@ -984,15 +984,19 @@ Tk_SendCmd(
i++;
break;
} else {
- Tcl_AppendResult(interp, "bad option \"", argv[i],
- "\": must be -async, -displayof, or --", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -async, -displayof, or --",
+ argv[i]));
+ Tcl_SetErrorCode(interp, "TK", "SEND", "OPTION", NULL);
return TCL_ERROR;
}
}
if (argc < (i+2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?-option value ...? interpName arg ?arg ...?\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong # args: should be "
+ "\"%s ?-option value ...? interpName arg ?arg ...?\"",
+ argv[0]));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
destName = argv[i];
@@ -1067,7 +1071,9 @@ Tk_SendCmd(
commWindow = RegFindName(regPtr, destName);
RegClose(regPtr);
if (commWindow == None) {
- Tcl_AppendResult(interp, "no application named \"",destName,"\"",NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no application named \"%s\"", destName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "APPLICATION", NULL);
return TCL_ERROR;
}
@@ -1190,12 +1196,10 @@ Tk_SendCmd(
ckfree(pending.errorInfo);
}
if (pending.errorCode != NULL) {
- Tcl_Obj *errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1);
-
- Tcl_SetObjErrorCode(interp, errorObjPtr);
+ Tcl_SetObjErrorCode(interp, Tcl_NewStringObj(pending.errorCode, -1));
ckfree(pending.errorCode);
}
- Tcl_SetResult(interp, pending.result, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(pending.result, -1));
ckfree(pending.result);
return pending.code;
}
@@ -1989,7 +1993,7 @@ TkpTestsendCmd(
*p = '\n';
}
}
- Tcl_SetResult(interp, property, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(property, -1));
}
if (property != NULL) {
XFree(property);
@@ -2013,10 +2017,7 @@ TkpTestsendCmd(
Tcl_DStringFree(&tmp);
}
} else if (strcmp(argv[1], "serial") == 0) {
- char buf[TCL_INTEGER_SPACE];
-
- sprintf(buf, "%d", localData.sendSerial+1);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(localData.sendSerial+1));
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be bogus, prop, or serial", NULL);
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index ffa2235..0142768 100644
--- a/unix/tkUnixWm.c
+++ b/unix/tkUnixWm.c
@@ -1082,8 +1082,9 @@ Tk_WmObjCmd(
winPtr = (TkWindow *) targetWin;
if (!Tk_IsTopLevel(winPtr) &&
(index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) {
- 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;
}
@@ -1214,8 +1215,9 @@ WmAspectCmd(
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- Tcl_SetResult(interp, "aspect number can't be <= 0",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "aspect number can't be <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "ASPECT", NULL);
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -1650,10 +1652,10 @@ WmCommandCmd(
}
if (objc == 3) {
if (wmPtr->cmdArgv != NULL) {
- /* TODO: Convert this to work with the Tcl_Obj API */
char *arg = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- Tcl_SetResult(interp, arg, TCL_DYNAMIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, -1));
+ ckfree(arg);
}
return TCL_OK;
}
@@ -1715,13 +1717,17 @@ WmDeiconifyCmd(
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]),
- ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't deiconify %s: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL);
return TCL_ERROR;
}
if (winPtr->flags & TK_EMBEDDED) {
- Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName,
- ": it is an embedded window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't deiconify %s: it is an embedded window",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL);
return TCL_ERROR;
}
wmPtr->flags &= ~WM_WITHDRAWN;
@@ -1766,8 +1772,8 @@ WmFocusmodelCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ wmPtr->hints.input ? "passive" : "active", -1));
return TCL_OK;
}
@@ -2000,19 +2006,27 @@ WmGridCmd(
return TCL_ERROR;
}
if (reqWidth < 0) {
- Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "baseWidth can't be < 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
if (reqHeight < 0) {
- Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "baseHeight can't be < 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
if (widthInc <= 0) {
- Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "widthInc can't be <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
if (heightInc <= 0) {
- Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "heightInc can't be <= 0", -1));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL);
return TCL_ERROR;
}
Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
@@ -2191,29 +2205,40 @@ WmIconifyCmd(
return TCL_ERROR;
}
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": override-redirect flag is set", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": override-redirect flag is set",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "CANNOT_ICONIFY",
+ "OVERRIDE_REDIRECT", NULL);
return TCL_ERROR;
}
if (wmPtr->masterPtr != NULL) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": it is a transient", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": it is a transient",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "CANNOT_ICONIFY", "TRANSIENT",
+ NULL);
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
- ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify %s: it is an icon for %s",
+ winPtr->pathName, Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "CANNOT_ICONIFY", "ICON", NULL);
return TCL_ERROR;
}
if (winPtr->flags & TK_EMBEDDED) {
- Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
- ": it is an embedded window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify %s: it is an embedded window",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "CANNOT_ICONIFY", "EMBEDDED",
+ NULL);
return TCL_ERROR;
}
if (TkpWmSetState(winPtr, IconicState) == 0) {
- Tcl_SetResult(interp,
- "couldn't send iconify message to window manager",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't send iconify message to window manager", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2383,8 +2408,10 @@ WmIconphotoCmd(
for (i = 3 + isDefault; i < objc; i++) {
photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
if (photo == NULL) {
- Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]),
- "\" as iconphoto: not a photo image", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use \"%s\" as iconphoto: not a photo image",
+ Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL);
return TCL_ERROR;
}
Tk_PhotoGetSize(photo, &width, &height);
@@ -2594,15 +2621,18 @@ WmIconwindowCmd(
return TCL_ERROR;
}
if (!Tk_IsTopLevel(tkwin2)) {
- Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]),
- " as icon window: not at top level", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use %s as icon window: not at top level",
+ Tcl_GetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONWIN", "INNER", NULL);
return TCL_ERROR;
}
wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
if (wmPtr2->iconFor != NULL) {
- Tcl_AppendResult(interp, Tcl_GetString(objv[3]),
- " is already an icon for ", Tk_PathName(wmPtr2->iconFor),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s is already an icon for %s",
+ Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "ICONWIN", "ICON", NULL);
return TCL_ERROR;
}
if (wmPtr->icon != NULL) {
@@ -2635,9 +2665,10 @@ WmIconwindowCmd(
if (XWithdrawWindow(Tk_Display(tkwin2),
Tk_WindowId(wmPtr2->wrapperPtr),
Tk_ScreenNumber(tkwin2)) == 0) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't send withdraw message to window manager",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
WaitForMapNotify((TkWindow *) tkwin2, 0);
@@ -2677,9 +2708,10 @@ WmManageCmd(
if (!Tk_IsTopLevel(frameWin)) {
if (!Tk_IsManageable(frameWin)) {
- Tcl_AppendResult(interp, "window \"", Tk_PathName(frameWin),
- "\" is not manageable: must be a frame, labelframe or "
- "toplevel", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" is not manageable: must be a frame,"
+ " labelframe or toplevel", Tk_PathName(frameWin)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", "TYPE", NULL);
return TCL_ERROR;
}
TkFocusSplit(winPtr);
@@ -2913,11 +2945,14 @@ WmPositionfromCmd(
return TCL_ERROR;
}
if (objc == 3) {
+ const char *sourceStr = "";
+
if (wmPtr->sizeHintsFlags & USPosition) {
- Tcl_SetResult(interp, "user", TCL_STATIC);
+ sourceStr = "user";
} else if (wmPtr->sizeHintsFlags & PPosition) {
- Tcl_SetResult(interp, "program", TCL_STATIC);
+ sourceStr = "program";
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1));
return TCL_OK;
}
if (*Tcl_GetString(objv[3]) == '\0') {
@@ -3012,8 +3047,9 @@ WmProtocolCmd(
*/
if (strcmp(Tcl_GetString(objv[3]), "_NET_WM_PING") == 0) {
- Tcl_SetResult(interp, "may not alter handling of that protocol",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not alter handling of that protocol", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "PROTOCOL", "RESERVED", NULL);
return TCL_ERROR;
}
@@ -3145,11 +3181,14 @@ WmSizefromCmd(
return TCL_ERROR;
}
if (objc == 3) {
+ const char *sourceStr = "";
+
if (wmPtr->sizeHintsFlags & USSize) {
- Tcl_SetResult(interp, "user", TCL_STATIC);
+ sourceStr = "user";
} else if (wmPtr->sizeHintsFlags & PSize) {
- Tcl_SetResult(interp, "program", TCL_STATIC);
+ sourceStr = "program";
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1));
return TCL_OK;
}
@@ -3235,20 +3274,24 @@ WmStackorderCmd(
winPtr2 = (TkWindow *) relWin;
if (!Tk_IsTopLevel(winPtr2)) {
- Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
- "\" isn't a top-level window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't a top-level window",
+ winPtr2->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL);
return TCL_ERROR;
}
if (!Tk_IsMapped(winPtr)) {
- Tcl_AppendResult(interp, "window \"", winPtr->pathName,
- "\" isn't mapped", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't mapped", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL);
return TCL_ERROR;
}
if (!Tk_IsMapped(winPtr2)) {
- Tcl_AppendResult(interp, "window \"", winPtr2->pathName,
- "\" isn't mapped", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't mapped", winPtr2->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL);
return TCL_ERROR;
}
@@ -3258,9 +3301,10 @@ WmStackorderCmd(
*/
windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
-
if (windows == NULL) {
- Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "TkWmStackorderToplevel failed", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "INTERNAL", NULL);
return TCL_ERROR;
}
@@ -3328,9 +3372,10 @@ WmStateCmd(
}
if (objc == 4) {
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't change state of ",
- Tcl_GetString(objv[2]), ": it is an icon for ",
- Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't change state of %s: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL);
return TCL_ERROR;
}
@@ -3344,27 +3389,35 @@ WmStateCmd(
(void) TkpWmSetState(winPtr, NormalState);
} else if (index == OPT_ICONIC) {
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": override-redirect flag is set", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": override-redirect flag is set",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STATE",
+ "ICONIFY_REDIRECTED", NULL);
return TCL_ERROR;
}
if (wmPtr->masterPtr != NULL) {
- Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
- "\": it is a transient", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't iconify \"%s\": it is a transient",
+ winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "WM", "STATE",
+ "ICONIFY_TRANSIENT", NULL);
return TCL_ERROR;
}
if (TkpWmSetState(winPtr, IconicState) == 0) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't send iconify message to window manager",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
} else { /* OPT_WITHDRAWN */
wmPtr->flags |= WM_WITHDRAWN;
if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't send withdraw message to window manager",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
}
@@ -3516,9 +3569,10 @@ WmTransientCmd(
Tk_MakeWindowExist((Tk_Window) masterPtr);
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]),
- "\" a transient: it is an icon for ",
- Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't make \"%s\" a transient: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
return TCL_ERROR;
}
@@ -3528,15 +3582,17 @@ WmTransientCmd(
}
if (wmPtr2->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]),
- "\" a master: it is an icon for ",
- Tk_PathName(wmPtr2->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't make \"%s\" a master: it is an icon for %s",
+ Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
return TCL_ERROR;
}
if (masterPtr == winPtr) {
- Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr),
- "\" its own master", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't make \"%s\" its own master", Tk_PathName(winPtr)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
return TCL_ERROR;
} else if (masterPtr != wmPtr->masterPtr) {
/*
@@ -3561,9 +3617,10 @@ WmTransientCmd(
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) {
if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't send withdraw message to window manager",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
} else {
@@ -3612,15 +3669,17 @@ WmWithdrawCmd(
return TCL_ERROR;
}
if (wmPtr->iconFor != NULL) {
- Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]),
- ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't withdraw %s: it is an icon for %s",
+ Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL);
return TCL_ERROR;
}
wmPtr->flags |= WM_WITHDRAWN;
if (TkpWmSetState(winPtr, WithdrawnState) == 0) {
- Tcl_SetResult(interp,
- "couldn't send withdraw message to window manager",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't send withdraw message to window manager", -1));
+ Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -5614,7 +5673,9 @@ ParseGeometry(
return TCL_OK;
error:
- Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad geometry specifier \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL);
return TCL_ERROR;
}
@@ -6371,9 +6432,11 @@ TkWmStackorderToplevel(
*window_ptr++ = childWinPtr;
}
}
+
/* ASSERT: window_ptr - windows == table.numEntries
* (#matched toplevel windows == #children) [Bug 1789819]
*/
+
*window_ptr = NULL;
if (numChildren) {
XFree((char *) children);
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index b0c7f4d..7f96ec2 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -361,9 +361,9 @@ Tk_ChooseColorObjCmd(
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL);
return TCL_ERROR;
}
@@ -581,7 +581,7 @@ GetFileName(
Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
Tcl_DString utfFilterString, utfDirString, ds;
Tcl_DString extString, filterString, dirString, titleString;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
static const char *const saveOptionStrings[] = {
"-confirmoverwrite", "-defaultextension", "-filetypes", "-initialdir",
@@ -592,8 +592,8 @@ GetFileName(
"-multiple", "-parent", "-title", "-typevariable", NULL
};
enum options {
- FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
- FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
+ FILE_CONFIRMOW, FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_MULTIPLE, FILE_PARENT, FILE_TITLE, FILE_TYPEVARIABLE
};
file[0] = '\0';
@@ -617,9 +617,9 @@ GetFileName(
}
if (i + 1 == objc) {
- string = Tcl_GetString(objv[i]);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
goto end;
}
@@ -645,9 +645,9 @@ GetFileName(
if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
goto end;
}
- Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds), 0, NULL, (char *) file,
- sizeof(file), NULL, NULL, NULL);
+ Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
+ Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
+ (char *) file, sizeof(file), NULL, NULL, NULL);
Tcl_DStringFree(&ds);
break;
case FILE_PARENT:
@@ -868,8 +868,8 @@ GetFileName(
Tcl_SetObjResult(interp, returnList);
Tcl_DStringFree(&ds);
} else {
- Tcl_AppendResult(interp, ConvertExternalFilename(ofn.lpstrFile,
- &ds), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(ofn.lpstrFile, &ds), -1));
gotFilename = (Tcl_DStringLength(&ds) > 0);
Tcl_DStringFree(&ds);
}
@@ -893,9 +893,10 @@ GetFileName(
}
}
} else if (cdlgerr == FNERR_INVALIDFILENAME) {
- Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC);
- Tcl_AppendResult(interp, ConvertExternalFilename(ofn.lpstrFile,
- &ds), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid filename \"%s\"",
+ ConvertExternalFilename(ofn.lpstrFile, &ds)));
+ Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALIDFILENAME", NULL);
Tcl_DStringFree(&ds);
} else {
result = TCL_OK;
@@ -960,14 +961,16 @@ OFNHookProc(
OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam;
/*
- * This is weird... or not. The CDN_FILEOK is NOT sent when the selection
- * exceeds declared buffer size (the nMaxFile member of the OPENFILENAME
- * struct passed to GetOpenFileName function). So, we have to rely on
- * the most recent CDN_SELCHANGE then. Unfortunately this means, that
- * gathering the selected filenames happens twice when they fit into the
- * declared buffer. Luckily, it's not frequent operation so it should
- * not incur any noticeable delay. See [tktoolkit-Bugs-2987995]
+ * This is weird... or not. The CDN_FILEOK is NOT sent when the
+ * selection exceeds declared buffer size (the nMaxFile member of the
+ * OPENFILENAME struct passed to GetOpenFileName function). So, we
+ * have to rely on the most recent CDN_SELCHANGE then. Unfortunately
+ * this means, that gathering the selected filenames happens twice
+ * when they fit into the declared buffer. Luckily, it's not frequent
+ * operation so it should not incur any noticeable delay. See [Bug
+ * 2987995]
*/
+
if (notifyPtr->hdr.code == CDN_FILEOK ||
notifyPtr->hdr.code == CDN_SELCHANGE) {
int dirsize, selsize;
@@ -989,8 +992,10 @@ OFNHookProc(
buffersize = (selsize + dirsize + 1);
/*
- * Just empty the buffer if dirsize indicates an error [Bug 3071836]
+ * Just empty the buffer if dirsize indicates an error. [Bug
+ * 3071836]
*/
+
if ((selsize > 1) && (dirsize > 0)) {
if (ofnData->dynFileBufferSize < buffersize) {
buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR));
@@ -1355,9 +1360,9 @@ Tk_ChooseDirectoryObjCmd(
goto cleanup;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL);
goto cleanup;
}
@@ -1367,7 +1372,8 @@ Tk_ChooseDirectoryObjCmd(
if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
goto cleanup;
}
- Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, &tempString);
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1,
+ &tempString);
uniStr = (TCHAR *) Tcl_DStringValue(&tempString);
/*
@@ -1459,10 +1465,11 @@ Tk_ChooseDirectoryObjCmd(
pidl = SHBrowseForFolder(&bInfo);
/*
- * This is a fix for Windows 2000, which seems to modify the folder name
- * buffer even when the dialog is canceled (in this case the buffer
- * contains garbage). See [Bug #3002230]
+ * This is a fix for Windows 2000, which seems to modify the folder
+ * name buffer even when the dialog is canceled (in this case the
+ * buffer contains garbage). See [Bug #3002230]
*/
+
path[0] = '\0';
/*
@@ -1471,9 +1478,10 @@ Tk_ChooseDirectoryObjCmd(
if (pidl != NULL) {
if (!SHGetPathFromIDList(pidl, path)) {
- Tcl_SetResult(interp, "Error: Not a file system folder\n",
- TCL_VOLATILE);
- };
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error: not a file system folder", -1));
+ Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "PSEUDO", NULL);
+ }
pMalloc->lpVtbl->Free(pMalloc, (void *) pidl);
} else if (_tcslen(cdCBData.retDir) > 0) {
_tcscpy(path, cdCBData.retDir);
@@ -1500,8 +1508,8 @@ Tk_ChooseDirectoryObjCmd(
if (*path) {
Tcl_DString ds;
- Tcl_AppendResult(interp, ConvertExternalFilename(path, &ds),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ ConvertExternalFilename(path, &ds), -1));
Tcl_DStringFree(&ds);
}
@@ -1576,7 +1584,8 @@ ChooseDirectoryValidateProc(
Tcl_DStringFree(&initDirString);
Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString);
Tcl_DStringFree(&tempString);
- _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString), MAX_PATH);
+ _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString),
+ MAX_PATH);
Tcl_DStringFree(&initDirString);
if (SetCurrentDirectory(string) == 0) {
@@ -1594,7 +1603,9 @@ ChooseDirectoryValidateProc(
* User HAS to select a valid directory.
*/
- wsprintf(selDir, TEXT("Directory '%s' does not exist,\nplease select or enter an existing directory."), chooseDirSharedData->retDir);
+ wsprintf(selDir, TEXT("Directory '%s' does not exist,\n"
+ "please select or enter an existing directory."),
+ chooseDirSharedData->retDir);
MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
chooseDirSharedData->retDir[0] = '\0';
return 1;
@@ -1730,7 +1741,6 @@ Tk_MessageBoxObjCmd(
for (i = 1; i < objc; i += 2) {
int index;
- const char *string;
Tcl_Obj *optionPtr, *valuePtr;
optionPtr = objv[i];
@@ -1741,9 +1751,9 @@ Tk_MessageBoxObjCmd(
return TCL_ERROR;
}
if (i + 1 == objc) {
- string = Tcl_GetString(optionPtr);
- Tcl_AppendResult(interp, "value for \"", string, "\" missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(optionPtr)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL);
return TCL_ERROR;
}
@@ -1812,9 +1822,10 @@ Tk_MessageBoxObjCmd(
}
}
if (defaultBtnIdx < 0) {
- Tcl_AppendResult(interp, "invalid default button \"",
- TkFindStateString(buttonMap, defaultBtn),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid default button \"%s\"",
+ TkFindStateString(buttonMap, defaultBtn)));
+ Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL);
return TCL_ERROR;
}
break;
@@ -1862,9 +1873,8 @@ Tk_MessageBoxObjCmd(
EnableWindow(hWnd, 1);
Tcl_DecrRefCount(tmpObj);
-
- Tcl_SetResult(interp,
- (char *)TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TkFindStateString(buttonMap, winCode), -1));
return TCL_OK;
}
@@ -1932,6 +1942,7 @@ SetTkDialog(
/*
* Factored out a common pattern in use in this file.
*/
+
static const char *
ConvertExternalFilename(
TCHAR *filename,
@@ -1967,7 +1978,9 @@ ConvertExternalFilename(
*/
static Tcl_Obj *
-GetFontObj(HDC hdc, LOGFONT *plf)
+GetFontObj(
+ HDC hdc,
+ LOGFONT *plf)
{
Tcl_DString ds;
Tcl_Obj *resObj;
@@ -1999,7 +2012,11 @@ GetFontObj(HDC hdc, LOGFONT *plf)
}
static void
-ApplyLogfont(Tcl_Interp *interp, Tcl_Obj *cmdObj, HDC hdc, LOGFONT *logfontPtr)
+ApplyLogfont(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ HDC hdc,
+ LOGFONT *logfontPtr)
{
int objc;
Tcl_Obj **objv, **tmpv;
@@ -2034,7 +2051,11 @@ typedef struct HookData {
} HookData;
static UINT_PTR CALLBACK
-HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam)
+HookProc(
+ HWND hwndDlg,
+ UINT msg,
+ WPARAM wParam,
+ LPARAM lParam)
{
CHOOSEFONT *pcf = (CHOOSEFONT *) lParam;
HWND hwndCtrl;
@@ -2046,7 +2067,7 @@ HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam)
phd = (HookData *) pcf->lCustData;
phd->hwnd = hwndDlg;
if (tsdPtr->debugFlag) {
- tsdPtr->debugInterp = (Tcl_Interp *) phd->interp;
+ tsdPtr->debugInterp = phd->interp;
Tcl_DoWhenIdle(SetTkDialog, hwndDlg);
}
if (phd->titleObj != NULL) {
@@ -2113,7 +2134,9 @@ enum FontchooserOption {
};
static Tcl_Obj *
-FontchooserCget(HookData *hdPtr, int optionIndex)
+FontchooserCget(
+ HookData *hdPtr,
+ int optionIndex)
{
Tcl_Obj *resObj = NULL;
@@ -2223,16 +2246,18 @@ FontchooserConfigureCmd(
return TCL_OK;
}
if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"",
- Tcl_GetString(objv[i]), "\" missing", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL);
return TCL_ERROR;
}
switch (optionIndex) {
case FontchooserVisible: {
- const char *msg = "cannot change read-only option "
+ static const char *msg = "cannot change read-only option "
"\"-visible\": use the show or hide command";
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL);
return TCL_ERROR;
}
case FontchooserParent: {
@@ -2365,9 +2390,10 @@ FontchooserShowCmd(
}
fontPtr = (TkFont *) f;
cf.Flags |= CF_INITTOLOGFONTSTRUCT;
- Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds);
- _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds), LF_FACESIZE-1);
- Tcl_DStringFree(&ds);
+ Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds);
+ _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds),
+ LF_FACESIZE-1);
+ Tcl_DStringFree(&ds);
lf.lfFaceName[LF_FACESIZE-1] = 0;
lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size),
GetDeviceCaps(hdc, LOGPIXELSY), 72);
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index 45ccbe2..4bb0a06 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.c
@@ -3315,7 +3315,7 @@ WmClientCmd(
}
if (objc == 3) {
if (wmPtr->clientMachine != NULL) {
- Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
+ Tcl_SetResult(interp, Tcl_NewStringObj(wmPtr->clientMachine, -1));
}
return TCL_OK;
}
@@ -3477,7 +3477,8 @@ WmCommandCmd(
}
if (objc == 3) {
if (wmPtr->cmdArgv != NULL) {
- char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
+ char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
+
Tcl_SetResult(interp, merged, TCL_DYNAMIC);
}
return TCL_OK;
@@ -3965,9 +3966,9 @@ WmIconbitmapCmd(
*/
if (wmPtr->hints.flags & IconPixmapHint) {
- Tcl_SetResult(interp, (char *)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
- TCL_STATIC);
+ -1));
}
return TCL_OK;
}
@@ -4139,9 +4140,9 @@ WmIconmaskCmd(
}
if (objc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- Tcl_SetResult(interp, (char *)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
- TCL_STATIC);
+ -1));
}
return TCL_OK;
}
@@ -4196,9 +4197,8 @@ WmIconnameCmd(
return TCL_ERROR;
}
if (objc == 3) {
- Tcl_SetResult(interp,
- ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ (wmPtr->iconName ? wmPtr->iconName : ""), -1));
return TCL_OK;
} else {
if (wmPtr->iconName != NULL) {
@@ -4488,7 +4488,7 @@ WmIconwindowCmd(
}
if (objc == 3) {
if (wmPtr->icon != NULL) {
- Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon));
}
return TCL_OK;
}
@@ -4898,7 +4898,8 @@ WmProtocolCmd(
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(protPtr->command, -1));
return TCL_OK;
}
}
@@ -5368,12 +5369,13 @@ WmTitleCmd(
GetWindowText(wrapper, buf, size);
Tcl_WinTCharToUtf(buf, -1, &titleString);
- Tcl_SetResult(interp, Tcl_DStringValue(&titleString), TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_DStringValue(&titleString),
+ Tcl_DStringLength(&titleString)));
Tcl_DStringFree(&titleString);
} else {
- Tcl_SetResult(interp, (char *)
- ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ (wmPtr->title ? wmPtr->title : winPtr->nameUid), -1));
}
} else {
if (wmPtr->title != NULL) {
@@ -5429,7 +5431,7 @@ WmTransientCmd(
}
if (objc == 3) {
if (masterPtr != NULL) {
- Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
+ Tcl_SetObjResult(interp, TkNewWindowObj(masterPtr));
}
return TCL_OK;
}