diff options
46 files changed, 1006 insertions, 757 deletions
diff --git a/carbon/tkMacOSXWindowEvent.c b/carbon/tkMacOSXWindowEvent.c index 2f46026..99ab918 100644 --- a/carbon/tkMacOSXWindowEvent.c +++ b/carbon/tkMacOSXWindowEvent.c @@ -885,10 +885,9 @@ TkWmProtocolEventProc( Tcl_Preserve(interp); result = Tcl_GlobalEval(interp, protPtr->command); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, - Tk_GetAtomName((Tk_Window) winPtr, protocol)); - Tcl_AddErrorInfo(interp, "\" window manager protocol)"); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + Tk_GetAtomName((Tk_Window) winPtr, protocol))); Tcl_BackgroundException(interp, result); } Tcl_Release(interp); diff --git a/generic/tk3d.c b/generic/tk3d.c index 2920c76..dd7ab2f 100644 --- a/generic/tk3d.c +++ b/generic/tk3d.c @@ -673,11 +673,10 @@ Tk_GetRelief( } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) { *reliefPtr = TK_RELIEF_SUNKEN; } else { - char buf[200]; - - sprintf(buf, "bad relief \"%.50s\": must be %s", - name, "flat, groove, raised, ridge, solid, or sunken"); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("bad relief \"%.50s\": must be %s", + name, "flat, groove, raised, ridge, solid, or sunken")); + Tcl_SetErrorCode(interp, "TK", "VALUE", "RELIEF", NULL); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tkArgv.c b/generic/tkArgv.c index 3f235ad..f4ddda4 100644 --- a/generic/tkArgv.c +++ b/generic/tkArgv.c @@ -70,7 +70,7 @@ Tk_ParseArgv( register const Tk_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ - const Tk_ArgvInfo *matchPtr; /* Descriptor that matches current argument. */ + const Tk_ArgvInfo *matchPtr;/* Descriptor that matches current argument. */ const char *curArg; /* Current argument */ register char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. @@ -83,6 +83,7 @@ Tk_ParseArgv( * than srcIndex). */ int argc; /* # arguments in argv still to process. */ size_t length; /* Number of characters in current argument. */ + char *endPtr; /* Used for identifying junk in arguments. */ int i; if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) { @@ -139,8 +140,9 @@ Tk_ParseArgv( continue; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", curArg, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "AMBIGUOUS", NULL); return TCL_ERROR; } matchPtr = infoPtr; @@ -153,8 +155,9 @@ Tk_ParseArgv( */ if (flags & TK_ARGV_NO_LEFTOVERS) { - Tcl_AppendResult(interp, "unrecognized argument \"", - curArg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unrecognized argument \"%s\"", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "UNRECOGNIZED", NULL); return TCL_ERROR; } argv[dstIndex] = curArg; @@ -175,19 +178,17 @@ Tk_ParseArgv( case TK_ARGV_INT: if (argc == 0) { goto missingArg; - } else { - char *endPtr; - - *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0); - if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { - Tcl_AppendResult(interp,"expected integer argument for \"", - infoPtr->key, "\" but got \"", argv[srcIndex], - "\"", NULL); - return TCL_ERROR; - } - srcIndex++; - argc--; } + *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0); + if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s argument for \"%s\" but got \"%s\"", + "integer", infoPtr->key, argv[srcIndex])); + Tcl_SetErrorCode(interp, "TK", "ARG", "INTEGER", NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_STRING: if (argc == 0) { @@ -211,19 +212,17 @@ Tk_ParseArgv( case TK_ARGV_FLOAT: if (argc == 0) { goto missingArg; - } else { - char *endPtr; - - *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr); - if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { - Tcl_AppendResult(interp, "expected floating-point ", - "argument for \"", infoPtr->key, "\" but got \"", - argv[srcIndex], "\"", NULL); - return TCL_ERROR; - } - srcIndex++; - argc--; } + *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr); + if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s argument for \"%s\" but got \"%s\"", + "floating-point", infoPtr->key, argv[srcIndex])); + Tcl_SetErrorCode(interp, "TK", "ARG", "FLOAT", NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_FUNC: { typedef int (ArgvFunc)(char *, const char *, const char *); @@ -249,6 +248,7 @@ Tk_ParseArgv( } case TK_ARGV_HELP: PrintUsage(interp, argTable, flags); + Tcl_SetErrorCode(interp, "TK", "ARG", "HELP", NULL); return TCL_ERROR; case TK_ARGV_CONST_OPTION: Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src, @@ -265,8 +265,10 @@ Tk_ParseArgv( break; case TK_ARGV_OPTION_NAME_VALUE: if (argc < 2) { - Tcl_AppendResult(interp, "\"", curArg, - "\" option requires two following arguments", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires two following arguments", + curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "NAME_VALUE", NULL); return TCL_ERROR; } Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1], @@ -274,14 +276,12 @@ Tk_ParseArgv( srcIndex += 2; argc -= 2; break; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad argument type %d in Tk_ArgvInfo", infoPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument type %d in Tk_ArgvInfo", infoPtr->type)); + Tcl_SetErrorCode(interp, "TK", "ARG", "BAD_TYPE", NULL); return TCL_ERROR; } - } } /* @@ -301,8 +301,9 @@ Tk_ParseArgv( return TCL_OK; missingArg: - Tcl_AppendResult(interp, "\"", curArg, - "\" option requires an additional argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires an additional argument", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "MISSING", NULL); return TCL_ERROR; } diff --git a/generic/tkBind.c b/generic/tkBind.c index e58ad4d..0c50368 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -2926,6 +2926,7 @@ HandleEventGenerate( || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { Tcl_AppendResult(interp, "window id \"", Tcl_GetString(objv[0]), "\" doesn't exist in this application", NULL); + Tcl_SetErrorCode(interp, "TK", "EVENT", "FOREIGN_TARGET", NULL); return TCL_ERROR; } @@ -2941,11 +2942,13 @@ HandleEventGenerate( if (count != 1) { Tcl_SetResult(interp, "Double or Triple modifier not allowed", TCL_STATIC); + 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_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL); return TCL_ERROR; } @@ -3023,6 +3026,7 @@ HandleEventGenerate( Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr), "\" missing", NULL); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL); return TCL_ERROR; } @@ -3165,6 +3169,7 @@ HandleEventGenerate( if (keysym == NoSymbol) { Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", NULL); return TCL_ERROR; } @@ -3172,6 +3177,7 @@ HandleEventGenerate( if (event.general.xkey.keycode == 0) { Tcl_AppendResult(interp, "no keycode for keysym \"", value, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", NULL); return TCL_ERROR; } if (!(flags & KEY) @@ -3402,6 +3408,7 @@ HandleEventGenerate( badopt: Tcl_AppendResult(interp, name, " event doesn't accept \"", Tcl_GetString(optionPtr), "\" option", NULL); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL); return TCL_ERROR; } @@ -3496,6 +3503,7 @@ NameToWindow( badWindow: Tcl_AppendResult(interp, "bad window name/identifier \"",name,"\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", NULL); return TCL_ERROR; } @@ -3560,6 +3568,7 @@ GetVirtualEventUid( virtString[length - 2] != '>' || virtString[length - 1] != '>') { Tcl_AppendResult(interp, "virtual event \"", virtString, "\" is badly formed", NULL); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); return NULL; } virtString[length - 2] = '\0'; @@ -3654,6 +3663,8 @@ FindSequence( Tcl_SetResult(interp, "virtual event not allowed in definition of another virtual event", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", + NULL); return NULL; } virtualFound = 1; @@ -3680,11 +3691,14 @@ FindSequence( if (numPats == 0) { Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); + 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_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", + NULL); return NULL; } @@ -3804,6 +3818,7 @@ ParseEventDescription( } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad ASCII character 0x%x", UCHAR(*p))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL); count = 0; goto done; } @@ -3846,12 +3861,16 @@ ParseEventDescription( if (p == field) { Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", TCL_STATIC); + 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_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } @@ -3920,6 +3939,7 @@ ParseEventDescription( } else if ((eventFlags & BUTTON) == 0) { Tcl_AppendResult(interp, "specified button \"", field, "\" for non-button event", NULL); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL); count = 0; goto done; } @@ -3931,6 +3951,7 @@ ParseEventDescription( if (patPtr->detail.keySym == NoSymbol) { Tcl_AppendResult(interp, "bad event type or keysym \"", field, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", NULL); count = 0; goto done; } @@ -3940,6 +3961,7 @@ ParseEventDescription( } else if ((eventFlags & KEY) == 0) { Tcl_AppendResult(interp, "specified keysym \"", field, "\" for non-key event", NULL); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL); count = 0; goto done; } @@ -3947,6 +3969,7 @@ ParseEventDescription( } else if (eventFlags == 0) { Tcl_SetResult(interp, "no event type or button # or keysym", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); count = 0; goto done; } @@ -3961,11 +3984,13 @@ ParseEventDescription( Tcl_SetResult(interp, "extra characters after detail in binding", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); count = 0; goto done; } } Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); count = 0; goto done; } diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index b0d1ecc..5349fd5 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -344,6 +344,7 @@ GetBitmap( if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't specify bitmap with '@' in a", " safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); goto error; } @@ -365,6 +366,7 @@ GetBitmap( if (interp != NULL) { Tcl_AppendResult(interp, "error reading bitmap file \"", string, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL); } Tcl_DStringFree(&buffer); goto error; @@ -386,6 +388,7 @@ GetBitmap( if (interp != NULL) { Tcl_AppendResult(interp, "bitmap \"", string, "\" not defined", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", NULL); } goto error; } @@ -489,6 +492,7 @@ Tk_DefineBitmap( if (!isNew) { Tcl_AppendResult(interp, "bitmap \"", name, "\" is already defined", NULL); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "EXISTS", NULL); return TCL_ERROR; } predefPtr = ckalloc(sizeof(TkPredefBitmap)); diff --git a/generic/tkBusy.c b/generic/tkBusy.c index fc7f6ab..5439969 100644 --- a/generic/tkBusy.c +++ b/generic/tkBusy.c @@ -689,6 +689,7 @@ GetBusy( if (hPtr == NULL) { Tcl_AppendResult(interp, "can't find busy window \"", Tcl_GetString(windowObj), "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BUSY", NULL); return NULL; } return Tcl_GetHashValue(hPtr); diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index 6cbc89b..d8a8062 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.c @@ -344,27 +344,21 @@ ArcCoords( ArcItem *arcPtr = (ArcItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(arcPtr->bbox[0]); - - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[1]); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[2]); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[3]); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *objs[4]; + + objs[0] = Tcl_NewDoubleObj(arcPtr->bbox[0]); + objs[1] = Tcl_NewDoubleObj(arcPtr->bbox[1]); + objs[2] = Tcl_NewDoubleObj(arcPtr->bbox[2]); + objs[3] = Tcl_NewDoubleObj(arcPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); } else if ((objc == 1)||(objc == 4)) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 4, got %d", objc)); return TCL_ERROR; } } @@ -380,10 +374,8 @@ ArcCoords( } ComputeArcBbox(canvas, arcPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 4, got %d", objc)); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index ea16a29..adaa184 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.c @@ -249,10 +249,8 @@ BitmapCoords( if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(bmapPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); + Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->x)); + Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->y)); Tcl_SetObjResult(interp, obj); } else if (objc < 3) { if (objc == 1) { @@ -260,10 +258,8 @@ BitmapCoords( (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); return TCL_ERROR; } } @@ -275,10 +271,8 @@ BitmapCoords( } ComputeBitmapBbox(canvas, bmapPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c index 880070b..b92659b 100644 --- a/generic/tkCanvImg.c +++ b/generic/tkCanvImg.c @@ -232,23 +232,19 @@ ImageCoords( ImageItem *imgPtr = (ImageItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); + Tcl_Obj *objs[2]; - Tcl_Obj *subobj = Tcl_NewDoubleObj(imgPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(imgPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + objs[0] = Tcl_NewDoubleObj(imgPtr->x); + objs[1] = Tcl_NewDoubleObj(imgPtr->y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); return TCL_ERROR; } } @@ -259,10 +255,8 @@ ImageCoords( } ComputeImageBbox(canvas, imgPtr); } else { - char buf[64]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index 20a391e..e2dd8d3 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.c @@ -391,54 +391,50 @@ LineCoords( } } if (objc & 1) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected an even number, got %d", - objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected an even number, got %d", + objc)); return TCL_ERROR; } else if (objc < 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected at least 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected at least 4, got %d", objc)); return TCL_ERROR; - } else { - numPoints = objc/2; - if (linePtr->numPoints != numPoints) { - coordPtr = ckalloc(sizeof(double) * objc); - if (linePtr->coordPtr != NULL) { - ckfree(linePtr->coordPtr); - } - linePtr->coordPtr = coordPtr; - linePtr->numPoints = numPoints; + } + + numPoints = objc/2; + if (linePtr->numPoints != numPoints) { + coordPtr = ckalloc(sizeof(double) * objc); + if (linePtr->coordPtr != NULL) { + ckfree(linePtr->coordPtr); } - coordPtr = linePtr->coordPtr; - for (i = 0; i < objc ; i++) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], - coordPtr++) != TCL_OK) { - return TCL_ERROR; - } + linePtr->coordPtr = coordPtr; + linePtr->numPoints = numPoints; + } + coordPtr = linePtr->coordPtr; + for (i = 0; i < objc ; i++) { + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], + coordPtr++) != TCL_OK) { + return TCL_ERROR; } + } - /* - * Update arrowheads by throwing away any existing arrow-head - * information and calling ConfigureArrows to recompute it. - */ + /* + * Update arrowheads by throwing away any existing arrow-head information + * and calling ConfigureArrows to recompute it. + */ - if (linePtr->firstArrowPtr != NULL) { - ckfree(linePtr->firstArrowPtr); - linePtr->firstArrowPtr = NULL; - } - if (linePtr->lastArrowPtr != NULL) { - ckfree(linePtr->lastArrowPtr); - linePtr->lastArrowPtr = NULL; - } - if (linePtr->arrow != ARROWS_NONE) { - ConfigureArrows(canvas, linePtr); - } - ComputeLineBbox(canvas, linePtr); + if (linePtr->firstArrowPtr != NULL) { + ckfree(linePtr->firstArrowPtr); + linePtr->firstArrowPtr = NULL; + } + if (linePtr->lastArrowPtr != NULL) { + ckfree(linePtr->lastArrowPtr); + linePtr->lastArrowPtr = NULL; + } + if (linePtr->arrow != ARROWS_NONE) { + ConfigureArrows(canvas, linePtr); } + ComputeLineBbox(canvas, linePtr); return TCL_OK; } @@ -1894,16 +1890,8 @@ ParseArrowShape( } if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) { - syntaxError: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad arrow shape \"", value, - "\": must be list with three numbers", NULL); - if (argv != NULL) { - ckfree(argv); - } - return TCL_ERROR; - } - if (argc != 3) { + goto syntaxError; + } else if (argc != 3) { goto syntaxError; } if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK) @@ -1913,11 +1901,21 @@ ParseArrowShape( != TCL_OK)) { goto syntaxError; } + linePtr->arrowShapeA = (float) a; linePtr->arrowShapeB = (float) b; linePtr->arrowShapeC = (float) c; ckfree(argv); return TCL_OK; + + syntaxError: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad arrow shape \"", value, + "\": must be list with three numbers", NULL); + if (argv != NULL) { + ckfree(argv); + } + return TCL_ERROR; } /* diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index eafc07f..69c9cfb 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -548,11 +548,9 @@ TkCanvPostscriptCmd( result = itemPtr->typePtr->postscriptProc(interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (generating Postscript for item %d)", - itemPtr->id); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (generating Postscript for item %d)", + itemPtr->id)); goto cleanup; } Tcl_AppendResult(interp, "grestore\n", NULL); diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index f2cce7d..0c54741 100644 --- a/generic/tkCanvWind.c +++ b/generic/tkCanvWind.c @@ -246,22 +246,19 @@ WinItemCoords( WindowItem *winItemPtr = (WindowItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(winItemPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(winItemPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *objs[2]; + + objs[0] = Tcl_NewDoubleObj(winItemPtr->x); + objs[1] = Tcl_NewDoubleObj(winItemPtr->y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); return TCL_ERROR; } } @@ -272,10 +269,8 @@ WinItemCoords( } ComputeWindowBbox(canvas, winItemPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tkColor.c b/generic/tkColor.c index 9383a92..b1ed4f1 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -226,9 +226,11 @@ Tk_GetColor( if (*name == '#') { Tcl_AppendResult(interp, "invalid color name \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); } else { Tcl_AppendResult(interp, "unknown color name \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "COLOR", name, NULL); } } if (isNew) { @@ -372,10 +374,12 @@ Tk_NameOfColor( sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, colorPtr->green, colorPtr->blue); - /* If the string has the form #RSRSTUTUVWVW (where equal - * letters denote equal hexdigits) then this is - * equivalent to #RSTUVW. Then output the shorter form. + /* + * If the string has the form #RSRSTUTUVWVW (where equal letters + * denote equal hexdigits) then this is equivalent to #RSTUVW. Then + * output the shorter form. */ + if ((tsdPtr->rgbString[1] == tsdPtr->rgbString[3]) && (tsdPtr->rgbString[2] == tsdPtr->rgbString[4]) && (tsdPtr->rgbString[5] == tsdPtr->rgbString[7]) diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 5262f58..51ac6dc 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -946,16 +946,13 @@ DoObjConfig( break; } - { - char buf[40+TCL_INTEGER_SPACE]; - default: - sprintf(buf, "bad config table: unknown type %d", - optionPtr->specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", + optionPtr->specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } /* * Release resources associated with the old value, if we're not returning @@ -1162,6 +1159,7 @@ GetOptionFromObj( error: if (interp != NULL) { Tcl_AppendResult(interp, "unknown option \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL); } return NULL; } @@ -1231,9 +1229,10 @@ SetOptionFromAny( Tcl_AppendResult(interp, "can't convert value to option except via GetOptionFromObj API", NULL); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1348,6 +1347,7 @@ Tk_SetOptions( if (interp != NULL) { Tcl_AppendResult(interp, "value for \"", Tcl_GetStringFromObj(*objv, NULL), "\" missing",NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); goto error; } } @@ -1369,11 +1369,9 @@ Tk_SetOptions( if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin, (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems] : NULL) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - Tcl_GetStringFromObj(*objv, NULL)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)", + Tcl_GetStringFromObj(*objv, NULL))); goto error; } if (savePtr != NULL) { @@ -1771,7 +1769,6 @@ FreeResources( * single option or all the configuration options in a table. * * Results: - * This function normally returns a pointer to an object. If namePtr * isn't NULL, then the result object is a list with five elements: the * option's name, its database name, database class, default value, and @@ -2154,8 +2151,7 @@ TkDebugConfig( Tcl_Obj *objPtr; objPtr = Tcl_NewObj(); - hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, - NULL); + hashTablePtr = Tcl_GetAssocData(interp, OPTION_HASH_KEY, NULL); if (hashTablePtr == NULL) { return objPtr; } diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 044a35b..39aa228 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -2935,10 +2935,9 @@ EntryUpdateScrollbar( code = Tcl_VarEval(interp, entryPtr->scrollCmd, " ", firstStr, " ", lastStr, NULL); if (code != TCL_OK) { - Tcl_AddErrorInfo(interp, - "\n (horizontal scrolling command executed by "); - Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin)); - Tcl_AddErrorInfo(interp, ")"); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (horizontal scrolling command executed by %s)", + Tk_PathName(entryPtr->tkwin))); Tcl_BackgroundException(interp, code); } Tcl_ResetResult(interp); @@ -3141,7 +3140,7 @@ EntryValidate( if (code != TCL_OK && code != TCL_RETURN) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n\t(in validation command executed by %s)", + "\n (in validation command executed by %s)", Tk_PathName(entryPtr->tkwin))); Tcl_BackgroundException(interp, code); return TCL_ERROR; @@ -3154,7 +3153,7 @@ EntryValidate( if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), &bool) != TCL_OK) { Tcl_AddErrorInfo(interp, - "\nvalid boolean not returned by validation command"); + "\n (invalid boolean result from validation command)"); Tcl_BackgroundError(interp); Tcl_ResetResult(interp); return TCL_ERROR; @@ -3280,7 +3279,7 @@ EntryValidateChange( TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (result != TCL_OK) { Tcl_AddErrorInfo(entryPtr->interp, - "\n\t(in invalidcommand executed by entry)"); + "\n (in invalidcommand executed by entry)"); Tcl_BackgroundException(entryPtr->interp, result); code = TCL_ERROR; entryPtr->validate = VALIDATE_NONE; @@ -4284,7 +4283,8 @@ SpinboxInvoke( Tcl_DStringFree(&script); if (code != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)"); + Tcl_AddErrorInfo(interp, + "\n (in command executed by spinbox)"); Tcl_BackgroundException(interp, code); /* diff --git a/generic/tkFont.c b/generic/tkFont.c index 32d0589..e536c41 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -569,6 +569,7 @@ Tk_FontObjCmd( -1, 40, "..."); Tcl_AppendToObj(resultPtr, "\"", -1); Tcl_SetObjResult(interp, resultPtr); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL); return TCL_ERROR; } uniChar = Tcl_GetUniChar(charPtr, 0); @@ -618,6 +619,7 @@ Tk_FontObjCmd( if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) { Tcl_AppendResult(interp, "named font \"", string, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); return TCL_ERROR; } if (objc == 3) { @@ -951,6 +953,7 @@ TkCreateNamedFont( if (interp) { Tcl_AppendResult(interp, "named font \"", name, "\" already exists", NULL); + Tcl_SetErrorCode(interp, "TK", "FONT", "EXISTS", NULL); } return TCL_ERROR; } @@ -1002,6 +1005,7 @@ TkDeleteNamedFont( if (interp) { Tcl_AppendResult(interp, "named font \"", name, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL); } return TCL_ERROR; } @@ -1185,6 +1189,7 @@ Tk_AllocFontFromObj( } Tcl_AppendResult(interp, "failed to allocate font due to ", "internal system font engine problem", NULL); + Tcl_SetErrorCode(interp, "TK", "FONT", "INTERNAL_PROBLEM", NULL); return NULL; } @@ -3405,6 +3410,7 @@ ConfigAttributesObj( if (interp != NULL) { Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr), "\" option missing", NULL); + Tcl_SetErrorCode(interp, "TK", "FONT", "NO_ATTRIBUTE", NULL); } return TCL_ERROR; } @@ -3648,6 +3654,7 @@ ParseFontNameObj( if (interp != NULL) { Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); } return TCL_ERROR; } @@ -3696,6 +3703,8 @@ ParseFontNameObj( if (interp != NULL) { Tcl_AppendResult(interp, "unknown font style \"", Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT_STYLE", + Tcl_GetString(objv[i]), NULL); } return TCL_ERROR; } @@ -4077,7 +4086,6 @@ TkFontGetPoints( * platform expects when asking for the font. * * Results: - * As above. The return value is NULL if the font name has no aliases. * * Side effects: diff --git a/generic/tkGrab.c b/generic/tkGrab.c index 695690b..9e9daae 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -215,6 +215,7 @@ Tk_GrabObjCmd( 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); return TCL_ERROR; } @@ -410,10 +411,7 @@ Tk_Grab( return TCL_OK; } if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) { - alreadyGrabbed: - Tcl_SetResult(interp, "grab failed: another application has grab", - TCL_STATIC); - return TCL_ERROR; + goto alreadyGrabbed; } Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr); } @@ -423,7 +421,7 @@ Tk_Grab( if (!grabGlobal) #else if (0) -#endif +#endif /* MAC_OSX_TK */ { Window dummy1, dummy2; int dummy3, dummy4, dummy5, dummy6; @@ -479,26 +477,7 @@ Tk_Grab( Tcl_Sleep(100); } if (grabResult != 0) { - grabError: - if (grabResult == GrabNotViewable) { - Tcl_SetResult(interp, "grab failed: window not viewable", - TCL_STATIC); - } else if (grabResult == AlreadyGrabbed) { - goto alreadyGrabbed; - } else if (grabResult == GrabFrozen) { - Tcl_SetResult(interp, - "grab failed: keyboard or pointer frozen", TCL_STATIC); - } else if (grabResult == GrabInvalidTime) { - Tcl_SetResult(interp, "grab failed: invalid time", - TCL_STATIC); - } else { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "grab failed for unknown reason (code %d)", - grabResult); - Tcl_AppendResult(interp, msg, NULL); - } - return TCL_ERROR; + goto grabError; } grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin), False, GrabModeAsync, GrabModeAsync, CurrentTime); @@ -546,6 +525,29 @@ Tk_Grab( } QueueGrabWindowChange(dispPtr, winPtr); return TCL_OK; + + grabError: + if (grabResult == GrabNotViewable) { + Tcl_SetResult(interp, "grab failed: window not viewable", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL); + } else if (grabResult == AlreadyGrabbed) { + alreadyGrabbed: + Tcl_SetResult(interp, "grab failed: another application has grab", + TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL); + } else if (grabResult == GrabFrozen) { + Tcl_SetResult(interp, + "grab failed: keyboard or pointer frozen", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL); + } else if (grabResult == GrabInvalidTime) { + Tcl_SetResult(interp, "grab failed: invalid time", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GRAB", "BADTIME", NULL); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "grab failed for unknown reason (code %d)", grabResult)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNKNOWN", NULL); + } + return TCL_ERROR; } /* diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 70d463e..627bb89 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -402,7 +402,7 @@ Tk_GridObjCmd( } /* This should not happen */ - Tcl_SetResult(interp, "Internal error in grid.", TCL_STATIC); + Tcl_SetResult(interp, "internal error in grid", TCL_STATIC); return TCL_ERROR; } @@ -997,6 +997,7 @@ GridRowColumnConfigureCommand( Tcl_AppendResult(interp, "no ", (slotType == COLUMN) ? "column" : "row", " indices specified", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "NOINDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1010,6 +1011,7 @@ GridRowColumnConfigureCommand( Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), ": must specify a single element on retrieval", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1017,6 +1019,7 @@ GridRowColumnConfigureCommand( Tcl_AppendResult(interp, " (when retreiving options only integer indices are " "allowed)", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1122,6 +1125,7 @@ GridRowColumnConfigureCommand( Tcl_GetString(objv[1]), ": the window \"", Tcl_GetString(lObjv[j]), "\" is not managed by \"", Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "GRID_MASTER", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1129,6 +1133,7 @@ GridRowColumnConfigureCommand( Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), ": illegal index \"", Tcl_GetString(lObjv[j]), "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1152,6 +1157,7 @@ GridRowColumnConfigureCommand( Tcl_GetString(objv[1]), ": \"", Tcl_GetString(lObjv[j]), "\" is out of range", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1189,6 +1195,8 @@ GridRowColumnConfigureCommand( Tcl_GetString(objv[i]), "\": should be non-negative", NULL); Tcl_DecrRefCount(listCopy); + Tcl_SetErrorCode(interp, "TK", "GRID", + "NEG_INDEX", NULL); return TCL_ERROR; } else { slotPtr[slot].weight = wt; @@ -1209,6 +1217,8 @@ GridRowColumnConfigureCommand( 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; } else { @@ -1363,6 +1373,7 @@ GridSlavesCommand( if (value < 0) { Tcl_AppendResult(interp, Tcl_GetString(objv[i]), " is an invalid value: should NOT be < 0", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); return TCL_ERROR; } if (index == SLAVES_COLUMN) { @@ -2529,6 +2540,7 @@ SetSlaveColumn( lastCol = ((newColumn >= 0) ? newColumn : 0) + newNumCols; if (lastCol >= MAX_ELEMENT) { Tcl_SetResult(interp, "Column out of bounds", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_COLUMN", NULL); return TCL_ERROR; } @@ -2569,6 +2581,7 @@ SetSlaveRow( lastRow = ((newRow >= 0) ? newRow : 0) + newNumRows; if (lastRow >= MAX_ELEMENT) { Tcl_SetResult(interp, "Row out of bounds", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_ROW", NULL); return TCL_ERROR; } @@ -2994,6 +3007,7 @@ ConfigureSlaves( if (length > 1 && i == 0) { Tcl_AppendResult(interp, "bad argument \"", string, "\": must be name of window", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (length > 1 && firstChar == '-') { @@ -3003,6 +3017,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "unexpected parameter, \"", string, "\", in configure list. ", "Should be window name or option", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3010,6 +3025,7 @@ ConfigureSlaves( (prevChar == REL_SKIP) || (prevChar == REL_VERT))) { Tcl_AppendResult(interp, "Must specify window before shortcut '-'.", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3020,12 +3036,14 @@ ConfigureSlaves( Tcl_AppendResult(interp, "invalid window shortcut, \"", string, "\" should be '-', 'x', or '^'", NULL); + 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_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3055,6 +3073,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad row value \"", Tcl_GetString(objv[i+1]), "\": must be ", "a non-negative integer", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "POSITIVE_INT", NULL); return TCL_ERROR; } defaultRow = tmp; @@ -3118,6 +3137,7 @@ ConfigureSlaves( if (Tk_TopWinHierarchy(slave)) { Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[j]), "\": it's a top-level window", NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetGrid(slave); @@ -3147,6 +3167,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad column value \"", Tcl_GetString(objv[i+1]), "\": must be ", "a non-negative integer", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3159,6 +3180,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad columnspan value \"", Tcl_GetString(objv[i+1]), "\": must be ", "a positive integer", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3173,6 +3195,7 @@ ConfigureSlaves( if (other == slave) { Tcl_SetResult(interp, "Window can't be managed in itself", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } positionGiven = 1; @@ -3186,6 +3209,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad stickyness value \"", Tcl_GetString(objv[i+1]), "\": must be ", "a string containing n, e, s, and/or w", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } slavePtr->sticky = sticky; @@ -3197,6 +3221,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad ipadx value \"", Tcl_GetString(objv[i+1]), "\": must be ", "positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; @@ -3207,6 +3232,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad ipady value \"", Tcl_GetString(objv[i+1]), "\": must be ", "positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -3229,6 +3255,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad row value \"", Tcl_GetString(objv[i+1]), "\": must be a non-negative integer", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3241,6 +3268,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad rowspan value \"", Tcl_GetString(objv[i+1]), "\": must be a positive integer", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3307,6 +3335,7 @@ ConfigureSlaves( if (Tk_TopWinHierarchy(ancestor)) { Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3320,6 +3349,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), " inside ", Tk_PathName(masterPtr->tkwin), ", would cause management loop.", NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3398,6 +3428,7 @@ ConfigureSlaves( if (masterPtr == NULL) { Tcl_AppendResult(interp, "can't use '^', cant find master", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3451,12 +3482,14 @@ ConfigureSlaves( if (!match) { Tcl_AppendResult(interp, "can't find slave to extend with \"^\".", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } } if (masterPtr == NULL) { Tcl_AppendResult(interp, "can't determine master window", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } SetGridSize(masterPtr); @@ -3497,6 +3530,7 @@ StickyToString( char *result) /* Where to put the result. */ { int count = 0; + if (flags&STICK_NORTH) { result[count++] = 'n'; } diff --git a/generic/tkImage.c b/generic/tkImage.c index 5fa3671..9cc8738 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -273,6 +273,7 @@ Tk_ImageObjCmd( if (typePtr == NULL) { Tcl_AppendResult(interp, "image type \"", arg, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", NULL); return TCL_ERROR; } @@ -306,6 +307,7 @@ Tk_ImageObjCmd( if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { Tcl_AppendResult(interp, "images may not be named the ", "same as the main window", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL); return TCL_ERROR; } } @@ -491,6 +493,7 @@ Tk_ImageObjCmd( alreadyDeleted: Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", NULL); return TCL_ERROR; } @@ -631,6 +634,7 @@ Tk_GetImage( noSuchImage: if (interp) { Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", NULL); } return NULL; } diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 82374cb..a08bb8f 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -279,6 +279,8 @@ ImgBmapConfigureMaster( if (masterPtr->data == NULL) { Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap", TCL_STATIC); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "NO_BITMAP", NULL); return TCL_ERROR; } masterPtr->maskData = TkGetBitmapData(masterPtr->interp, @@ -293,6 +295,8 @@ ImgBmapConfigureMaster( masterPtr->maskData = NULL; Tcl_SetResult(masterPtr->interp, "bitmap and mask have different sizes", TCL_STATIC); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "MASK_SIZE", NULL); return TCL_ERROR; } } @@ -492,6 +496,7 @@ TkGetBitmapData( if ((interp != NULL) && Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't get bitmap data from a file in a", " safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "SAFE", NULL); return NULL; } expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer); @@ -595,6 +600,8 @@ TkGetBitmapData( if (interp != NULL) { Tcl_AppendResult(interp, "format error in bitmap data; ", "looks like it's an obsolete X10 bitmap file", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OBSOLETE", + NULL); } goto errorCleanup; } @@ -637,6 +644,7 @@ TkGetBitmapData( error: if (interp != NULL) { Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "FORMAT", NULL); } errorCleanup: @@ -1154,6 +1162,7 @@ ImgBmapPsImagemask( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unable to generate postscript for bitmaps " "larger than 60000 pixels", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OUTSIZE", NULL); return TCL_ERROR; } diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 4cbf94d..62d364f 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -432,6 +432,8 @@ FileReadGIF( 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); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) { @@ -446,11 +448,13 @@ FileReadGIF( if (!ReadGIFHeader(gifConfPtr, chan, &fileWidth, &fileHeight)) { Tcl_AppendResult(interp, "couldn't read GIF header from file \"", fileName, "\"", NULL); + 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_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BOGUS_SIZE", NULL); return TCL_ERROR; } @@ -466,6 +470,8 @@ 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); return TCL_ERROR; } } @@ -503,12 +509,15 @@ FileReadGIF( Tcl_AppendResult(interp, "premature end of image data for this index", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", + NULL); goto error; } switch (buf[0]) { case GIF_TERMINATOR: Tcl_AppendResult(interp, "no image data for this index", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL); goto error; case GIF_EXTENSION: @@ -520,12 +529,16 @@ FileReadGIF( Tcl_SetResult(interp, "error reading extension function code in GIF image", TCL_STATIC); + 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_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } continue; @@ -534,6 +547,8 @@ FileReadGIF( Tcl_SetResult(interp, "couldn't read left/top/width/height in GIF image", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "DIMENSIONS", + NULL); goto error; } break; @@ -562,6 +577,8 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", + "COLOR_MAP", NULL); goto error; } } @@ -609,6 +626,7 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); goto error; } } @@ -1018,6 +1036,7 @@ ReadImage( if (initialCodeSize > MAX_LWZ_BITS) { Tcl_SetResult(interp, "malformed image", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "MALFORMED", NULL); return TCL_ERROR; } @@ -1690,6 +1709,7 @@ CommonWriteGIF( SaveMap(&state, blockPtr); if (state.num >= MAXCOLORMAPSIZE) { Tcl_AppendResult(interp, "too many colors", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLORFUL", NULL); return TCL_ERROR; } if (state.num<2) { diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 8d6721e..96a17bd 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -335,6 +335,7 @@ 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_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL); if (objPtr) { Tcl_DecrRefCount(objPtr); } @@ -516,6 +517,7 @@ ReadBase64( if (destSz) { Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -558,6 +560,7 @@ ReadByteArray( if (pngPtr->strDataLen < destSz) { Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -625,7 +628,8 @@ ReadData( if (blockSz < 0) { /* TODO: failure info... */ - Tcl_SetResult(interp, "Channel read failed", TCL_STATIC); + Tcl_AppendResult(interp, "channel read failed: ", + Tcl_PosixError(interp), NULL); return TCL_ERROR; } @@ -647,7 +651,8 @@ ReadData( */ if (destSz && Tcl_Eof(pngPtr->channel)) { - Tcl_SetResult(interp, "Unexpected end of file ", TCL_STATIC); + Tcl_SetResult(interp, "unexpected end of file", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EOF", NULL); return TCL_ERROR; } } @@ -733,6 +738,7 @@ CheckCRC( if (calculated != chunked) { Tcl_SetResult(interp, "CRC check failed", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "CRC", NULL); return TCL_ERROR; } @@ -882,8 +888,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 " + Tcl_SetResult(interp, "chunk size is out of supported range " "on this architecture", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "OUTSIZE", NULL); return TCL_ERROR; } @@ -968,8 +975,10 @@ ReadChunkHeader( if (!(chunkType & PNG_CF_ANCILLARY)) { Tcl_SetResult(interp, - "Encountered an unsupported criticial chunk type", + "encountered an unsupported criticial chunk type", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "UNSUPPORTED_CRITICAL", NULL); return TCL_ERROR; } @@ -980,7 +989,9 @@ 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_SetResult(interp, "invalid chunk type", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "INVALID_CHUNK", NULL); return TCL_ERROR; } } @@ -1083,13 +1094,15 @@ CheckColor( break; default: - Tcl_SetResult(interp, "Unknown Color Type field", TCL_STATIC); + Tcl_SetResult(interp, "unknown color type field", TCL_STATIC); + 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_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; } @@ -1118,8 +1131,9 @@ CheckColor( if (pngPtr->block.width > INT_MAX / pngPtr->block.pixelSize) { Tcl_SetResult(interp, - "Image pitch is out of supported range on this architecture", + "image pitch is out of supported range on this architecture", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PITCH", NULL); return TCL_ERROR; } @@ -1131,8 +1145,9 @@ CheckColor( */ if (pngPtr->block.height > INT_MAX / pngPtr->block.pitch) { - Tcl_SetResult(interp, "Image total size is out of supported range " + Tcl_SetResult(interp, "image total size is out of supported range " "on this architecture", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "SIZE", NULL); return TCL_ERROR; } @@ -1161,6 +1176,7 @@ CheckColor( default: Tcl_SetResult(interp, "internal error - unknown color type", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } @@ -1240,8 +1256,9 @@ ReadIHDR( } if (mismatch) { - Tcl_SetResult(interp, "Data stream does not have a PNG signature", + Tcl_SetResult(interp, "data stream does not have a PNG signature", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_SIG", NULL); return TCL_ERROR; } @@ -1257,12 +1274,14 @@ ReadIHDR( */ if (chunkType != CHUNK_IHDR) { - Tcl_SetResult(interp, "Expected IHDR chunk type", TCL_STATIC); + Tcl_SetResult(interp, "expected IHDR chunk type", TCL_STATIC); + 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_SetResult(interp, "invalid IHDR chunk size", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IHDR", NULL); return TCL_ERROR; } @@ -1282,8 +1301,9 @@ ReadIHDR( if (!width || !height || (width > INT_MAX) || (height > INT_MAX)) { Tcl_SetResult(interp, - "Image dimensions are invalid or beyond architecture limits", + "image dimensions are invalid or beyond architecture limits", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DIMENSIONS", NULL); return TCL_ERROR; } @@ -1326,7 +1346,8 @@ ReadIHDR( } if (PNG_COMPRESS_DEFLATE != pngPtr->compression) { - Tcl_SetResult(interp, "Unknown compression method", TCL_STATIC); + Tcl_SetResult(interp, "unknown compression method", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_COMPRESS", NULL); return TCL_ERROR; } @@ -1340,7 +1361,8 @@ ReadIHDR( } if (PNG_FILTMETH_STANDARD != pngPtr->filter) { - Tcl_SetResult(interp, "Unknown filter method", TCL_STATIC); + Tcl_SetResult(interp, "unknown filter method", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -1354,7 +1376,8 @@ ReadIHDR( break; default: - Tcl_SetResult(interp, "Unknown interlace method", TCL_STATIC); + Tcl_SetResult(interp, "unknown interlace method", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_INTERLACE", NULL); return TCL_ERROR; } @@ -1399,6 +1422,8 @@ ReadPLTE( case PNG_COLOR_GRAYALPHA: Tcl_SetResult(interp, "PLTE chunk type forbidden for grayscale", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PLTE_UNEXPECTED", + NULL); return TCL_ERROR; default: @@ -1412,7 +1437,8 @@ ReadPLTE( */ if (!chunkSz || (chunkSz > PNG_PLTE_MAXSZ) || (chunkSz % 3)) { - Tcl_SetResult(interp, "Invalid palette chunk size", TCL_STATIC); + Tcl_SetResult(interp, "invalid palette chunk size", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PLTE", NULL); return TCL_ERROR; } @@ -1477,6 +1503,7 @@ ReadTRNS( Tcl_SetResult(interp, "tRNS chunk not allowed color types with a full alpha channel", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_TRNS", NULL); return TCL_ERROR; } @@ -1486,7 +1513,8 @@ ReadTRNS( */ if (chunkSz > PNG_TRNS_MAXSZ) { - Tcl_SetResult(interp, "Invalid tRNS chunk size", TCL_STATIC); + Tcl_SetResult(interp, "invalid tRNS chunk size", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1516,8 +1544,9 @@ ReadTRNS( if (chunkSz > pngPtr->paletteLen) { Tcl_SetResult(interp, - "Size of tRNS chunk is too large for the palette", + "size of tRNS chunk is too large for the palette", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TRNS_SIZE", NULL); return TCL_ERROR; } @@ -1534,8 +1563,9 @@ ReadTRNS( if (chunkSz != 2) { Tcl_SetResult(interp, - "Invalid tRNS chunk size - must 2 bytes for grayscale", + "invalid tRNS chunk size - must 2 bytes for grayscale", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1560,8 +1590,9 @@ ReadTRNS( if (chunkSz != 6) { Tcl_SetResult(interp, - "Invalid tRNS chunk size - must 6 bytes for RGB", + "invalid tRNS chunk size - must 6 bytes for RGB", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1742,7 +1773,8 @@ UnfilterLine( } break; default: - Tcl_SetResult(interp, "Invalid filter type", TCL_STATIC); + Tcl_SetResult(interp, "invalid filter type", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -2049,8 +2081,10 @@ ReadIDAT( */ if (Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_SetResult(interp, "Extra data after end of zlib stream", + Tcl_SetResult(interp, "extra data after end of zlib stream", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); return TCL_ERROR; } @@ -2090,8 +2124,10 @@ ReadIDAT( if (len2 == pngPtr->phaseSize) { if (pngPtr->phase > 7) { Tcl_SetResult(interp, - "Extra data after final scan line of final phase", + "extra data after final scan line of final phase", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); return TCL_ERROR; } @@ -2136,6 +2172,7 @@ ReadIDAT( if (chunkSz != 0) { Tcl_AppendResult(interp, "compressed data after stream finalize in PNG data", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2274,6 +2311,8 @@ ParseFormat( Tcl_SetResult(interp, "-alpha value must be between 0.0 and 1.0", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_ALPHA", + NULL); return TCL_ERROR; } break; @@ -2365,6 +2404,7 @@ DecodePNG( } else if (PNG_COLOR_PLTE == pngPtr->colorType) { Tcl_SetResult(interp, "PLTE chunk required for indexed color", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_PLTE", NULL); return TCL_ERROR; } @@ -2400,8 +2440,9 @@ DecodePNG( */ if (CHUNK_IDAT != chunkType) { - Tcl_SetResult(interp, "At least one IDAT chunk is required", + Tcl_SetResult(interp, "at least one IDAT chunk is required", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_IDAT", NULL); return TCL_ERROR; } @@ -2423,8 +2464,9 @@ DecodePNG( if (pngPtr->block.width > ((INT_MAX - 1) / (pngPtr->numChannels * 2))) { Tcl_SetResult(interp, - "Line size is out of supported range on this architecture", + "line size is out of supported range on this architecture", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "LINE_SIZE", NULL); return TCL_ERROR; } @@ -2449,7 +2491,8 @@ DecodePNG( pngPtr->block.pixelPtr = attemptckalloc(pngPtr->blockLen); if (!pngPtr->block.pixelPtr) { - Tcl_SetResult(interp, "Memory allocation failed", TCL_STATIC); + Tcl_SetResult(interp, "memory allocation failed", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } @@ -2500,6 +2543,7 @@ DecodePNG( if (!Tcl_ZlibStreamEof(pngPtr->stream)) { Tcl_AppendResult(interp, "unfinalized data stream in PNG data", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2525,6 +2569,7 @@ DecodePNG( if (chunkSz) { Tcl_SetResult(interp, "IEND chunk contents must be empty", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } @@ -2543,7 +2588,8 @@ DecodePNG( #if 0 if (ReadData(interp, pngPtr, &c, 1, NULL) != TCL_ERROR) { - Tcl_SetResult(interp, "Extra data following IEND chunk", TCL_STATIC); + Tcl_SetResult(interp, "extra data following IEND chunk", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } #endif @@ -2796,23 +2842,24 @@ WriteData( if (objSz > INT_MAX - srcSz) { Tcl_SetResult(interp, - "Image too large to store completely in byte array", + "image too large to store completely in byte array", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } destPtr = Tcl_SetByteArrayLength(pngPtr->objDataPtr, objSz + srcSz); if (!destPtr) { - Tcl_SetResult(interp, "Memory allocation failed", TCL_STATIC); + Tcl_SetResult(interp, "memory allocation failed", TCL_STATIC); + 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) { - /* TODO: reason */ - - Tcl_SetResult(interp, "Write to channel failed", TCL_STATIC); + Tcl_AppendResult(interp, "write to channel failed: ", + Tcl_PosixError(interp), NULL); return TCL_ERROR; } @@ -3128,6 +3175,7 @@ WriteIDAT( if (Tcl_ZlibStreamPut(pngPtr->stream, pngPtr->thisLineObj, flush) != TCL_OK) { Tcl_SetResult(interp, "deflate() returned error", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DEFLATE", NULL); return TCL_ERROR; } @@ -3301,8 +3349,9 @@ 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_SetResult(interp, "image is too large to encode pixel data", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c index 527efa2..0378d16 100644 --- a/generic/tkImgPPM.c +++ b/generic/tkImgPPM.c @@ -149,11 +149,13 @@ FileReadPPM( if (type == 0) { Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"", fileName, "\"", NULL); + 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_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { @@ -162,6 +164,7 @@ FileReadPPM( sprintf(buffer, "%d", maxIntensity); Tcl_AppendResult(interp, "PPM image file \"", fileName, "\" has bad maximum intensity value ", buffer, NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -484,11 +487,13 @@ StringReadPPM( if (type == 0) { Tcl_AppendResult(interp, "couldn't read raw PPM header from string", NULL); + 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_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { @@ -498,6 +503,7 @@ StringReadPPM( Tcl_AppendResult(interp, "PPM image data has bad maximum intensity value ", buffer, NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -539,6 +545,7 @@ StringReadPPM( if (block.pitch*height > dataSize) { Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } block.pixelPtr = dataBuffer + srcX * block.pixelSize; @@ -573,6 +580,7 @@ StringReadPPM( if (dataSize < nBytes) { ckfree(pixelPtr); Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } for (p=pixelPtr,count=nBytes ; count>0 ; count--,p++,dataBuffer++) { diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 5b172f1..d1e8524 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -565,6 +565,7 @@ ImgPhotoCmd( Tcl_AppendResult(interp, "image \"", Tcl_GetString(options.name), "\" doesn't", " exist or is not a photo image", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO", NULL); return TCL_ERROR; } Tk_PhotoGetImage(srcHandle, &block); @@ -573,6 +574,7 @@ ImgPhotoCmd( || (options.fromY2 > block.height)) { Tcl_AppendResult(interp, "coordinates for -from option extend ", "outside source image", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -626,6 +628,7 @@ ImgPhotoCmd( options.toY2) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -674,6 +677,7 @@ ImgPhotoCmd( || (options.fromY2 > masterPtr->height)) { Tcl_AppendResult(interp, "coordinates for -from option extend ", "outside image", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -722,6 +726,8 @@ ImgPhotoCmd( Tcl_AppendResult(interp, "image string format \"", Tcl_GetString(options.format), "\" is ", (matched ? "not supported" : "unknown"), NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + NULL); return TCL_ERROR; } } else { @@ -770,7 +776,7 @@ ImgPhotoCmd( * photo get command - first parse and check parameters. */ - char string[TCL_INTEGER_SPACE * 3]; + Tcl_Obj *channels[3]; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "x y"); @@ -784,6 +790,7 @@ ImgPhotoCmd( || (y < 0) || (y >= masterPtr->height)) { Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ", "coordinates out of range", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -792,9 +799,10 @@ ImgPhotoCmd( */ pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; - sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1], - pixelPtr[2]); - Tcl_AppendResult(interp, string, NULL); + channels[0] = Tcl_NewIntObj(pixelPtr[0]); + channels[1] = Tcl_NewIntObj(pixelPtr[1]); + channels[2] = Tcl_NewIntObj(pixelPtr[2]); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels)); return TCL_OK; } @@ -878,6 +886,8 @@ ImgPhotoCmd( } else if (listObjc != dataWidth) { Tcl_AppendResult(interp, "all elements of color list must", " have the same number of elements", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "NON_RECTANGULAR", + NULL); break; } @@ -922,6 +932,7 @@ ImgPhotoCmd( colorString, &color)) { Tcl_AppendResult(interp, "can't parse color \"", colorString, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); break; } *pixelPtr++ = color.red >> 8; @@ -994,6 +1005,7 @@ ImgPhotoCmd( if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't get image from a file in a", " safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "SAFE", NULL); return TCL_ERROR; } @@ -1033,6 +1045,7 @@ ImgPhotoCmd( || (options.fromY2 > imageHeight)) { Tcl_AppendResult(interp, "coordinates for -from option extend ", "outside source image", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1053,6 +1066,7 @@ ImgPhotoCmd( options.toY + height) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -1145,6 +1159,7 @@ ImgPhotoCmd( || (y < 0) || (y >= masterPtr->height)) { Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " transparency get: coordinates out of range", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -1182,6 +1197,7 @@ ImgPhotoCmd( || (y < 0) || (y >= masterPtr->height)) { Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " transparency set: coordinates out of range", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "COORDINATES", NULL); return TCL_ERROR; } @@ -1246,6 +1262,7 @@ ImgPhotoCmd( if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't write image to a file in a", " safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "SAFE", NULL); return TCL_ERROR; } @@ -1272,6 +1289,7 @@ ImgPhotoCmd( || (options.fromY2 > masterPtr->height)) { Tcl_AppendResult(interp, "coordinates for -from option extend ", "outside image", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -1343,14 +1361,12 @@ ImgPhotoCmd( } else if (!matched) { Tcl_AppendResult(interp, "image file format \"", fmtString, "\" is unknown", NULL); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - fmtString, NULL); } else { Tcl_AppendResult(interp, "image file format \"", fmtString, "\" has no file writing capability", NULL); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - fmtString, NULL); } + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + fmtString, NULL); return TCL_ERROR; } @@ -1502,6 +1518,7 @@ ParseSubcommandOptions( } bit <<= 1; } + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_OPTION", NULL); return TCL_ERROR; } @@ -1525,6 +1542,8 @@ ParseSubcommandOptions( } else { Tcl_AppendResult(interp, "the \"-background\" option ", "requires a value", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if (bit == OPT_FORMAT) { @@ -1539,6 +1558,8 @@ ParseSubcommandOptions( } else { Tcl_AppendResult(interp, "the \"-format\" option ", "requires a value", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if (bit == OPT_COMPOSITE) { @@ -1567,6 +1588,8 @@ ParseSubcommandOptions( } else { Tcl_AppendResult(interp, "the \"-compositingrule\" option ", "requires a value", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { @@ -1594,6 +1617,8 @@ ParseSubcommandOptions( Tcl_AppendResult(interp, "the \"", option, "\" option ", "requires one ", maxValues == 2? "or two": "to four", " integer values", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } *optIndexPtr = (index += numValues); @@ -1620,6 +1645,7 @@ ParseSubcommandOptions( && ((values[2] < 0) || (values[3] < 0)))) { Tcl_AppendResult(interp, "value(s) for the -from", " option must be non-negative", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } if (numValues <= 2) { @@ -1643,6 +1669,7 @@ ParseSubcommandOptions( && ((values[2] < 0) || (values[3] < 0)))) { Tcl_AppendResult(interp, "value(s) for the -to", " option must be non-negative", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_TO", NULL); return TCL_ERROR; } if (numValues <= 2) { @@ -1661,6 +1688,7 @@ ParseSubcommandOptions( if ((values[0] <= 0) || (values[1] <= 0)) { Tcl_AppendResult(interp, "value(s) for the -zoom", " option must be positive", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_ZOOM", NULL); return TCL_ERROR; } optPtr->zoomX = values[0]; @@ -1732,6 +1760,8 @@ ImgPhotoConfigureMaster( ckfree(args); Tcl_AppendResult(interp, "value for \"-data\" missing", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } else if ((args[j][1] == 'f') && @@ -1743,6 +1773,8 @@ ImgPhotoConfigureMaster( ckfree(args); Tcl_AppendResult(interp, "value for \"-format\" missing", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", + NULL); return TCL_ERROR; } } @@ -1834,6 +1866,7 @@ ImgPhotoConfigureMaster( masterPtr->height) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -1853,6 +1886,7 @@ ImgPhotoConfigureMaster( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't get image from a file in a safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "SAFE", NULL); goto errorExit; } @@ -1878,6 +1912,7 @@ ImgPhotoConfigureMaster( Tcl_Close(NULL, chan); Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -1908,6 +1943,7 @@ ImgPhotoConfigureMaster( if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -2353,6 +2389,8 @@ MatchFileFormat( if (formatPtr->fileMatchProc == NULL) { Tcl_AppendResult(interp, "-file option isn't supported for ", formatString, " images", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_FILE_FORMAT", + NULL); return TCL_ERROR; } } @@ -2384,6 +2422,8 @@ MatchFileFormat( if (formatPtr->fileMatchProc == NULL) { Tcl_AppendResult(interp, "-file option isn't supported", " for ", formatString, " images", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_FILE_FORMAT", + NULL); return TCL_ERROR; } } @@ -2407,10 +2447,13 @@ MatchFileFormat( if ((formatObj != NULL) && !matched) { Tcl_AppendResult(interp, "image file format \"", formatString, "\" is not supported", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", NULL); } else { Tcl_AppendResult(interp, "couldn't recognize data in image file \"", fileName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "UNRECOGNIZED_DATA", + NULL); } return TCL_ERROR; } @@ -2482,6 +2525,8 @@ MatchStringFormat( if (formatPtr->stringMatchProc == NULL) { Tcl_AppendResult(interp, "-data option isn't supported for ", formatString, " images", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_DATA_FORMAT", + NULL); return TCL_ERROR; } } @@ -2506,6 +2551,8 @@ MatchStringFormat( if (formatPtr->stringMatchProc == NULL) { Tcl_AppendResult(interp, "-data option isn't supported", " for ", formatString, " images", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "NOT_DATA_FORMAT", + NULL); return TCL_ERROR; } } @@ -2523,8 +2570,11 @@ MatchStringFormat( if ((formatObj != NULL) && !matched) { Tcl_AppendResult(interp, "image format \"", formatString, "\" is not supported", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", NULL); } else { Tcl_AppendResult(interp, "couldn't recognize image data", NULL); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "UNRECOGNIZED_DATA", + NULL); } return TCL_ERROR; } @@ -2643,6 +2693,7 @@ Tk_PhotoPutBlock( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3039,6 +3090,7 @@ Tk_PhotoPutZoomedBlock( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3437,6 +3489,7 @@ Tk_PhotoExpand( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3511,6 +3564,7 @@ Tk_PhotoSetSize( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 7faa44b..e8817af 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -168,6 +168,13 @@ typedef struct { } Listbox; /* + * How to encode the keys for the hash tables used to store what items are + * selected and what the attributes are. + */ + +#define KEY(i) ((char *) INT2PTR(i)) + +/* * ItemAttr structures are used to store item configuration information for * the items in a listbox */ @@ -437,8 +444,8 @@ static void MigrateHashEntries(Tcl_HashTable *table, static const Tk_ClassProcs listboxClass = { sizeof(Tk_ClassProcs), /* size */ ListboxWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -480,8 +487,7 @@ Tk_ListboxObjCmd( return TCL_ERROR; } - optionTables = (ListboxOptionTables *) - Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); + optionTables = Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); if (optionTables == NULL) { /* * We haven't created the option tables for this widget class yet. Do @@ -515,7 +521,7 @@ Tk_ListboxObjCmd( */ listPtr = ckalloc(sizeof(Listbox)); - memset(listPtr, 0, (sizeof(Listbox))); + memset(listPtr, 0, sizeof(Listbox)); listPtr->tkwin = tkwin; listPtr->display = Tk_Display(tkwin); @@ -597,6 +603,7 @@ ListboxWidgetObjCmd( register Listbox *listPtr = clientData; int cmdIndex, index; int result = TCL_OK; + Tcl_Obj *objPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); @@ -661,9 +668,7 @@ ListboxWidgetObjCmd( result = ListboxBboxSubCmd(interp, listPtr, index); break; - case COMMAND_CGET: { - Tcl_Obj *objPtr; - + case COMMAND_CGET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); result = TCL_ERROR; @@ -679,11 +684,8 @@ ListboxWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); result = TCL_OK; break; - } - - case COMMAND_CONFIGURE: { - Tcl_Obj *objPtr; + case COMMAND_CONFIGURE: if (objc <= 3) { objPtr = Tk_GetOptionInfo(interp, (char *) listPtr, listPtr->optionTable, @@ -698,10 +700,8 @@ ListboxWidgetObjCmd( result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0); } break; - } case COMMAND_CURSELECTION: { - char indexStringRep[TCL_INTEGER_SPACE]; int i; if (objc != 2) { @@ -718,12 +718,13 @@ ListboxWidgetObjCmd( * selected. */ + objPtr = Tcl_NewObj(); for (i = 0; i < listPtr->nElements; i++) { - if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { - sprintf(indexStringRep, "%d", i); - Tcl_AppendElement(interp, indexStringRep); + if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) { + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(i)); } } + Tcl_SetObjResult(interp, objPtr); result = TCL_OK; break; } @@ -857,7 +858,6 @@ ListboxWidgetObjCmd( break; case COMMAND_ITEMCGET: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc != 4) { @@ -892,7 +892,6 @@ ListboxWidgetObjCmd( } case COMMAND_ITEMCONFIGURE: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc < 3) { @@ -922,10 +921,9 @@ ListboxWidgetObjCmd( if (objPtr == NULL) { result = TCL_ERROR; break; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } else { result = ConfigureListboxItem(interp, listPtr, attrPtr, objc-3, objv+3, index); @@ -1007,7 +1005,7 @@ ListboxWidgetObjCmd( } diff = listPtr->topIndex - index; if (diff > 0) { - if (diff <= (listPtr->fullLines/3)) { + if (diff <= listPtr->fullLines / 3) { ChangeListboxView(listPtr, index); } else { ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2); @@ -1015,7 +1013,7 @@ ListboxWidgetObjCmd( } else { diff = index - (listPtr->topIndex + listPtr->fullLines - 1); if (diff > 0) { - if (diff <= (listPtr->fullLines/3)) { + if (diff <= listPtr->fullLines / 3) { ChangeListboxView(listPtr, listPtr->topIndex + diff); } else { ChangeListboxView(listPtr, index-(listPtr->fullLines-1)/2); @@ -1090,7 +1088,7 @@ ListboxBboxSubCmd( */ if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) { - Tcl_Obj *el; + Tcl_Obj *el, *results[4]; const char *stringRep; int pixelWidth, stringLen, x, y, result; Tk_FontMetrics fm; @@ -1111,8 +1109,11 @@ ListboxBboxSubCmd( x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + listPtr->selBorderWidth; - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x, y, pixelWidth, fm.linespace)); + results[0] = Tcl_NewIntObj(x); + results[1] = Tcl_NewIntObj(y); + results[2] = Tcl_NewIntObj(pixelWidth); + results[3] = Tcl_NewIntObj(fm.linespace); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1197,9 +1198,8 @@ ListboxSelectionSubCmd( Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((Tcl_FindHashEntry(listPtr->selection, - (char *) INT2PTR(first)) != NULL))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + Tcl_FindHashEntry(listPtr->selection, KEY(first)) != NULL)); result = TCL_OK; break; case SELECTION_SET: @@ -1232,43 +1232,45 @@ ListboxXviewSubCmd( int objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { - - int index, count, type, windowWidth, windowUnits; + int index, count, windowWidth, windowUnits; int offset = 0; /* Initialized to stop gcc warnings. */ double fraction; windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset + listPtr->selBorderWidth); if (objc == 2) { + Tcl_Obj *results[2]; + if (listPtr->maxWidth == 0) { - Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); + results[0] = Tcl_NewDoubleObj(0.0); + results[1] = Tcl_NewDoubleObj(1.0); } else { double fraction2; - fraction = listPtr->xOffset/((double) listPtr->maxWidth); + fraction = listPtr->xOffset / (double) listPtr->maxWidth; fraction2 = (listPtr->xOffset + windowWidth) - / ((double) listPtr->maxWidth); + / (double) listPtr->maxWidth; if (fraction2 > 1.0) { fraction2 = 1.0; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%g %g", - fraction, fraction2)); + results[0] = Tcl_NewDoubleObj(fraction); + results[1] = Tcl_NewDoubleObj(fraction2); } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit); } else { - type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); - switch (type) { + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_ERROR: return TCL_ERROR; case TK_SCROLL_MOVETO: offset = (int) (fraction*listPtr->maxWidth + 0.5); break; case TK_SCROLL_PAGES: - windowUnits = windowWidth/listPtr->xScrollUnit; + windowUnits = windowWidth / listPtr->xScrollUnit; if (windowUnits > 2) { offset = listPtr->xOffset + count*listPtr->xScrollUnit*(windowUnits-2); @@ -1308,12 +1310,15 @@ ListboxYviewSubCmd( int objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { - int index, count, type; + int index, count; double fraction; if (objc == 2) { + Tcl_Obj *results[2]; + if (listPtr->nElements == 0) { - Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); + results[0] = Tcl_NewDoubleObj(0.0); + results[1] = Tcl_NewDoubleObj(1.0); } else { double fraction2, numEls = (double) listPtr->nElements; @@ -1322,17 +1327,17 @@ ListboxYviewSubCmd( if (fraction2 > 1.0) { fraction2 = 1.0; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%g %g", - fraction, fraction2)); + results[0] = Tcl_NewDoubleObj(fraction); + results[1] = Tcl_NewDoubleObj(fraction2); } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxView(listPtr, index); } else { - type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); - switch (type) { + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_MOVETO: index = (int) (listPtr->nElements*fraction + 0.5); break; @@ -1383,8 +1388,7 @@ ListboxGetItemAttributes( Tcl_HashEntry *entry; ItemAttr *attrs; - entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, - (char *) INT2PTR(index), &isNew); + entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, KEY(index), &isNew); if (isNew) { attrs = ckalloc(sizeof(ItemAttr)); attrs->border = NULL; @@ -1910,7 +1914,7 @@ DisplayListbox( * special foreground/background colors. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); /* * If the listbox is enabled, items may be drawn differently; they may @@ -1919,7 +1923,7 @@ DisplayListbox( */ if (listPtr->state & STATE_NORMAL) { - if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { + if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) { /* * Selected items are drawn differently. */ @@ -2001,8 +2005,7 @@ DisplayListbox( } /* Draw bottom bevel */ if (i + 1 == listPtr->nElements || - Tcl_FindHashEntry(listPtr->selection, - (char *) INT2PTR(i + 1)) == NULL ) { + !Tcl_FindHashEntry(listPtr->selection, KEY(i + 1))) { Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left, y + listPtr->lineHeight - listPtr->selBorderWidth, width+left+right, listPtr->selBorderWidth, 0, 0, 0, @@ -2238,7 +2241,7 @@ ListboxComputeGeometry( width = listPtr->width; if (width <= 0) { width = (listPtr->maxWidth + listPtr->xScrollUnit - 1) - /listPtr->xScrollUnit; + / listPtr->xScrollUnit; if (width < 1) { width = 1; } @@ -2439,13 +2442,13 @@ ListboxDeleteSubCmd( * Remove selection information. */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); @@ -2903,7 +2906,7 @@ ListboxScanTo( */ newTopIndex = listPtr->scanMarkYIndex - - (10*(y - listPtr->scanMarkY))/listPtr->lineHeight; + - (10*(y - listPtr->scanMarkY)) / listPtr->lineHeight; if (newTopIndex > maxIndex) { newTopIndex = listPtr->scanMarkYIndex = maxIndex; listPtr->scanMarkY = y; @@ -2955,7 +2958,7 @@ NearestListboxElement( { int index; - index = (y - listPtr->inset)/listPtr->lineHeight; + index = (y - listPtr->inset) / listPtr->lineHeight; if (index >= (listPtr->fullLines + listPtr->partialLine)) { index = listPtr->fullLines + listPtr->partialLine - 1; } @@ -3026,7 +3029,7 @@ ListboxSelect( */ for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (!select) { Tcl_DeleteHashEntry(entry); @@ -3037,8 +3040,8 @@ ListboxSelect( } } else { if (select) { - entry = Tcl_CreateHashEntry(listPtr->selection, - (char *) INT2PTR(i), &isNew); + entry = Tcl_CreateHashEntry(listPtr->selection, KEY(i), + &isNew); Tcl_SetHashValue(entry, NULL); listPtr->numSelected++; if (firstRedisplay < 0) { @@ -3052,7 +3055,7 @@ ListboxSelect( EventuallyRedrawRange(listPtr, first, last); } if ((oldCount == 0) && (listPtr->numSelected > 0) - && (listPtr->exportSelection)) { + && listPtr->exportSelection) { Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, listPtr); } @@ -3109,7 +3112,7 @@ ListboxFetchSelection( needNewline = 0; Tcl_DStringInit(&selection); for (i = 0; i < listPtr->nElements; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (needNewline) { Tcl_DStringAppend(&selection, "\n", 1); @@ -3250,9 +3253,9 @@ ListboxUpdateVScrollbar( first = 0.0; last = 1.0; } else { - first = listPtr->topIndex / ((double) listPtr->nElements); + first = listPtr->topIndex / (double) listPtr->nElements; last = (listPtr->topIndex + listPtr->fullLines) - / ((double) listPtr->nElements); + / (double) listPtr->nElements; if (last > 1.0) { last = 1.0; } @@ -3309,15 +3312,15 @@ ListboxUpdateHScrollbar( if (listPtr->xScrollCmd == NULL) { return; } - windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset - + listPtr->selBorderWidth); + + windowWidth = Tk_Width(listPtr->tkwin) + - 2*(listPtr->inset + listPtr->selBorderWidth); if (listPtr->maxWidth == 0) { first = 0; last = 1.0; } else { - first = listPtr->xOffset/((double) listPtr->maxWidth); - last = (listPtr->xOffset + windowWidth) - /((double) listPtr->maxWidth); + first = listPtr->xOffset / (double) listPtr->maxWidth; + last = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth; if (last > 1.0) { last = 1.0; } @@ -3429,7 +3432,7 @@ ListboxListVarProc( * Clean up selection. */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); @@ -3439,8 +3442,7 @@ ListboxListVarProc( * Clean up attributes. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, - (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); @@ -3514,23 +3516,21 @@ MigrateHashEntries( if (offset > 0) { for (i = last; i >= first; i--) { - entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, - (char *) INT2PTR(i + offset), &isNew); + entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } } else { for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, - (char *) INT2PTR(i + offset), &isNew); + entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } diff --git a/generic/tkObj.c b/generic/tkObj.c index 8877d42..29a235a 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -506,6 +506,7 @@ SetPixelFromAny( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad screen distance \"%.50s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); } return TCL_ERROR; } @@ -736,6 +737,7 @@ SetMMFromAny( error: Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DISTANCE", NULL); return TCL_ERROR; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { @@ -1036,6 +1038,7 @@ TkParsePadAmount( Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(specObj), "\": must be positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } secondInt = firstInt; @@ -1053,6 +1056,7 @@ TkParsePadAmount( if (objc != 1 && objc != 2) { Tcl_AppendResult(interp, "wrong number of parts to pad specification", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "PARTS", NULL); return TCL_ERROR; } @@ -1065,6 +1069,7 @@ TkParsePadAmount( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), "\": must be positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1081,6 +1086,7 @@ TkParsePadAmount( Tcl_AppendResult(interp, "bad 2nd pad value \"", Tcl_GetString(objv[1]), "\": must be positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index 1ab6ab6..49d505e 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -96,6 +96,7 @@ Tk_ConfigureWidget( */ Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return TCL_ERROR; } @@ -136,6 +137,7 @@ Tk_ConfigureWidget( if (argc < 2) { Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); return TCL_ERROR; } if (flags & TK_CONFIG_OBJS) { @@ -144,11 +146,8 @@ Tk_ConfigureWidget( arg = argv[1]; } if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - specPtr->argvName); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)",specPtr->argvName)); return TCL_ERROR; } if (!(flags & TK_CONFIG_ARGV_ONLY)) { @@ -181,12 +180,10 @@ Tk_ConfigureWidget( if (value != NULL) { if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != TCL_OK) { - char msg[200]; - - sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", - "database entry for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (%s \"%.50s\" in widget \"%.50s\")", + "database entry for", specPtr->dbName, + Tk_PathName(tkwin))); return TCL_ERROR; } } else { @@ -199,13 +196,10 @@ Tk_ConfigureWidget( & TK_CONFIG_DONT_SET_DEFAULT)) { if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != TCL_OK) { - char msg[200]; - - sprintf(msg, + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.50s\" in widget \"%.50s\")", - "default value for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); + "default value for", specPtr->dbName, + Tk_PathName(tkwin))); return TCL_ERROR; } } @@ -274,6 +268,7 @@ FindConfigSpec( if (matchPtr != NULL) { Tcl_AppendResult(interp, "ambiguous option \"", argvName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL); return NULL; } matchPtr = specPtr; @@ -281,6 +276,7 @@ FindConfigSpec( if (matchPtr == NULL) { Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL); return NULL; } @@ -296,6 +292,8 @@ FindConfigSpec( if (specPtr->type == TK_CONFIG_END) { Tcl_AppendResult(interp, "couldn't find synonym for option \"", argvName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, + NULL); return NULL; } if ((specPtr->dbName == matchPtr->dbName) @@ -546,14 +544,12 @@ DoConfig( return TCL_ERROR; } break; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad config table: unknown type %d", specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } specPtr++; } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); return TCL_OK; diff --git a/generic/tkOption.c b/generic/tkOption.c index d5c423f..a258bb0 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -541,7 +541,7 @@ Tk_GetOption( winClassId = Tk_GetUid(masqClass); ckfree(masqClass); - winNameId = ((TkWindow *)tkwin)->nameUid; + winNameId = ((TkWindow *) tkwin)->nameUid; levelPtr = &tsdPtr->levels[tsdPtr->curLevel]; @@ -619,11 +619,9 @@ Tk_OptionObjCmd( int index, result; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - static const char *const optionCmds[] = { "add", "clear", "get", "readfile", NULL }; - enum optionVals { OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE }; @@ -663,13 +661,12 @@ Tk_OptionObjCmd( } case OPTION_CLEAR: { - TkMainInfo *mainPtr; + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } - mainPtr = ((TkWindow *) tkwin)->mainPtr; if (mainPtr->optionRootPtr != NULL) { ClearOptionTree(mainPtr->optionRootPtr); mainPtr->optionRootPtr = NULL; @@ -883,6 +880,7 @@ ParsePriority( Tcl_AppendResult(interp, "bad priority level \"", string, "\": must be widgetDefault, startupFile, userDefault, ", "interactive, or a number between 0 and 100", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PRIORITY", NULL); return -1; } } @@ -964,10 +962,9 @@ AddFromString( dst = name = src; while (*src != ':') { if ((*src == '\0') || (*src == '\n')) { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing colon on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing colon on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "COLON", NULL); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -999,10 +996,9 @@ AddFromString( src++; } if (*src == '\0') { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing value on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing value on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "VALUE", NULL); return TCL_ERROR; } @@ -1014,10 +1010,9 @@ AddFromString( dst = value = src; while (*src != '\n') { if (*src == '\0') { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing newline on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing newline on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "NEWLINE", NULL); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -1085,6 +1080,7 @@ ReadOptionFile( if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "can't read options from a file in a", " safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "SAFE", NULL); return TCL_ERROR; } @@ -1309,6 +1305,7 @@ SetupStacks( if (tsdPtr->curLevel >= tsdPtr->numLevels) { StackLevel *newLevels = ckalloc(tsdPtr->numLevels * 2 * sizeof(StackLevel)); + memcpy(newLevels, tsdPtr->levels, tsdPtr->numLevels * sizeof(StackLevel)); ckfree(tsdPtr->levels); diff --git a/generic/tkPack.c b/generic/tkPack.c index b32cc23..3c3b389 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -152,11 +152,12 @@ 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 */ { char buffer[60 + 2*TCL_INTEGER_SPACE]; + if (halfSpace*2 == allSpace) { sprintf(buffer, " -%.10s %d", switchName, halfSpace); } else { @@ -240,6 +241,7 @@ Tk_PackObjCmd( if (prevPtr->masterPtr == NULL) { Tcl_AppendResult(interp, "window \"", argv2, "\" isn't packed", NULL); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } return PackAfter(interp, prevPtr, prevPtr->masterPtr, objc-3, objv+3); @@ -273,6 +275,7 @@ Tk_PackObjCmd( if (packPtr->masterPtr == NULL) { Tcl_AppendResult(interp, "window \"", argv2, "\" isn't packed", NULL); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } masterPtr = packPtr->masterPtr; @@ -295,6 +298,7 @@ Tk_PackObjCmd( if (argv2[0] != '.') { Tcl_AppendResult(interp, "bad argument \"", argv2, "\": must be name of window", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", NULL); return TCL_ERROR; } return ConfigureSlaves(interp, tkwin, objc-2, objv+2); @@ -335,6 +339,7 @@ Tk_PackObjCmd( if (slavePtr->masterPtr == NULL) { Tcl_AppendResult(interp, "window \"", argv2, "\" isn't packed", NULL); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } Tcl_AppendElement(interp, "-in"); @@ -1099,6 +1104,7 @@ PackAfter( Tcl_AppendResult(interp, "wrong # args: window \"", Tcl_GetString(objv[0]), "\" should be followed by options", NULL); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -1122,6 +1128,7 @@ PackAfter( badWindow: Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[0]), " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } @@ -1182,6 +1189,8 @@ PackAfter( Tcl_AppendResult(interp, "wrong # args: \"", curOpt, "\" option must be followed by screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } if (TkParsePadAmount(interp, tkwin, options[index+1], @@ -1209,6 +1218,8 @@ PackAfter( if (optionCount < (index+2)) { Tcl_AppendResult(interp, "wrong # args: \"frame\" ", "option must be followed by anchor point", NULL); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } if (Tk_GetAnchorFromObj(interp, options[index+1], @@ -1220,6 +1231,8 @@ PackAfter( Tcl_AppendResult(interp, "bad option \"", curOpt, "\": should be top, bottom, left, right, expand, ", "fill, fillx, filly, padx, pady, or frame", NULL); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } } @@ -1536,6 +1549,7 @@ ConfigureSlaves( if (Tk_TopWinHierarchy(slave)) { Tcl_AppendResult(interp, "can't pack \"", Tcl_GetString(objv[j]), "\": it's a top-level window", NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetPacker(slave); @@ -1561,6 +1575,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "extra option \"", Tcl_GetString(objv[i]), "\" (option with no value?)", NULL); + Tcl_SetErrorCode(interp, "TK", "PACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", @@ -1581,6 +1596,8 @@ ConfigureSlaves( Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[i+1]), "\" isn't packed", NULL); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", + NULL); return TCL_ERROR; } masterPtr = prevPtr->masterPtr; @@ -1637,6 +1654,7 @@ ConfigureSlaves( } else { Tcl_AppendResult(interp, "bad fill style \"", string, "\": must be none, x, y, or both", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILL", NULL); return TCL_ERROR; } break; @@ -1664,6 +1682,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad ipadx value \"", Tcl_GetString(objv[i+1]), "\": must be positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; @@ -1676,6 +1695,7 @@ ConfigureSlaves( Tcl_AppendResult(interp, "bad ipady value \"", Tcl_GetString(objv[i+1]), "\": must be positive screen distance", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -1754,12 +1774,14 @@ ConfigureSlaves( if (Tk_TopWinHierarchy(ancestor)) { Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), " inside ", Tk_PathName(masterPtr->tkwin), NULL); + 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_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 22072ce..a0d3562 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -621,6 +621,7 @@ ConfigureSlave( if (Tk_TopWinHierarchy(tkwin)) { Tcl_AppendResult(interp, "can't use placer on top-level window \"", Tk_PathName(tkwin), "\"; use wm command instead", NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -681,6 +682,7 @@ ConfigureSlave( Tcl_AppendResult(interp, "can't place ", Tk_PathName(slavePtr->tkwin), " relative to ", Tk_PathName(tkwin), NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } @@ -688,6 +690,7 @@ ConfigureSlave( Tcl_AppendResult(interp, "can't place ", Tk_PathName(slavePtr->tkwin), " relative to itself", NULL); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } if ((slavePtr->masterPtr != NULL) diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index 630737c..c41387c 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -348,10 +348,8 @@ RectOvalCoords( */ if (objc != 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 4, got %d", objc)); return TCL_ERROR; } diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 271243e..b1cdd53 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -55,7 +55,7 @@ TkpSync(Display *display) void TkCreateXEventSource(void) { - TkWinXInit(Tk_GetHINSTANCE()); + TkWinXInit(Tk_GetHINSTANCE()); } # define TkUnixContainerId 0 @@ -105,7 +105,7 @@ TkpPrintWindowId( * the hex representation of a pointer. */ Window window) /* Window to be printed into buffer. */ { - sprintf(buf, "%#08lx", (unsigned long) (window)); + sprintf(buf, "%#08lx", (unsigned long) (window)); } int diff --git a/generic/tkStyle.c b/generic/tkStyle.c index 76291fa..965230e 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -1358,6 +1358,7 @@ Tk_GetStyle( if (interp != NULL) { Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", NULL); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "STYLE", name, NULL); } return (Tk_Style) NULL; } diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 5282708..b0ea2ea 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -96,6 +96,7 @@ TkStateParseProc( Tcl_AppendResult(interp, ",", NULL); } Tcl_AppendResult(interp, " or disabled", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL); *statePtr = TK_STATE_NORMAL; return TCL_ERROR; } @@ -197,6 +198,7 @@ TkOrientParseProc( } Tcl_AppendResult(interp, "bad orientation \"", value, "\": must be vertical or horizontal", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL); *orientPtr = 0; return TCL_ERROR; } @@ -385,6 +387,7 @@ TkOffsetParseProc( Tcl_AppendResult(interp, ", <index>", NULL); } Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL); return TCL_ERROR; } @@ -482,6 +485,7 @@ TkPixelParseProc( if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); return TCL_ERROR; } return result; @@ -646,6 +650,7 @@ Tk_GetScrollInfo( if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " moveto fraction\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { @@ -657,6 +662,7 @@ Tk_GetScrollInfo( if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " scroll number units|pages\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { @@ -672,10 +678,13 @@ Tk_GetScrollInfo( Tcl_AppendResult(interp, "bad argument \"", argv[4], "\": must be units or pages", NULL); + 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_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2], + NULL); return TK_SCROLL_ERROR; } @@ -746,10 +755,12 @@ Tk_GetScrollInfoObj( Tcl_AppendResult(interp, "bad argument \"", arg, "\": must be units or pages", NULL); + 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_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL); return TK_SCROLL_ERROR; } @@ -916,6 +927,7 @@ TkFindStateNum( mPtr = mapPtr; Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, "\": must be ", mPtr->strKey, NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", option, NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, ((mPtr[1].strKey != NULL) ? ", " : ", or "), @@ -972,6 +984,8 @@ TkFindStateNumObj( mPtr = mapPtr; Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), " value \"", key, "\": must be ", mPtr->strKey, NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", Tcl_GetString(optionPtr), + NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, ((mPtr[1].strKey != NULL) ? ", " : ", or "), diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 3602088..b19e78c 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -176,6 +176,7 @@ Tk_GetVisual( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad X identifier for visual: \"", string, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL); return NULL; } template.visualid = visualId; @@ -204,6 +205,7 @@ Tk_GetVisual( if (template.class == -1) { Tcl_AppendResult(interp, "unknown or ambiguous visual name \"", string, "\": class must be ", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUAL", NULL); for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { Tcl_AppendResult(interp, dictPtr->name, ", ", NULL); } @@ -239,6 +241,7 @@ Tk_GetVisual( if (visInfoList == NULL) { Tcl_SetResult(interp, "couldn't find an appropriate visual", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "INAPPROPRIATE", NULL); return NULL; } @@ -405,11 +408,13 @@ Tk_GetColormap( if (Tk_Screen(other) != Tk_Screen(tkwin)) { Tcl_AppendResult(interp, "can't use colormap for ", string, ": not on same screen", NULL); + 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_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", NULL); return None; } colormap = Tk_Colormap(other); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index b04b95f..27fba69 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -103,8 +103,9 @@ static const XSetWindowAttributes defAtts= { typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); typedef struct { - const char *name; /* Name of command. */ - Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based function, or initProc. */ + const char *name; /* Name of command. */ + Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based + * function, or initProc. */ int flags; } TkCmd; @@ -153,7 +154,8 @@ static const TkCmd commands[] = { {"panedwindow", Tk_PanedWindowObjCmd, ISSAFE}, {"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE}, {"scale", Tk_ScaleObjCmd, ISSAFE}, - {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, + NOOBJPROC|PASSMAINWINDOW|ISSAFE}, {"spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"toplevel", Tk_ToplevelObjCmd, 0}, @@ -175,7 +177,8 @@ static const TkCmd commands[] = { {"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE}, {"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE}, {"::tk::scale", Tk_ScaleObjCmd, ISSAFE}, - {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, + NOOBJPROC|PASSMAINWINDOW|ISSAFE}, {"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"::tk::toplevel", Tk_ToplevelObjCmd, 0}, @@ -197,7 +200,7 @@ static const TkCmd commands[] = { * Misc. */ -#if defined(MAC_OSX_TK) +#ifdef MAC_OSX_TK {"::tk::unsupported::MacWindowStyle", TkUnsupported1ObjCmd, PASSMAINWINDOW|ISSAFE}, #endif @@ -290,6 +293,7 @@ TkCloseDisplay( if (dispPtr->errorPtr != NULL) { TkErrorHandler *errorPtr; + for (errorPtr = dispPtr->errorPtr; errorPtr != NULL; errorPtr = dispPtr->errorPtr) { @@ -470,6 +474,7 @@ GetScreen( Tcl_SetResult(interp, "no display name and no $DISPLAY environment variable", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL); return NULL; } length = strlen(screenName); @@ -500,6 +505,7 @@ GetScreen( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't connect to display \"", screenName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECTION", NULL); return NULL; } dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */ @@ -531,10 +537,9 @@ GetScreen( } } if (screenId >= ScreenCount(dispPtr->display)) { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad screen number \"%d\"", screenId); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen number \"%d\"", screenId)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL); return NULL; } *screenPtr = screenId; @@ -774,12 +779,6 @@ NameWindow( } /* - * For non-anonymous windows, set up the window name. - */ - - winPtr->nameUid = Tk_GetUid(name); - - /* * Don't permit names that start with an upper-case letter: this will just * cause confusion with class names in the option database. */ @@ -788,10 +787,17 @@ NameWindow( Tcl_AppendResult(interp, "window name starts with an upper-case letter: \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL); return TCL_ERROR; } /* + * For non-anonymous windows, set up the window name. + */ + + winPtr->nameUid = Tk_GetUid(name); + + /* * To permit names of arbitrary length, must be prepared to malloc a * buffer to hold the new path name. To run fast in the common case where * names are short, use a fixed-size buffer on the stack. @@ -820,6 +826,7 @@ NameWindow( if (!isNew) { Tcl_AppendResult(interp, "window name \"", name, "\" already exists in parent", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL); return TCL_ERROR; } Tcl_SetHashValue(hPtr, winPtr); @@ -964,7 +971,7 @@ TkCreateMainWindow( clientData = NULL; } if (cmdPtr->flags & USEINITPROC) { - ((TkInitProc *)cmdPtr->objProc)(interp, clientData); + ((TkInitProc *) cmdPtr->objProc)(interp, clientData); } else if (cmdPtr->flags & NOOBJPROC) { Tcl_CreateCommand(interp, cmdPtr->name, (Tcl_CmdProc *) cmdPtr->objProc, clientData, NULL); @@ -972,10 +979,8 @@ TkCreateMainWindow( Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, clientData, NULL); } - if (isSafe) { - if (!(cmdPtr->flags & ISSAFE)) { - Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); - } + if (isSafe && !(cmdPtr->flags & ISSAFE)) { + Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); } } @@ -1034,11 +1039,13 @@ Tk_CreateWindow( if (parentPtr->flags & TK_ALREADY_DEAD) { Tcl_AppendResult(interp, "can't create window: parent has been destroyed", NULL); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { Tcl_AppendResult(interp, "can't create window: its parent has -container = yes", NULL); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, @@ -1096,11 +1103,13 @@ Tk_CreateAnonymousWindow( if (parentPtr->flags & TK_ALREADY_DEAD) { Tcl_AppendResult(interp, "can't create window: parent has been destroyed", NULL); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { Tcl_AppendResult(interp, "can't create window: its parent has -container = yes", NULL); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, @@ -1178,6 +1187,7 @@ Tk_CreateWindowFromPath( if (p == NULL) { Tcl_AppendResult(interp, "bad window path name \"", pathName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOWPATH", NULL); return NULL; } numChars = (int) (p-pathName); @@ -1208,11 +1218,13 @@ Tk_CreateWindowFromPath( if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { Tcl_AppendResult(interp, "can't create window: parent has been destroyed", NULL); + 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_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } @@ -1354,8 +1366,8 @@ Tk_DestroyWindow( } while (winPtr->childList != NULL) { - TkWindow *childPtr; - childPtr = winPtr->childList; + TkWindow *childPtr = winPtr->childList; + childPtr->flags |= TK_DONT_DESTROY_WINDOW; Tk_DestroyWindow((Tk_Window) childPtr); if (winPtr->childList == childPtr) { @@ -1382,8 +1394,8 @@ Tk_DestroyWindow( * deleted, in which case TkpGetOtherWindow will return NULL. */ - TkWindow *childPtr; - childPtr = TkpGetOtherWindow(winPtr); + TkWindow *childPtr = TkpGetOtherWindow(winPtr); + if (childPtr != NULL) { childPtr->flags |= TK_DONT_DESTROY_WINDOW; Tk_DestroyWindow((Tk_Window) childPtr); @@ -1751,6 +1763,7 @@ Tk_MakeWindowExist( if ((winPtr2->window != None) && !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) { XWindowChanges changes; + changes.sibling = winPtr2->window; changes.stack_mode = Below; XConfigureWindow(winPtr->display, winPtr->window, @@ -2328,7 +2341,8 @@ Tk_NameToWindow( */ if (interp != NULL) { - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetResult(interp, "NULL main window", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); } return NULL; } @@ -2339,6 +2353,7 @@ Tk_NameToWindow( if (interp != NULL) { Tcl_AppendResult(interp, "bad window path name \"", pathName, "\"", NULL); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOWNAME", NULL); } return NULL; } @@ -2591,9 +2606,8 @@ Tk_RestackWindow( if (winPtr->window != None) { XWindowChanges changes; - unsigned int mask; + unsigned int mask = CWStackMode; - mask = CWStackMode; changes.stack_mode = Above; for (otherPtr = winPtr->nextPtr; otherPtr != NULL; otherPtr = otherPtr->nextPtr) { @@ -2653,6 +2667,7 @@ Tk_MainWindow( } } Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return NULL; } @@ -2840,44 +2855,47 @@ static HMODULE tkcygwindll = NULL; /* * Run Tk_MainEx from libtk8.?.dll * - * This function is only ever called from wish8.4.exe, the cygwin - * port of Tcl. This means that the system encoding is utf-8, - * so we don't have to do any encoding conversions. + * This function is only ever called from wish8.4.exe, the cygwin port of Tcl. + * This means that the system encoding is utf-8, so we don't have to do any + * encoding conversions. */ + int -TkCygwinMainEx(argc, argv, appInitProc, interp) - int argc; /* Number of arguments. */ - char **argv; /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc; /* Application-specific initialization - * procedure to call after most - * initialization but before starting - * to execute commands. */ - Tcl_Interp *interp; +TkCygwinMainEx( + int argc, /* Number of arguments. */ + char **argv, /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc, + /* Application-specific initialization + * procedure to call after most initialization + * but before starting to execute commands. */ + Tcl_Interp *interp) { TCHAR name[MAX_PATH]; int len; - void (*sym)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */ - len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH); - name[len-2] = TEXT('.'); - name[len-1] = name[len-5]; - _tcscpy(name+len, TEXT(".dll")); - memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR)); - - tkcygwindll = LoadLibrary(name); - if (!tkcygwindll) { - /* dll is not present */ - return 0; - } - sym = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_MainEx"); - if (!sym) { - return 0; - } - sym(argc, argv, appInitProc, interp); + len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH); + name[len-2] = TEXT('.'); + name[len-1] = name[len-5]; + _tcscpy(name+len, TEXT(".dll")); + memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR)); + + tkcygwindll = LoadLibrary(name); + if (!tkcygwindll) { + /* dll is not present */ + return 0; + } + tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_MainEx"); + if (!tkmainex) { + return 0; + } + tkmainex(argc, argv, appInitProc, interp); return 1; } -#endif +#endif /* __WIN32__ && !__WIN64__ */ + /* *---------------------------------------------------------------------- * @@ -2907,14 +2925,14 @@ Tk_Init( { #if defined(__WIN32__) && !defined(__WIN64__) if (tkcygwindll) { - int (*sym)(Tcl_Interp *); + int (*tkinit)(Tcl_Interp *); - sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_Init"); - if (sym) { - return sym(interp); + tkinit = (int(*)(Tcl_Interp *)) GetProcAddress(tkcygwindll,"Tk_Init"); + if (tkinit) { + return tkinit(interp); } } -#endif +#endif /* __WIN32__ && !__WIN64__ */ return Initialize(interp); } @@ -2980,14 +2998,15 @@ Tk_SafeInit( #if defined(__WIN32__) && !defined(__WIN64__) if (tkcygwindll) { - int (*sym)(Tcl_Interp *); + int (*tksafeinit)(Tcl_Interp *); - sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_SafeInit"); - if (sym) { - return sym(interp); + tksafeinit = (int (*)(Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_SafeInit"); + if (tksafeinit) { + return tksafeinit(interp); } } -#endif +#endif /* __WIN32__ && !__WIN64__ */ return Initialize(interp); } @@ -2998,7 +3017,8 @@ MODULE_SCOPE const TkStubs tkStubs; * * Initialize -- * - * ???TODO??? + * The core of the initialization code for Tk, called from Tk_Init and + * Tk_SafeInit. * * Results: * A standard Tcl result. Also leaves an error message in the interp's @@ -3083,6 +3103,7 @@ Initialize( master = Tcl_GetMaster(master); if (master == NULL) { Tcl_AppendResult(interp, "NULL master", NULL); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); code = TCL_ERROR; goto done; } @@ -3099,6 +3120,7 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", NULL); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } @@ -3125,6 +3147,7 @@ Initialize( Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "not allowed to start Tk by master's safe::TkInit", NULL); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } Tcl_DStringFree(&ds); @@ -3389,6 +3412,7 @@ Tk_PkgInitStubsCheck( } return actualVersion; } + /* * Local Variables: * mode: c diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 722ac9d..48ac5b2 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -704,10 +704,9 @@ TkWmProtocolEventProc( Tcl_Preserve(interp); result = Tcl_GlobalEval(interp, protPtr->command); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, - Tk_GetAtomName((Tk_Window) winPtr, protocol)); - Tcl_AddErrorInfo(interp, "\" window manager protocol)"); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + Tk_GetAtomName((Tk_Window) winPtr, protocol))); Tcl_BackgroundError(interp); } Tcl_Release(interp); diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index f2cb572..44b88f2 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -51,7 +51,6 @@ | tkCanJoinAllSpacesAttribute | tkMoveToActiveSpaceAttribute \ | tkNonactivatingPanelAttribute | tkHUDWindowAttribute) - /*Objects for use in setting background color and opacity of window.*/ NSColor *colorName = NULL; NSString *opaqueTag = NULL; @@ -479,7 +478,6 @@ FrontWindowAtPoint( } return (win ? TkMacOSXGetTkWindow(win) : NULL); } - /* *---------------------------------------------------------------------- @@ -561,7 +559,6 @@ TkWmNewWindow( UpdateVRootGeometry(wmPtr); - /* * Tk must monitor structure events for top-level windows, in order to * detect size and position changes caused by window managers. @@ -753,9 +750,8 @@ TkWmDeadWindow( wmPtr2->hints.flags &= ~IconWindowHint; } while (wmPtr->protPtr != NULL) { - ProtocolHandler *protPtr; + ProtocolHandler *protPtr = wmPtr->protPtr; - protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); } @@ -782,7 +778,7 @@ TkWmDeadWindow( [window close]; TkMacOSXUnregisterMacWindow(window); if (winPtr->window) { - ((MacDrawable *)winPtr->window)->view = nil; + ((MacDrawable *) winPtr->window)->view = nil; } TkMacOSXMakeCollectableAndRelease(wmPtr->window); } @@ -875,13 +871,13 @@ Tk_WmObjCmd( argv1 = Tcl_GetStringFromObj(objv[1], &length); if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0) - && (length >= 3)) { + && (length >= 3)) { if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); 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); @@ -1013,12 +1009,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[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); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1276,9 +1273,9 @@ WmAttributesCmd( Tcl_Obj *result = Tcl_NewListObj(0,0); for (attribute = 0; attribute < _WMATT_LAST_ATTRIBUTE; ++attribute) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(WmAttributeNames[attribute], -1)); - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, WmGetAttribute(winPtr, macWindow, attribute)); } Tcl_SetObjResult(interp, result); @@ -1293,7 +1290,7 @@ WmAttributesCmd( for (i = 3; i < objc; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } if (WmSetAttribute(winPtr, macWindow, interp, attribute, objv[i+1]) @@ -1402,7 +1399,7 @@ WmColormapwindowsCmd( Tk_MakeWindowExist((Tk_Window) winPtr); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) - && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { + && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); @@ -1410,7 +1407,7 @@ WmColormapwindowsCmd( return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } cmapList = ckalloc((windowObjc+1) * sizeof(TkWindow*)); @@ -1486,7 +1483,7 @@ WmCommandCmd( } if (objc == 3) { if (wmPtr->cmdArgv != NULL) { - argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); + argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); Tcl_SetResult(interp, argv3, TCL_VOLATILE); ckfree(argv3); } @@ -1543,13 +1540,15 @@ 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))); 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)); return TCL_ERROR; } TkpWmSetState(winPtr, TkMacOSXIsWindowZoomed(winPtr) ? @@ -1687,7 +1686,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1697,8 +1695,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; } @@ -1750,9 +1747,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]); @@ -1800,12 +1796,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1954,8 +1951,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_SetResult(interp, (char *) + Tk_NameOfBitmap(winPtr->display,wmPtr->hints.icon_pixmap), + TCL_STATIC); } return TCL_OK; } @@ -2075,8 +2073,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_SetResult(interp, (char *) + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + TCL_STATIC); } return TCL_OK; } @@ -2249,11 +2248,11 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } @@ -2450,15 +2449,16 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); 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; @@ -2501,11 +2501,12 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMinSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2756,16 +2757,15 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[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); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); 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) { @@ -4981,7 +4981,6 @@ TkUnsupported1ObjCmd( return TCL_ERROR; } - /* Iterate through objc/objv to set correct background color and toggle opacity of window. */ int i; for (i= 0; i < objc; i++) { @@ -5186,7 +5185,6 @@ WmWinStyle( Tcl_Panic("invalid class"); } - attributeList = Tcl_NewListObj(0, NULL); attributes = wmPtr->attributes; @@ -5259,7 +5257,6 @@ WmWinStyle( return TCL_ERROR; } - return TCL_OK; } @@ -6573,8 +6570,6 @@ RemapWindows( RemapWindows(childPtr, (MacDrawable *) winPtr->window); } } - - /* * Local Variables: diff --git a/unix/tkUnix.c b/unix/tkUnix.c index 841a1b7..c6fff82 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -13,7 +13,14 @@ #include "tkInt.h" #ifdef HAVE_XSS -#include <X11/extensions/scrnsaver.h> +# include <X11/extensions/scrnsaver.h> +# ifdef __APPLE__ +/* Support for weak-linked libXss. */ +# define HaveXSSLibrary() (XScreenSaverQueryInfo != NULL) +# else +/* Other platforms always link libXss. */ +# define HaveXSSLibrary() (1) +# endif #endif /* @@ -26,7 +33,7 @@ * server" command. * * Results: - * None. + * Sets the interpreter result. * * Side effects: * None. @@ -41,14 +48,11 @@ TkGetServerInfo( Tk_Window tkwin) /* Token for window; this selects a particular * display and server. */ { - char buffer[8 + TCL_INTEGER_SPACE * 2]; - char buffer2[TCL_INTEGER_SPACE]; - - sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)), - ProtocolRevision(Tk_Display(tkwin))); - sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin))); - Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)), - buffer2, (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("X%dR%d %s %d", + ProtocolVersion(Tk_Display(tkwin)), + ProtocolRevision(Tk_Display(tkwin)), + ServerVendor(Tk_Display(tkwin)), + VendorRelease(Tk_Display(tkwin)))); } /* @@ -207,13 +211,9 @@ Tk_GetUserInactiveTime( * on some buggy versions of XFree86. */ - if ( -#ifdef __APPLE__ - XScreenSaverQueryInfo != NULL && /* Support for weak-linked libXss. */ -#endif - XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) && - XScreenSaverQueryVersion(dpy, &major, &minor)) { - + if (HaveXSSLibrary() + && XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) + && XScreenSaverQueryVersion(dpy, &major, &minor)) { XScreenSaverInfo *info = XScreenSaverAllocInfo(); if (info == NULL) { diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index 172d5ca..a67e75e 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.c @@ -583,13 +583,11 @@ TkSelEventProc( if ((type == XA_STRING) || (type == dispPtr->textAtom) || (type == dispPtr->compoundTextAtom)) { Tcl_Encoding encoding; - if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, + if (format != 8) { + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); retrPtr->result = TCL_ERROR; return; } @@ -631,12 +629,9 @@ TkSelEventProc( char *propData = propInfo; if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); retrPtr->result = TCL_ERROR; return; } @@ -673,11 +668,9 @@ TkSelEventProc( Tcl_DString ds; if (format != 32 && format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad format for selection: wanted \"32\" or " - "\"8\", got \"%d\"", format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "bad format for selection: wanted \"32\" or " + "\"8\", got \"%d\"", format)); retrPtr->result = TCL_ERROR; return; } @@ -1150,12 +1143,9 @@ SelRcvIncrProc( Tcl_DString *dstPtr, temp; if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); retrPtr->result = TCL_ERROR; goto done; } @@ -1257,11 +1247,9 @@ SelRcvIncrProc( Tcl_DString ds; if (format != 32 && format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad format for selection: wanted \"32\" or " - "\"8\", got \"%d\"", format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "bad format for selection: wanted \"32\" or " + "\"8\", got \"%d\"", format)); retrPtr->result = TCL_ERROR; goto done; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 48d9021..ffa2235 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -41,6 +41,7 @@ typedef struct ProtocolHandler { /* * Data for [wm attributes] command: */ + typedef struct { double alpha; /* Transparency; 0.0=transparent, 1.0=opaque */ int topmost; /* Flag: true=>stay-on-top */ @@ -277,6 +278,16 @@ typedef struct TkWmInfo { #define WM_WITHDRAWN 0x4000 /* + * Wrapper for XGetWindowProperty to make it a *bit* less verbose. + */ + +#define GetWindowProperty(wrapperPtr, atom, length, type, typePtr, formatPtr, numItemsPtr, bytesAfterPtr, itemsPtr) \ + (XGetWindowProperty((wrapperPtr)->display, (wrapperPtr)->window, \ + (atom), 0, (long) (length), False, (type), \ + (typePtr),(formatPtr),(numItemsPtr),(bytesAfterPtr), \ + (unsigned char **) (itemsPtr)) == Success) + +/* * This module keeps a list of all top-level windows, primarily to simplify * the job of Tk_CoordsToWindow. The list is called firstWmPtr and is stored * in the TkDisplay structure. @@ -1041,9 +1052,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, - ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1183,12 +1193,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[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); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1450,7 +1461,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; } @@ -1530,8 +1542,7 @@ WmColormapwindowsCmd( Window *cmapList; TkWindow *winPtr2; int count, i, windowObjc, gotToplevel; - Tcl_Obj **windowObjv; - char buffer[20]; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1546,6 +1557,7 @@ WmColormapwindowsCmd( wmPtr->wrapperPtr->window, &cmapList, &count) == 0) { return TCL_OK; } + resultObj = Tcl_NewObj(); for (i = 0; i < count; i++) { if ((i == (count-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { @@ -1554,13 +1566,15 @@ WmColormapwindowsCmd( winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display, cmapList[i]); if (winPtr2 == NULL) { - sprintf(buffer, "0x%lx", cmapList[i]); - Tcl_AppendElement(interp, buffer); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_ObjPrintf("0x%lx", cmapList[i])); } else { - Tcl_AppendElement(interp, winPtr2->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(winPtr2->pathName, -1)); } } XFree((char *) cmapList); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) @@ -1636,6 +1650,7 @@ 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); @@ -1844,7 +1859,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1854,8 +1868,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; } @@ -1894,8 +1907,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) { @@ -1907,9 +1918,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]); @@ -1957,12 +1967,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -2049,7 +2060,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; } @@ -2123,10 +2134,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); + wmPtr->hints.icon_pixmap), -1)); } return TCL_OK; } @@ -2244,9 +2254,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; } @@ -2302,9 +2312,9 @@ WmIconnameCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), - TCL_STATIC); + if (wmPtr->iconName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->iconName, -1)); + } return TCL_OK; } else { if (wmPtr->iconName != NULL) { @@ -2498,11 +2508,11 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } @@ -2731,11 +2741,12 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2789,10 +2800,11 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minWidth); + results[1] = Tcl_NewIntObj(wmPtr->minHeight); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2968,11 +2980,14 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + Tcl_Obj *resultObj = Tcl_NewObj(); + for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -2984,7 +2999,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; } } @@ -3066,12 +3082,11 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[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); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) @@ -3198,11 +3213,15 @@ WmStackorderCmd( if (objc == 3) { windows = TkWmStackorderToplevel(winPtr); if (windows != NULL) { + Tcl_Obj *resultObj = Tcl_NewObj(); + /* ASSERT: true [Bug 1789819]*/ for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj((*window_ptr)->pathName, -1)); } ckfree(windows); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } } else { @@ -3350,17 +3369,20 @@ WmStateCmd( } } } else { + const char *state; + if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + state = "icon"; } else if (wmPtr->withdrawn) { - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + state = "withdrawn"; } else if (Tk_IsMapped((Tk_Window) winPtr) || ((wmPtr->flags & WM_NEVER_MAPPED) && (wmPtr->hints.initial_state == NormalState))) { - Tcl_SetResult(interp, "normal", TCL_STATIC); + state = "normal"; } else { - Tcl_SetResult(interp, "iconic", TCL_STATIC); + state = "iconic"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(state, -1)); } return TCL_OK; } @@ -3399,10 +3421,11 @@ WmTitleCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (char *) - ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), - TCL_STATIC); - return TCL_OK; + if (wmPtr->title) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->title, -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); + } } else { if (wmPtr->title != NULL) { ckfree(wmPtr->title); @@ -4052,6 +4075,8 @@ ReparentEvent( unsigned dummy; Tk_ErrorHandler handler; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; + Atom WM_ROOT = Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"); + Atom SWM_ROOT = Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"); /* * Identify the root window for wrapperPtr. This is tricky because of @@ -4065,15 +4090,11 @@ ReparentEvent( wmPtr->vRoot = None; handler = Tk_CreateErrorHandler(wrapperPtr->display, -1,-1,-1, NULL,NULL); vrPtrPtr = &virtualRootPtr; /* Silence GCC warning */ - if (((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, - Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"), 0, (long) 1, - False, XA_WINDOW, &actualType, &actualFormat, &numItems, - &bytesAfter, (unsigned char **) vrPtrPtr) == Success) + if ((GetWindowProperty(wrapperPtr, WM_ROOT, 1, XA_WINDOW, + &actualType, &actualFormat, &numItems, &bytesAfter, vrPtrPtr) && (actualType == XA_WINDOW)) - || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, - Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1, - False, XA_WINDOW, &actualType, &actualFormat, &numItems, - &bytesAfter, (unsigned char **) vrPtrPtr) == Success) + || (GetWindowProperty(wrapperPtr, SWM_ROOT, 1, XA_WINDOW, + &actualType, &actualFormat, &numItems, &bytesAfter, vrPtrPtr) && (actualType == XA_WINDOW))) { if ((actualFormat == 32) && (numItems == 1)) { vRoot = wmPtr->vRoot = *virtualRootPtr; @@ -4285,11 +4306,9 @@ PropertyEvent( unsigned char *propertyValue = 0; long maxLength = 1024; - if (XGetWindowProperty( - wrapperPtr->display, wrapperPtr->window, _NET_WM_STATE, - 0l, maxLength, False, XA_ATOM, + if (GetWindowProperty(wrapperPtr, _NET_WM_STATE, maxLength, XA_ATOM, &actualType, &actualFormat, &numItems, &bytesAfter, - &propertyValue) == Success) { + &propertyValue)) { CheckNetWmState(wmPtr, (Atom *) propertyValue, (int) numItems); XFree(propertyValue); } @@ -5446,13 +5465,12 @@ GetNetWmType(TkWindow *winPtr) wrapperPtr = winPtr->wmInfoPtr->wrapperPtr; typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); - if (Success == XGetWindowProperty(wrapperPtr->display, - wrapperPtr->window, typeAtom, 0L, maxLength, False, - XA_ATOM, &actualType, &actualFormat, &count, - &bytesAfter, &propertyValue)) { - atoms = (Atom *)propertyValue; + if (GetWindowProperty(wrapperPtr, typeAtom, maxLength, XA_ATOM, + &actualType, &actualFormat, &count, &bytesAfter, &propertyValue)){ + atoms = (Atom *) propertyValue; for (n = 0; n < count; ++n) { const char *name = Tk_GetAtomName(tkwin, atoms[n]); + if (strncmp("_NET_WM_WINDOW_TYPE_", name, 20) == 0) { Tcl_ExternalToUtfDString(NULL, name+20, -1, &ds); Tcl_UtfToLower(Tcl_DStringValue(&ds)); diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 4d60105..b0c7f4d 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -424,13 +424,11 @@ Tk_ChooseColorObjCmd( /* * User has selected a color */ - char color[100]; - sprintf(color, "#%02x%02x%02x", + Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x", GetRValue(chooseColor.rgbResult), GetGValue(chooseColor.rgbResult), - GetBValue(chooseColor.rgbResult)); - Tcl_AppendResult(interp, color, NULL); + GetBValue(chooseColor.rgbResult))); oldColor = chooseColor.rgbResult; result = TCL_OK; } diff --git a/win/tkWinSend.c b/win/tkWinSend.c index b3edc62..a8e2109 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -55,7 +55,7 @@ typedef struct { int initialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * Functions internal to this file. @@ -66,12 +66,12 @@ static void CmdDeleteProc(ClientData clientData); static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp); static void RevokeObjectRegistration(RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static HRESULT BuildMoniker(const char *name, LPMONIKER *pmk); #ifdef TK_SEND_ENABLED_ON_WINDOWS static HRESULT RegisterInterp(const char *name, RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static int FindInterpreterObject(Tcl_Interp *interp, const char *name, LPDISPATCH *ppdisp); static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, @@ -85,7 +85,7 @@ static Tcl_EventProc SendEventProc; #define TRACE SendTrace #else #define TRACE 1 ? ((void)0) : SendTrace -#endif +#endif /* DEBUG || _DEBUG */ /* *-------------------------------------------------------------- @@ -553,7 +553,7 @@ RevokeObjectRegistration( riPtr->name = NULL; } } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -580,7 +580,7 @@ InterpDeleteProc( { CoUninitialize(); } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -701,7 +701,7 @@ RegisterInterp( Tcl_DStringFree(&dString); return hr; } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -782,21 +782,14 @@ Send( * variables. */ - if (hr == DISP_E_EXCEPTION) { + if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) { Tcl_Obj *opError, *opErrorCode, *opErrorInfo; - if (ei.bstrSource != NULL) { - int len; - const char *szErrorInfo; - - opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); - Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); - Tcl_SetObjErrorCode(interp, opErrorCode); - - Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); - szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len); - Tcl_AddObjErrorInfo(interp, szErrorInfo, len); - } + opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); + Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); + Tcl_SetObjErrorCode(interp, opErrorCode); + Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); + Tcl_AppendObjToErrorInfo(interp, opErrorInfo); } /* @@ -852,7 +845,7 @@ Win32ErrorObj( errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); #else errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); -#endif +#endif /* _UNICODE */ if (lpBuffer != sBuffer) { LocalFree((HLOCAL)lpBuffer); @@ -864,7 +857,7 @@ Win32ErrorObj( /* * ---------------------------------------------------------------------- * - * SetErrorInfo -- + * TkWinSend_SetExcepInfo -- * * Convert the error information from a Tcl interpreter into a COM * exception structure. This information is then registered with the COM @@ -881,48 +874,51 @@ Win32ErrorObj( */ void -SetExcepInfo( - Tcl_Interp* interp, +TkWinSend_SetExcepInfo( + Tcl_Interp *interp, EXCEPINFO *pExcepInfo) { - if (pExcepInfo) { - Tcl_Obj *opError, *opErrorInfo, *opErrorCode; - ICreateErrorInfo *pCEI; - IErrorInfo *pEI, **ppEI = &pEI; - HRESULT hr; - - opError = Tcl_GetObjResult(interp); - opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo",NULL, TCL_GLOBAL_ONLY); - opErrorCode = Tcl_GetVar2Ex(interp, "errorCode",NULL, TCL_GLOBAL_ONLY); - - if (Tcl_IsShared(opErrorCode)) { - Tcl_Obj *ec = Tcl_DuplicateObj(opErrorCode); - - Tcl_IncrRefCount(ec); - Tcl_DecrRefCount(opErrorCode); - opErrorCode = ec; - } - Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + Tcl_Obj *opError, *opErrorInfo, *opErrorCode; + ICreateErrorInfo *pCEI; + IErrorInfo *pEI, **ppEI = &pEI; + HRESULT hr; - pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); - pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); - pExcepInfo->scode = E_FAIL; + if (!pExcepInfo) { + return; + } - hr = CreateErrorInfo(&pCEI); - if (SUCCEEDED(hr)) { - hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); - hr = pCEI->lpVtbl->SetDescription(pCEI, - pExcepInfo->bstrDescription); - hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); - hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, - (void**) ppEI); - if (SUCCEEDED(hr)) { - SetErrorInfo(0, pEI); - pEI->lpVtbl->Release(pEI); - } - pCEI->lpVtbl->Release(pCEI); - } + opError = Tcl_GetObjResult(interp); + opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + opErrorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + + /* + * Pack the trace onto the end of the Tcl exception descriptor. + */ + + opErrorCode = Tcl_DuplicateObj(opErrorCode); + Tcl_IncrRefCount(opErrorCode); + Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + /* TODO: Handle failure to append */ + + pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); + pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); + Tcl_DecrRefCount(opErrorCode); + pExcepInfo->scode = E_FAIL; + + hr = CreateErrorInfo(&pCEI); + if (!SUCCEEDED(hr)) { + return; + } + + hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); + hr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription); + hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); + hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void **) ppEI); + if (SUCCEEDED(hr)) { + SetErrorInfo(0, pEI); + pEI->lpVtbl->Release(pEI); } + pCEI->lpVtbl->Release(pCEI); } /* diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c index c67e533..83dd56b 100644 --- a/win/tkWinSendCom.c +++ b/win/tkWinSendCom.c @@ -100,7 +100,6 @@ TkWinSendCom_CreateInstance( ISupportErrorInfo_Release, ISupportErrorInfo_InterfaceSupportsErrorInfo, }; - HRESULT hr = S_OK; TkWinSendCom *obj = NULL; /* @@ -111,21 +110,19 @@ TkWinSendCom_CreateInstance( obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom)); if (obj == NULL) { *ppv = NULL; - hr = E_OUTOFMEMORY; - } else { - obj->lpVtbl = &vtbl; - obj->lpVtbl2 = &vtbl2; - obj->refcount = 0; - obj->interp = interp; - - /* - * lock the interp? Tcl_AddRef/Retain? - */ - - hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv); + return E_OUTOFMEMORY; } - return hr; + obj->lpVtbl = &vtbl; + obj->lpVtbl2 = &vtbl2; + obj->refcount = 0; + obj->interp = interp; + + /* + * lock the interp? Tcl_AddRef/Retain? + */ + + return obj->lpVtbl->QueryInterface((IDispatch *) obj, riid, ppv); } /* @@ -147,7 +144,7 @@ static void TkWinSendCom_Destroy( LPDISPATCH pdisp) { - CoTaskMemFree((void*)pdisp); + CoTaskMemFree((void *) pdisp); } /* @@ -169,17 +166,17 @@ WinSendCom_QueryInterface( void **ppvObject) { HRESULT hr = E_NOINTERFACE; - TkWinSendCom *this = (TkWinSendCom*)This; + TkWinSendCom *this = (TkWinSendCom *) This; *ppvObject = NULL; if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0 || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) { - *ppvObject = (void**)this; + *ppvObject = (void **) this; this->lpVtbl->AddRef(This); hr = S_OK; } else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) { - *ppvObject = (void**)(this + 1); - this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1)); + *ppvObject = (void **) (this + 1); + this->lpVtbl2->AddRef((ISupportErrorInfo *) (this + 1)); hr = S_OK; } return hr; @@ -316,16 +313,16 @@ ISupportErrorInfo_QueryInterface( REFIID riid, void **ppvObject) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); - return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject); + return this->lpVtbl->QueryInterface((IDispatch *) this, riid, ppvObject); } static STDMETHODIMP_(ULONG) ISupportErrorInfo_AddRef( ISupportErrorInfo *This) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); return InterlockedIncrement(&this->refcount); } @@ -334,9 +331,9 @@ static STDMETHODIMP_(ULONG) ISupportErrorInfo_Release( ISupportErrorInfo *This) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); - return this->lpVtbl->Release((IDispatch*)this); + return this->lpVtbl->Release((IDispatch *) this); } static STDMETHODIMP @@ -380,17 +377,15 @@ Async( if (FAILED(hr)) { Tcl_SetObjResult(obj->interp, Tcl_NewStringObj( "invalid args: Async(command)", -1)); - SetExcepInfo(obj->interp, pExcepInfo); + TkWinSend_SetExcepInfo(obj->interp, pExcepInfo); hr = DISP_E_EXCEPTION; } - if (SUCCEEDED(hr)) { - if (obj->interp) { - Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, - (int) SysStringLen(vCmd.bstrVal)); + if (SUCCEEDED(hr) && obj->interp) { + Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, + (int) SysStringLen(vCmd.bstrVal)); - TkWinSend_QueueCommand(obj->interp, scriptPtr); - } + TkWinSend_QueueCommand(obj->interp, scriptPtr); } VariantClear(&vCmd); @@ -427,29 +422,36 @@ Send( HRESULT hr = S_OK; int result = TCL_OK; VARIANT v; + register Tcl_Interp *interp = obj->interp; + Tcl_Obj *scriptPtr; + if (interp == NULL) { + return S_OK; + } VariantInit(&v); hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR); - if (SUCCEEDED(hr)) { - if (obj->interp) { - Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, - (int)SysStringLen(v.bstrVal)); - - result = Tcl_EvalObjEx(obj->interp, scriptPtr, - TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); - if (pvResult) { - VariantInit(pvResult); - pvResult->vt = VT_BSTR; - pvResult->bstrVal = SysAllocString( - Tcl_GetUnicode(Tcl_GetObjResult(obj->interp))); - } - if (result == TCL_ERROR) { - hr = DISP_E_EXCEPTION; - SetExcepInfo(obj->interp, pExcepInfo); - } - } - VariantClear(&v); + if (!SUCCEEDED(hr)) { + return hr; + } + + scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, (int) SysStringLen(v.bstrVal)); + Tcl_Preserve(interp); + Tcl_IncrRefCount(scriptPtr); + result = Tcl_EvalObjEx(interp, scriptPtr, + TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(scriptPtr); + if (pvResult != NULL) { + VariantInit(pvResult); + pvResult->vt = VT_BSTR; + pvResult->bstrVal = SysAllocString(Tcl_GetUnicode( + Tcl_GetObjResult(interp))); + } + if (result == TCL_ERROR) { + hr = DISP_E_EXCEPTION; + TkWinSend_SetExcepInfo(interp, pExcepInfo); } + Tcl_Release(interp); + VariantClear(&v); return hr; } diff --git a/win/tkWinSendCom.h b/win/tkWinSendCom.h index 4928bc7..cd6ec18 100644 --- a/win/tkWinSendCom.h +++ b/win/tkWinSendCom.h @@ -45,11 +45,11 @@ typedef struct { * TkWinSendCom public functions */ -HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp, +MODULE_SCOPE HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv); -int TkWinSend_QueueCommand(Tcl_Interp *interp, +MODULE_SCOPE int TkWinSend_QueueCommand(Tcl_Interp *interp, Tcl_Obj *cmdPtr); -void SetExcepInfo(Tcl_Interp *interp, +MODULE_SCOPE void TkWinSend_SetExcepInfo(Tcl_Interp *interp, EXCEPINFO *pExcepInfo); #endif /* _tkWinSendCom_h_INCLUDE */ diff --git a/win/tkWinX.c b/win/tkWinX.c index e85b7e7..22edb60 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -120,20 +120,19 @@ TkGetServerInfo( Tk_Window tkwin) /* Token for window; this selects a particular * display and server. */ { - char buffer[60]; OSVERSIONINFO os; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); GetVersionEx(&os); - sprintf(buffer, "Windows %d.%d %d %s", (int)os.dwMajorVersion, - (int)os.dwMinorVersion, (int)os.dwBuildNumber, + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Windows %d.%d %d %s", + (int) os.dwMajorVersion, (int) os.dwMinorVersion, + (int) os.dwBuildNumber, #ifdef _WIN64 "Win64" #else "Win32" #endif - ); - Tcl_SetResult(interp, buffer, TCL_VOLATILE); + )); } /* |