diff options
Diffstat (limited to 'generic')
79 files changed, 3880 insertions, 2941 deletions
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..6c2c5c5 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,10 @@ 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", curArg, + NULL); return TCL_ERROR; } matchPtr = infoPtr; @@ -153,8 +156,10 @@ 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", curArg, + NULL); return TCL_ERROR; } argv[dstIndex] = curArg; @@ -175,25 +180,23 @@ 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", curArg,NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_STRING: if (argc == 0) { goto missingArg; } - *((const char **)infoPtr->dst) = argv[srcIndex]; + *((const char **) infoPtr->dst) = argv[srcIndex]; srcIndex++; argc--; break; @@ -201,7 +204,7 @@ Tk_ParseArgv( if (argc == 0) { goto missingArg; } - *((Tk_Uid *)infoPtr->dst) = Tk_GetUid(argv[srcIndex]); + *((Tk_Uid *) infoPtr->dst) = Tk_GetUid(argv[srcIndex]); srcIndex++; argc--; break; @@ -211,19 +214,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", curArg, NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_FUNC: { typedef int (ArgvFunc)(char *, const char *, const char *); @@ -249,6 +250,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 +267,11 @@ 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", curArg, + NULL); return TCL_ERROR; } Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1], @@ -274,14 +279,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", "API_ABUSE", NULL); return TCL_ERROR; } - } } /* @@ -301,8 +304,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", curArg, NULL); return TCL_ERROR; } @@ -328,7 +332,7 @@ static void PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ - const Tk_ArgvInfo *argTable, /* Array of command-specific argument + const Tk_ArgvInfo *argTable,/* Array of command-specific argument * descriptions. */ int flags) /* If the TK_ARGV_NO_DEFAULTS bit is set in * this word, then don't generate information @@ -336,7 +340,7 @@ PrintUsage( { register const Tk_ArgvInfo *infoPtr; size_t width, i, numSpaces; - char tmp[TCL_DOUBLE_SPACE]; + Tcl_Obj *message; /* * First, compute the width of the widest option key, so that we can make @@ -348,6 +352,7 @@ PrintUsage( for (infoPtr = i ? defaultTable : argTable; infoPtr->type != TK_ARGV_END; infoPtr++) { size_t length; + if (infoPtr->key == NULL) { continue; } @@ -358,35 +363,35 @@ PrintUsage( } } - Tcl_AppendResult(interp, "Command-specific options:", NULL); + message = Tcl_NewStringObj("Command-specific options:", -1); for (i = 0; ; i++) { for (infoPtr = i ? defaultTable : argTable; infoPtr->type != TK_ARGV_END; infoPtr++) { if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) { - Tcl_AppendResult(interp, "\n", infoPtr->help, NULL); + Tcl_AppendPrintfToObj(message, "\n%s", infoPtr->help); continue; } - Tcl_AppendResult(interp, "\n ", infoPtr->key, ":", NULL); + Tcl_AppendPrintfToObj(message, "\n %s:", infoPtr->key); numSpaces = width + 1 - strlen(infoPtr->key); while (numSpaces-- > 0) { - Tcl_AppendResult(interp, " ", NULL); + Tcl_AppendToObj(message, " ", 1); } - Tcl_AppendResult(interp, infoPtr->help, NULL); + Tcl_AppendToObj(message, infoPtr->help, -1); switch (infoPtr->type) { case TK_ARGV_INT: - sprintf(tmp, "%d", *((int *) infoPtr->dst)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %d", + *((int *) infoPtr->dst)); break; case TK_ARGV_FLOAT: - Tcl_PrintDouble(NULL, *((double *) infoPtr->dst), tmp); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %f", + *((double *) infoPtr->dst)); break; case TK_ARGV_STRING: { char *string = *((char **) infoPtr->dst); if (string != NULL) { - Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string, - "\"", NULL); + Tcl_AppendPrintfToObj(message, + "\n\t\tDefault value: \"%s\"", string); } break; } @@ -398,8 +403,9 @@ PrintUsage( if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) { break; } - Tcl_AppendResult(interp, "\nGeneric options for all commands:", NULL); + Tcl_AppendToObj(message, "\nGeneric options for all commands:", -1); } + Tcl_SetObjResult(interp, message); } /* diff --git a/generic/tkBind.c b/generic/tkBind.c index e58ad4d..7126e24 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -620,7 +620,7 @@ static PatSeq * FindSequence(Tcl_Interp *interp, static void GetAllVirtualEvents(Tcl_Interp *interp, VirtualEventTable *vetPtr); static char * GetField(char *p, char *copy, int size); -static void GetPatternString(PatSeq *psPtr, Tcl_DString *dsPtr); +static Tcl_Obj * GetPatternObj(PatSeq *psPtr); static int GetVirtualEvent(Tcl_Interp *interp, VirtualEventTable *vetPtr, Tcl_Obj *virtName); static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp, @@ -1094,13 +1094,14 @@ Tk_GetAllBindings( { PatSeq *psPtr; Tcl_HashEntry *hPtr; - Tcl_DString ds; + Tcl_Obj *resultObj; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } - Tcl_DStringInit(&ds); + + resultObj = Tcl_NewObj(); for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextObjPtr) { /* @@ -1108,11 +1109,9 @@ Tk_GetAllBindings( * its sequence. */ - Tcl_DStringSetLength(&ds, 0); - GetPatternString(psPtr, &ds); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr)); } - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); } /* @@ -1223,7 +1222,8 @@ Tk_BindEvent( PatSeq *vMatchDetailList, *vMatchNoDetailList; int flags, oldScreen; Tcl_Interp *interp; - Tcl_DString scripts, savedResult; + Tcl_DString scripts; + Tcl_InterpState interpState; Detail detail; char *p, *end; TkWindow *winPtr = (TkWindow *) tkwin; @@ -1453,14 +1453,13 @@ Tk_BindEvent( */ interp = bindPtr->interp; - Tcl_DStringInit(&savedResult); /* * Save information about the current screen, then invoke a script if the * screen has changed. */ - Tcl_DStringGetResult(interp, &savedResult); + interpState = Tcl_SaveInterpState(interp, TCL_OK); screenPtr = &bindInfoPtr->screenInfo; oldDispPtr = screenPtr->curDispPtr; oldScreen = screenPtr->curScreenIndex; @@ -1475,7 +1474,7 @@ Tk_BindEvent( end = p + Tcl_DStringLength(&scripts); /* - * Be carefule when dereferencing screenPtr or bindInfoPtr. If we evaluate + * Be careful when dereferencing screenPtr or bindInfoPtr. If we evaluate * something that destroys ".", bindInfoPtr would have been freed, but we * can tell that by first checking to see if winPtr->mainPtr == NULL. */ @@ -1523,7 +1522,7 @@ Tk_BindEvent( screenPtr->curScreenIndex = oldScreen; ChangeScreen(interp, oldDispPtr->name, oldScreen); } - Tcl_DStringResult(interp, &savedResult); + (void) Tcl_RestoreInterpState(interp, interpState); Tcl_DStringFree(&scripts); Tcl_Release(bindInfoPtr); @@ -2771,10 +2770,10 @@ GetVirtualEvent( Tcl_Obj *virtName) /* String describing virtual event. */ { Tcl_HashEntry *vhPtr; - Tcl_DString ds; int iPhys; PhysicalsOwned *poPtr; Tk_Uid virtUid; + Tcl_Obj *resultObj; virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName)); if (virtUid == NULL) { @@ -2786,15 +2785,13 @@ GetVirtualEvent( return TCL_OK; } - Tcl_DStringInit(&ds); - + resultObj = Tcl_NewObj(); poPtr = Tcl_GetHashValue(vhPtr); for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) { - Tcl_DStringSetLength(&ds, 0); - GetPatternString(poPtr->patSeqs[iPhys], &ds); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, + GetPatternObj(poPtr->patSeqs[iPhys])); } - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -2824,20 +2821,15 @@ GetAllVirtualEvents( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - Tcl_DString ds; - - Tcl_DStringInit(&ds); + Tcl_Obj *resultObj; + resultObj = Tcl_NewObj(); hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, "<<", 2); - Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1); - Tcl_DStringAppend(&ds, ">>", 2); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr))); } - - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); } /* @@ -2924,8 +2916,11 @@ HandleEventGenerate( mainPtr = (TkWindow *) mainWin; if ((tkwin == NULL) || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", Tcl_GetString(objv[0]), - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", + Tcl_GetString(objv[0]), NULL); return TCL_ERROR; } @@ -2939,13 +2934,15 @@ HandleEventGenerate( return TCL_ERROR; } if (count != 1) { - Tcl_SetResult(interp, "Double or Triple modifier not allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Double or Triple modifier not allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL); return TCL_ERROR; } if (*p != '\0') { - Tcl_SetResult(interp, "only one event specification allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "only one event specification allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL); return TCL_ERROR; } @@ -3021,8 +3018,9 @@ HandleEventGenerate( * is missing. */ - Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr), - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL); return TCL_ERROR; } @@ -3163,15 +3161,19 @@ HandleEventGenerate( value = Tcl_GetString(valuePtr); keysym = TkStringToKeysym(value); if (keysym == NoSymbol) { - Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value, NULL); return TCL_ERROR; } TkpSetKeycodeAndState(tkwin, keysym, &event.general); if (event.general.xkey.keycode == 0) { - Tcl_AppendResult(interp, "no keycode for keysym \"", value, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no keycode for keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value, + NULL); return TCL_ERROR; } if (!(flags & KEY) @@ -3400,8 +3402,10 @@ HandleEventGenerate( continue; badopt: - Tcl_AppendResult(interp, name, " event doesn't accept \"", - Tcl_GetString(optionPtr), "\" option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s event doesn't accept \"%s\" option", + name, Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL); return TCL_ERROR; } @@ -3495,7 +3499,9 @@ NameToWindow( return TCL_OK; badWindow: - Tcl_AppendResult(interp, "bad window name/identifier \"",name,"\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window name/identifier \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL); return TCL_ERROR; } @@ -3558,8 +3564,9 @@ GetVirtualEventUid( if (length < 5 || virtString[0] != '<' || virtString[1] != '<' || virtString[length - 2] != '>' || virtString[length - 1] != '>') { - Tcl_AppendResult(interp, "virtual event \"", virtString, - "\" is badly formed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "virtual event \"%s\" is badly formed", virtString)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); return NULL; } virtString[length - 2] = '\0'; @@ -3651,9 +3658,11 @@ FindSequence( if (eventMask & VirtualEventMask) { if (allowVirtual == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "virtual event not allowed in definition of another virtual event", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", + NULL); return NULL; } virtualFound = 1; @@ -3679,12 +3688,16 @@ FindSequence( */ if (numPats == 0) { - Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no events specified in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL); return NULL; } if ((numPats > 1) && (virtualFound != 0)) { - Tcl_SetResult(interp, "virtual events may not be composed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual events may not be composed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", + NULL); return NULL; } @@ -3804,6 +3817,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; } @@ -3844,14 +3858,18 @@ ParseEventDescription( p = strchr(field, '>'); if (p == field) { - Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual event \"<<>>\" is badly formed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } if ((p == NULL) || (p[1] != '>')) { - Tcl_SetResult(interp, "missing \">\" in virtual binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in virtual binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } @@ -3917,9 +3935,11 @@ ParseEventDescription( eventMask = ButtonPressMask; } else if (eventFlags & KEY) { goto getKeysym; - } else if ((eventFlags & BUTTON) == 0) { - Tcl_AppendResult(interp, "specified button \"", field, - "\" for non-button event", NULL); + } else if (!(eventFlags & BUTTON)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified button \"%s\" for non-button event", + field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL); count = 0; goto done; } @@ -3929,24 +3949,28 @@ ParseEventDescription( getKeysym: patPtr->detail.keySym = TkStringToKeysym(field); if (patPtr->detail.keySym == NoSymbol) { - Tcl_AppendResult(interp, "bad event type or keysym \"", - field, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad event type or keysym \"%s\"", field)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field, + NULL); count = 0; goto done; } if (eventFlags == 0) { patPtr->eventType = KeyPress; eventMask = KeyPressMask; - } else if ((eventFlags & KEY) == 0) { - Tcl_AppendResult(interp, "specified keysym \"", field, - "\" for non-key event", NULL); + } else if (!(eventFlags & KEY)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified keysym \"%s\" for non-key event", field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL); count = 0; goto done; } } } else if (eventFlags == 0) { - Tcl_SetResult(interp, "no event type or button # or keysym", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no event type or button # or keysym", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); count = 0; goto done; } @@ -3958,14 +3982,16 @@ ParseEventDescription( while (*p != '\0') { p++; if (*p == '>') { - Tcl_SetResult(interp, - "extra characters after detail in binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after detail in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); count = 0; goto done; } } - Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); count = 0; goto done; } @@ -4020,31 +4046,30 @@ GetField( /* *--------------------------------------------------------------------------- * - * GetPatternString -- + * GetPatternObj -- * * Produce a string version of the given event, for displaying to the * user. * * Results: - * The string is left in dsPtr. + * The string is returned as a Tcl_Obj. * * Side effects: - * It is the caller's responsibility to initialize the DString before and - * to free it after calling this function. + * It is the caller's responsibility to arrange for the object to be + * released; it starts with a refCount of zero. * *--------------------------------------------------------------------------- */ -static void -GetPatternString( - PatSeq *psPtr, - Tcl_DString *dsPtr) +static Tcl_Obj * +GetPatternObj( + PatSeq *psPtr) { Pattern *patPtr; - char c, buffer[TCL_INTEGER_SPACE]; int patsLeft, needMods; const ModInfo *modPtr; const EventInfo *eiPtr; + Tcl_Obj *patternObj = Tcl_NewObj(); /* * The order of the patterns in the sequence is backwards from the order @@ -4058,14 +4083,15 @@ GetPatternString( */ if ((patPtr->eventType == KeyPress) - && ((psPtr->flags & PAT_NEARBY) == 0) + && !(psPtr->flags & PAT_NEARBY) && (patPtr->needMods == 0) && (patPtr->detail.keySym < 128) && isprint(UCHAR(patPtr->detail.keySym)) && (patPtr->detail.keySym != '<') && (patPtr->detail.keySym != ' ')) { - c = (char) patPtr->detail.keySym; - Tcl_DStringAppend(dsPtr, &c, 1); + char c = (char) patPtr->detail.keySym; + + Tcl_AppendToObj(patternObj, &c, 1); continue; } @@ -4074,9 +4100,7 @@ GetPatternString( */ if (patPtr->eventType == VirtualEvent) { - Tcl_DStringAppend(dsPtr, "<<", 2); - Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1); - Tcl_DStringAppend(dsPtr, ">>", 2); + Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name); continue; } @@ -4086,7 +4110,7 @@ GetPatternString( * or button detail. */ - Tcl_DStringAppend(dsPtr, "<", 1); + Tcl_AppendToObj(patternObj, "<", 1); if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) && (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { @@ -4100,12 +4124,12 @@ GetPatternString( (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) { patsLeft--; patPtr--; - Tcl_DStringAppend(dsPtr, "Quadruple-", 10); + Tcl_AppendToObj(patternObj, "Quadruple-", 10); } else { - Tcl_DStringAppend(dsPtr, "Triple-", 7); + Tcl_AppendToObj(patternObj, "Triple-", 7); } } else { - Tcl_DStringAppend(dsPtr, "Double-", 7); + Tcl_AppendToObj(patternObj, "Double-", 7); } } @@ -4113,16 +4137,15 @@ GetPatternString( needMods != 0; modPtr++) { if (modPtr->mask & needMods) { needMods &= ~modPtr->mask; - Tcl_DStringAppend(dsPtr, modPtr->name, -1); - Tcl_DStringAppend(dsPtr, "-", 1); + Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name); } } for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { if (eiPtr->type == patPtr->eventType) { - Tcl_DStringAppend(dsPtr, eiPtr->name, -1); + Tcl_AppendToObj(patternObj, eiPtr->name, -1); if (patPtr->detail.clientData != 0) { - Tcl_DStringAppend(dsPtr, "-", 1); + Tcl_AppendToObj(patternObj, "-", 1); } break; } @@ -4134,16 +4157,17 @@ GetPatternString( const char *string = TkKeysymToString(patPtr->detail.keySym); if (string != NULL) { - Tcl_DStringAppend(dsPtr, string, -1); + Tcl_AppendToObj(patternObj, string, -1); } } else { - sprintf(buffer, "%d", patPtr->detail.button); - Tcl_DStringAppend(dsPtr, buffer, -1); + Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button); } } - Tcl_DStringAppend(dsPtr, ">", 1); + Tcl_AppendToObj(patternObj, ">", 1); } + + return patternObj; } /* diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index b0d1ecc..729fff4 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -342,8 +342,10 @@ GetBitmap( int result; if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify bitmap with '@' in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify bitmap with '@' in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); goto error; } @@ -363,8 +365,9 @@ GetBitmap( &bitmap, &dummy2, &dummy2); if (result != BitmapSuccess) { if (interp != NULL) { - Tcl_AppendResult(interp, "error reading bitmap file \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap file \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL); } Tcl_DStringFree(&buffer); goto error; @@ -384,8 +387,10 @@ GetBitmap( if (bitmap == None) { if (interp != NULL) { - Tcl_AppendResult(interp, "bitmap \"", string, - "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bitmap \"%s\" not defined", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", string, + NULL); } goto error; } @@ -487,8 +492,9 @@ Tk_DefineBitmap( predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable, name, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "bitmap \"", name, "\" is already defined", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bitmap \"%s\" is already defined", name)); + 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..8f73d80 100644 --- a/generic/tkBusy.c +++ b/generic/tkBusy.c @@ -687,8 +687,10 @@ GetBusy( } hPtr = Tcl_FindHashEntry(busyTablePtr, (char *) tkwin); if (hPtr == NULL) { - Tcl_AppendResult(interp, "can't find busy window \"", - Tcl_GetString(windowObj), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find busy window \"%s\"", Tcl_GetString(windowObj))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BUSY", + Tcl_GetString(windowObj), NULL); return NULL; } return Tcl_GetHashValue(hPtr); diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index 6cbc89b..4e4c582 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.c @@ -344,27 +344,23 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", + NULL); return TCL_ERROR; } } @@ -380,10 +376,9 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", NULL); return TCL_ERROR; } return TCL_OK; @@ -1823,13 +1818,14 @@ ArcToPostscript( * being created. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; - char buffer[400]; double y1, y2, ang1, ang2; XColor *color; Pixmap stipple; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]); @@ -1876,37 +1872,51 @@ ArcToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * If the arc is filled, output Postscript for the interior region of the * arc. */ if (arcPtr->fillGC != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - if (arcPtr->style == CHORD_STYLE) { - sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); - } else { - sprintf(buffer, - "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); + + if (arcPtr->style != CHORD_STYLE) { + Tcl_AppendToObj(psObj, "0 0 moveto ", -1); } - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", + ang1, ang2); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->outline.gc != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1915,57 +1925,86 @@ ArcToPostscript( */ if (arcPtr->outline.gc != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 0 1 %.15g %.15g", ang1, ang2); - Tcl_AppendResult(interp, buffer, - " arc\nsetmatrix\n0 setlinecap\n", NULL); - if (Tk_CanvasPsOutline(canvas, itemPtr, &(arcPtr->outline)) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc\nsetmatrix\n0 setlinecap\n", + ang1, ang2); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsOutline(canvas, itemPtr, &arcPtr->outline) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->style != ARC_STYLE) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); if (arcPtr->style == CHORD_STYLE) { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS); } else { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS); - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); - if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsStipple(interp, canvas, stipple) !=TCL_OK){ + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, PIE_OUTLINE2_PTS); } - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } } + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2021,8 +2060,10 @@ StyleParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad -style option \"", value, - "\": must be arc, chord, or pieslice", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad -style option \"%s\": must be arc, chord, or pieslice", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARC_STYLE", NULL); *stylePtr = PIESLICE_STYLE; return TCL_ERROR; } diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index ea16a29..d7d54f4 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,10 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", + NULL); return TCL_ERROR; } } @@ -275,10 +273,9 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", NULL); return TCL_ERROR; } return TCL_OK; @@ -853,11 +850,12 @@ BitmapToPostscript( double x, y; int width, height, rowsAtOnce, rowsThisTime; int curRow; - char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4]; XColor *fgColor; XColor *bgColor; Pixmap bitmap; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -913,18 +911,29 @@ BitmapToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Color the background, if there is one. */ if (bgColor != NULL) { - sprintf(buffer, - "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n", - x, y, width, height, -width, "0 rlineto closepath"); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto " + "%d 0 rlineto closepath\n", + x, y, width, height, -width); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, bgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "fill\n", -1); } /* @@ -935,37 +944,61 @@ BitmapToPostscript( */ if (fgColor != NULL) { + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (width > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't generate Postscript", - " for bitmaps more than 60000 pixels wide", NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't generate Postscript for bitmaps more than 60000" + " pixels wide", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + goto error; } + rowsAtOnce = 60000/width; if (rowsAtOnce < 1) { rowsAtOnce = 1; } - sprintf(buffer, "%.15g %.15g translate\n", x, y+height); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y+height); + for (curRow = 0; curRow < height; curRow += rowsAtOnce) { rowsThisTime = rowsAtOnce; if (rowsThisTime > (height - curRow)) { rowsThisTime = height - curRow; } - sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n", + + Tcl_AppendPrintfToObj(psObj, + "0 -%.15g translate\n%d %d true matrix {\n", (double) rowsThisTime, width, rowsThisTime); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_ResetResult(interp); if (Tk_CanvasPsBitmap(interp, canvas, bitmap, 0, curRow, width, rowsThisTime) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "\n} imagemask\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "\n} imagemask\n", -1); } } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c index 880070b..899741a 100644 --- a/generic/tkCanvImg.c +++ b/generic/tkCanvImg.c @@ -232,37 +232,35 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", + NULL); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &imgPtr->x) != TCL_OK) + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], + &imgPtr->x) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &imgPtr->y) != TCL_OK)) { return TCL_ERROR; } 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", NULL); return TCL_ERROR; } return TCL_OK; @@ -697,14 +695,12 @@ ImageToPostscript( { ImageItem *imgPtr = (ImageItem *) itemPtr; Tk_Window canvasWin = Tk_CanvasTkwin(canvas); - - char buffer[256]; double x, y; int width, height; Tk_Image image; Tk_State state = itemPtr->state; - if(state == TK_STATE_NULL) { + if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; } @@ -748,8 +744,14 @@ ImageToPostscript( } if (!prepass) { - sprintf(buffer, "%.15g %.15g", x, y); - Tcl_AppendResult(interp, buffer, " translate\n", NULL); + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y); } return Tk_PostscriptImage(image, interp, canvasWin, diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index 20a391e..9d68c37 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.c @@ -75,7 +75,7 @@ typedef struct LineItem { static int ArrowheadPostscript(Tcl_Interp *interp, Tk_Canvas canvas, LineItem *linePtr, - double *arrowPtr); + double *arrowPtr, Tcl_Obj *psObj); static void ComputeLineBbox(Tk_Canvas canvas, LineItem *linePtr); static int ConfigureLine(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, @@ -391,54 +391,52 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL); 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL); 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; } @@ -1752,15 +1750,7 @@ GetLineIndex( if (strncmp(string, "end", (unsigned) length) == 0) { *indexPtr = 2*linePtr->numPoints; } else { - /* - * Some of the paths here leave messages in interp->result, so we - * have to clear it out before storing our own message. - */ - - badIndex: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad index \"", string, "\"", NULL); - return TCL_ERROR; + goto badIndex; } } else if (string[0] == '@') { int i; @@ -1801,6 +1791,17 @@ GetLineIndex( } } return TCL_OK; + + /* + * Some of the paths here leave messages in interp->result, so we have to + * clear it out before storing our own message. + */ + + badIndex: + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "LINE", NULL); + return TCL_ERROR; } /* @@ -1894,16 +1895,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 +1906,23 @@ 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_SetObjResult(interp, Tcl_ObjPrintf( + "bad arrow shape \"%s\": must be list with three numbers", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW_SHAPE", NULL); + if (argv != NULL) { + ckfree(argv); + } + return TCL_ERROR; } /* @@ -2014,8 +2019,10 @@ ArrowParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad arrow spec \"", value, - "\": must be none, first, last, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad arrow spec \"%s\": must be none, first, last, or both", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW", NULL); *arrowPtr = ARROWS_NONE; return TCL_ERROR; } @@ -2252,13 +2259,13 @@ LineToPostscript( * being created. */ { LineItem *linePtr = (LineItem *) itemPtr; - char buffer[64 + TCL_INTEGER_SPACE]; - const char *style; - + int style; double width; XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -2293,30 +2300,50 @@ LineToPostscript( return TCL_OK; } + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Check if we're just doing a "pixel". + */ + if (linePtr->numPoints == 1) { - sprintf(buffer, "%.15g %.15g translate %.15g %.15g", + Tcl_AppendToObj(psObj, "matrix currentmatrix\n", -1); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate %.15g %.15g", linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]), width/2.0, width/2.0); - Tcl_AppendResult(interp, "matrix currentmatrix\n", buffer, - " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", NULL); + Tcl_AppendToObj(psObj, + " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } + /* * Generate a path for the line's center-line (do this differently for * straight lines and smoothed lines). */ + Tcl_ResetResult(interp); if ((!linePtr->smooth) || (linePtr->numPoints < 3)) { Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints); } else if ((stipple == None) && linePtr->smooth->postscriptProc) { @@ -2348,29 +2375,34 @@ LineToPostscript( ckfree(pointPtr); } } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Set other line-drawing parameters and stroke out the line. */ - style = "0 setlinecap\n"; if (linePtr->capStyle == CapRound) { - style = "1 setlinecap\n"; + style = 1; } else if (linePtr->capStyle == CapProjecting) { - style = "2 setlinecap\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); - style = "0 setlinejoin\n"; + Tcl_AppendPrintfToObj(psObj, "%d setlinecap\n", style); if (linePtr->joinStyle == JoinRound) { - style = "1 setlinejoin\n"; + style = 1; } else if (linePtr->joinStyle == JoinBevel) { - style = "2 setlinejoin\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin\n", style); + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &linePtr->outline) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Output polygons for the arrowheads, if there are any. @@ -2378,23 +2410,37 @@ LineToPostscript( if (linePtr->firstArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->firstArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->firstArrowPtr, psObj) != TCL_OK) { + goto error; } } if (linePtr->lastArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->lastArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->lastArrowPtr, psObj) != TCL_OK) { + goto error; } } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2409,7 +2455,7 @@ LineToPostscript( * The return value is a standard Tcl result. If an error occurs in * generating Postscript then an error message is left in the interp's * result, replacing whatever used to be there. If no error occurs, then - * Postscript for the arrowhead is appended to the result. + * Postscript for the arrowhead is appended to the given object. * * Side effects: * None. @@ -2419,12 +2465,14 @@ LineToPostscript( static int ArrowheadPostscript( - Tcl_Interp *interp, /* Leave Postscript or error message here. */ + Tcl_Interp *interp, /* Leave error message here; non-error results + * will be discarded by caller. */ Tk_Canvas canvas, /* Information about overall canvas. */ LineItem *linePtr, /* Line item for which Postscript is being * generated. */ - double *arrowPtr) /* Pointer to first of five points describing + double *arrowPtr, /* Pointer to first of five points describing * arrowhead polygon. */ + Tcl_Obj *psObj) /* Append postscript to this object. */ { Pixmap stipple; Tk_State state = linePtr->header.state; @@ -2444,14 +2492,20 @@ ArrowheadPostscript( } } + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } return TCL_OK; } diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c index 943ef0b..f8ea42b 100644 --- a/generic/tkCanvPoly.c +++ b/generic/tkCanvPoly.c @@ -359,6 +359,7 @@ PolygonCoords( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected an even number, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "POLYGON", NULL); return TCL_ERROR; } @@ -1731,6 +1732,7 @@ GetPolygonIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "POLY", NULL); return TCL_ERROR; } @@ -1799,13 +1801,15 @@ PolygonToPostscript( * being created. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - const char *style; + int style; XColor *color; XColor *fillColor; Pixmap stipple; Pixmap fillStipple; Tk_State state = itemPtr->state; double width; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (polyPtr->numPoints < 2 || polyPtr->coordPtr == NULL) { return TCL_OK; @@ -1852,9 +1856,17 @@ PolygonToPostscript( fillStipple = polyPtr->disabledFillStipple; } } + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + if (polyPtr->numPoints == 2) { if (color == NULL) { - return TCL_OK; + goto done; } /* @@ -1862,7 +1874,7 @@ PolygonToPostscript( * tiny to be used directly...) */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + Tcl_AppendPrintfToObj(psObj, "matrix currentmatrix\n" /* save state */ "%.15g %.15g translate " /* go to drawing location */ "%.15g %.15g scale " /* scale the drawing */ @@ -1871,24 +1883,30 @@ PolygonToPostscript( "setmatrix\n", /* restore state */ polyPtr->coordPtr[0], Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]), - width/2.0, width/2.0)); + width/2.0, width/2.0); /* * Color it in. */ + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } /* @@ -1896,6 +1914,7 @@ PolygonToPostscript( */ if (fillColor != NULL && polyPtr->numPoints > 3) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1904,18 +1923,24 @@ PolygonToPostscript( polyPtr->numPoints, polyPtr->splineSteps); } if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "eoclip ", NULL); + Tcl_AppendToObj(psObj, "eoclip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "eofill\n", NULL); + Tcl_AppendToObj(psObj, "eofill\n", -1); } } @@ -1924,6 +1949,7 @@ PolygonToPostscript( */ if (color != NULL) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1931,20 +1957,38 @@ PolygonToPostscript( polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints, polyPtr->splineSteps); } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (polyPtr->joinStyle == JoinRound) { - style = "1"; + style = 1; } else if (polyPtr->joinStyle == JoinBevel) { - style = "2"; + style = 2; } else { - style = "0"; + style = 0; } - Tcl_AppendResult(interp, style, " setlinejoin 1 setlinecap\n", NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin 1 setlinecap\n", style); + + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &polyPtr->outline) != TCL_OK){ - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index eafc07f..6542864 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -134,6 +134,10 @@ static const Tk_ConfigSpec configSpecs[] = { static int GetPostscriptPoints(Tcl_Interp *interp, char *string, double *doublePtr); +static void PostscriptBitmap(Tk_Window tkwin, Pixmap bitmap, + int startX, int startY, int width, int height, + Tcl_Obj *psObj); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); /* *-------------------------------------------------------------- @@ -166,9 +170,9 @@ TkCanvPostscriptCmd( TkPostscriptInfo psInfo, *psInfoPtr = &psInfo; Tk_PostscriptInfo oldInfoPtr; int result; + int written; Tk_Item *itemPtr; #define STRING_LENGTH 400 - char string[STRING_LENGTH+1]; const char *p; time_t now; size_t length; @@ -177,6 +181,7 @@ TkCanvPostscriptCmd( Tcl_HashEntry *hPtr; Tcl_DString buffer; Tcl_Obj *preambleObj; + Tcl_Obj *psObj; int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be * marked up, measured in canvas units from * the positioning point on the page (reflects @@ -200,6 +205,7 @@ TkCanvPostscriptCmd( } Tcl_IncrRefCount(preambleObj); Tcl_ResetResult(interp); + psObj = Tcl_NewObj(); /* * Initialize the data structure describing Postscript generation, then @@ -321,8 +327,11 @@ TkCanvPostscriptCmd( } else if (strncmp(psInfo.colorMode, "color", length) == 0) { psInfo.colorLevel = 2; } else { - Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode, - "\": must be monochrome, gray, or color", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad color mode \"%s\": must be monochrome, gray, or color", + psInfo.colorMode)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "COLORMODE", NULL); + result = TCL_ERROR; goto cleanup; } } @@ -333,8 +342,9 @@ TkCanvPostscriptCmd( */ if (psInfo.channelName != NULL) { - Tcl_AppendResult(interp, "can't specify both -file", - " and -channel", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify both -file and -channel", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", NULL); result = TCL_ERROR; goto cleanup; } @@ -345,8 +355,9 @@ TkCanvPostscriptCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify -file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify -file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PS_FILE", NULL); result = TCL_ERROR; goto cleanup; } @@ -375,9 +386,11 @@ TkCanvPostscriptCmd( result = TCL_ERROR; goto cleanup; } - if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", psInfo.channelName, - "\" wasn't opened for writing", NULL); + if (!(mode & TCL_WRITABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel \"%s\" wasn't opened for writing", + psInfo.channelName)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "UNWRITABLE",NULL); result = TCL_ERROR; goto cleanup; } @@ -422,24 +435,27 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", - "%%Creator: Tk Canvas Widget\n", NULL); + Tcl_AppendToObj(psObj, + "%!PS-Adobe-3.0 EPSF-3.0\n" + "%%Creator: Tk Canvas Widget\n", -1); + #ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ - Tcl_AppendResult(interp, "%%For: ", - (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%For: %s\n", (pwPtr ? pwPtr->pw_gecos : "Unknown")); endpwent(); } #endif /* HAVE_PW_GECOS */ - Tcl_AppendResult(interp, "%%Title: Window ", Tk_PathName(tkwin), "\n", - NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%Title: Window %s\n", Tk_PathName(tkwin)); time(&now); - Tcl_AppendResult(interp, "%%CreationDate: ", - ctime(&now), NULL); /* INTL: Native. */ + Tcl_AppendPrintfToObj(psObj, + "%%%%CreationDate: %s", ctime(&now)); /* INTL: Native. */ if (!psInfo.rotate) { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX + psInfo.scale*deltaX), (int) (psInfo.pageY + psInfo.scale*deltaY), (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) @@ -447,50 +463,61 @@ TkCanvPostscriptCmd( (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) + 1.0)); } else { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX - psInfo.scale*(deltaY+psInfo.height)), (int) (psInfo.pageY + psInfo.scale*deltaX), (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + 1.0)); } - Tcl_AppendResult(interp, "%%BoundingBox: ", string, "\n", NULL); - Tcl_AppendResult(interp, "%%Pages: 1\n", - "%%DocumentData: Clean7Bit\n", NULL); - Tcl_AppendResult(interp, "%%Orientation: ", - psInfo.rotate ? "Landscape\n" : "Portrait\n", NULL); - p = "%%DocumentNeededResources: font "; + Tcl_AppendPrintfToObj(psObj, + "%%%%Pages: 1\n" + "%%%%DocumentData: Clean7Bit\n" + "%%%%Orientation: %s\n", + psInfo.rotate ? "Landscape" : "Portrait"); + p = "%%%%DocumentNeededResources: font %s\n"; for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, p, - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); - p = "%%+ font "; + Tcl_AppendPrintfToObj(psObj, p, + Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + p = "%%%%+ font %s\n"; } - Tcl_AppendResult(interp, "%%EndComments\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndComments\n\n", -1); /* * Insert the prolog */ - Tcl_AppendResult(interp, Tcl_GetString(preambleObj), NULL); + Tcl_AppendObjToObj(psObj, preambleObj); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + channelWriteFailed: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "problem writing postscript data to channel: %s", + Tcl_PosixError(interp))); + result = TCL_ERROR; + goto cleanup; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } /* * Document setup: set the color level and include fonts. */ - sprintf(string, "/CL %d def\n", psInfo.colorLevel); - Tcl_AppendResult(interp, "%%BeginSetup\n", string, NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%BeginSetup\n/CL %d def\n", psInfo.colorLevel); for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, "%%IncludeResource: font ", - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%IncludeResource: font %s\n", + (char *) Tcl_GetHashKey(&psInfo.fontTable, hPtr)); } - Tcl_AppendResult(interp, "%%EndSetup\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndSetup\n\n", -1); /* * Page setup: move to page positioning point, rotate if needed, set @@ -498,18 +525,19 @@ TkCanvPostscriptCmd( * region. */ - Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", NULL); - sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendToObj(psObj, "%%Page: 1 1\nsave\n", -1); + Tcl_AppendPrintfToObj(psObj, + "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); if (psInfo.rotate) { - Tcl_AppendResult(interp, "90 rotate\n", NULL); + Tcl_AppendToObj(psObj, "90 rotate\n", -1); } - sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, - "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", + Tcl_AppendPrintfToObj(psObj, + "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); + Tcl_AppendPrintfToObj(psObj, + "%d %d translate\n", deltaX - psInfo.x, deltaY); + Tcl_AppendPrintfToObj(psObj, + "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g " + "lineto closepath clip newpath\n", psInfo.x, Tk_PostscriptY((double)psInfo.y, (Tk_PostscriptInfo)psInfoPtr), psInfo.x2, Tk_PostscriptY((double)psInfo.y, @@ -518,12 +546,14 @@ TkCanvPostscriptCmd( (Tk_PostscriptInfo)psInfoPtr), psInfo.x, Tk_PostscriptY((double)psInfo.y2, (Tk_PostscriptInfo)psInfoPtr)); - Tcl_AppendResult(interp, string, - " lineto closepath clip newpath\n", NULL); - } - if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + if (psInfo.chan != NULL) { + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); + } } /* @@ -544,21 +574,28 @@ TkCanvPostscriptCmd( if (itemPtr->state == TK_STATE_HIDDEN) { continue; } - Tcl_AppendResult(interp, "gsave\n", NULL); + + Tcl_ResetResult(interp); 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); + + Tcl_AppendToObj(psObj, "gsave\n", -1); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "grestore\n", -1); + if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(interp); + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } } @@ -568,12 +605,23 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "restore showpage\n\n", - "%%Trailer\nend\n%%EOF\n", NULL); + Tcl_AppendToObj(psObj, + "restore showpage\n\n" + "%%Trailer\n" + "end\n" + "%%EOF\n", -1); + + if (psInfo.chan != NULL) { + Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + } } - if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + + if (psInfo.chan == NULL) { + Tcl_SetObjResult(interp, psObj); + psObj = Tcl_NewObj(); } /* @@ -614,9 +662,23 @@ TkCanvPostscriptCmd( Tcl_DeleteHashTable(&psInfo.fontTable); canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; Tcl_DecrRefCount(preambleObj); + Tcl_DecrRefCount(psObj); return result; } +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *-------------------------------------------------------------- * @@ -645,9 +707,7 @@ Tk_PostscriptColor( XColor *colorPtr) /* Information about color. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - int tmp; double red, green, blue; - char string[200]; if (psInfoPtr->prepass) { return TCL_OK; @@ -659,12 +719,12 @@ Tk_PostscriptColor( */ if (psInfoPtr->colorVar != NULL) { - const char *cmdString; - - cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + const char *cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, Tk_NameOfColor(colorPtr), 0); + if (cmdString != NULL) { - Tcl_AppendResult(interp, cmdString, "\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%s\n", cmdString); return TCL_OK; } } @@ -681,15 +741,12 @@ Tk_PostscriptColor( * per color, but most diplays use at least 8 bits. */ - tmp = colorPtr->red; - red = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->green; - green = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->blue; - blue = ((double) (tmp >> 8))/255.0; - sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", + red = ((double) (((int) colorPtr->red) >> 8))/255.0; + green = ((double) (((int) colorPtr->green) >> 8))/255.0; + blue = ((double) (((int) colorPtr->blue) >> 8))/255.0; + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%.3f %.3f %.3f setrgbcolor AdjustColor\n", red, green, blue); - Tcl_AppendResult(interp, string, NULL); return TCL_OK; } @@ -723,9 +780,9 @@ Tk_PostscriptFont( * be printed. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; + const char *fontname; /* * First, look up the font's name in the font map, if there is one. If @@ -741,28 +798,24 @@ Tk_PostscriptFont( Tcl_Obj *list = Tcl_GetVar2Ex(interp, psInfoPtr->fontVar, name, 0); if (list != NULL) { - const char *fontname; - if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK || objc != 2 - || Tcl_GetString(objv[0])[0] == '\0' + || (fontname = Tcl_GetString(objv[0]))[0] == '\0' + || strchr(fontname, ' ') != NULL || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK || size <= 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad font map entry for \"", name, - "\": \"", Tcl_GetString(list), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad font map entry for \"%s\": \"%s\"", + name, Tcl_GetString(list))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "FONTMAP", + NULL); return TCL_ERROR; } - fontname = Tcl_GetString(objv[0]); - sprintf(pointString, "%d", (int) size); - - Tcl_AppendResult(interp, "/", fontname, " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(fontname, "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, (int) size, + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontname, &i); return TCL_OK; } @@ -774,13 +827,11 @@ Tk_PostscriptFont( Tcl_DStringInit(&ds); points = Tk_PostscriptFontName(tkfont, &ds); - sprintf(pointString, "%d", TkFontGetPoints(psInfoPtr->tkwin, points)); - Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + fontname = Tcl_DStringValue(&ds); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, TkFontGetPoints(psInfoPtr->tkwin, points), + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); Tcl_DStringFree(&ds); @@ -818,18 +869,32 @@ Tk_PostscriptBitmap( int width, int height) /* Height of rectangular region. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + PostscriptBitmap(tkwin, bitmap, startX, startY, width, height, + GetPostscriptBuffer(interp)); + return TCL_OK; +} + +static void +PostscriptBitmap( + Tk_Window tkwin, + Pixmap bitmap, /* Bitmap for which to generate Postscript. */ + int startX, int startY, /* Coordinates of upper-left corner of + * rectangular region to output. */ + int width, int height, /* Height of rectangular region. */ + Tcl_Obj *psObj) /* Where to append the postscript. */ +{ XImage *imagePtr; int charsInLine, x, y, lastX, lastY, value, mask; unsigned int totalWidth, totalHeight; - char string[100]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; - if (psInfoPtr->prepass) { - return TCL_OK; - } - /* * The following call should probably be a call to Tk_SizeOfBitmap * instead, but it seems that we are occasionally invoked by custom item @@ -843,7 +908,8 @@ Tk_PostscriptBitmap( (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); - Tcl_AppendResult(interp, "<", NULL); + + Tcl_AppendToObj(psObj, "<", -1); mask = 0x80; value = 0; charsInLine = 0; @@ -856,28 +922,26 @@ Tk_PostscriptBitmap( } mask >>= 1; if (mask == 0) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; if (charsInLine >= 60) { - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); charsInLine = 0; } } } if (mask != 0x80) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; } } - Tcl_AppendResult(interp, ">", NULL); + Tcl_AppendToObj(psObj, ">", -1); + XDestroyImage(imagePtr); - return TCL_OK; } /* @@ -912,10 +976,10 @@ Tk_PostscriptStipple( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int width, height; - char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -932,13 +996,11 @@ Tk_PostscriptStipple( XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, (unsigned *) &height, &dummyBorderwidth, &dummyDepth); - sprintf(string, "%d %d ", width, height); - Tcl_AppendResult(interp, string, NULL); - if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, - width, height) != TCL_OK) { - return TCL_ERROR; - } - Tcl_AppendResult(interp, " StippleFill\n", NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%d %d ", width, height); + PostscriptBitmap(tkwin, bitmap, 0, 0, width, height, psObj); + Tcl_AppendToObj(psObj, " StippleFill\n", -1); return TCL_OK; } @@ -998,19 +1060,19 @@ Tk_PostscriptPath( int numPoints) /* Number of points at *coordPtr. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[200]; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return; } - sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g moveto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); for (numPoints--, coordPtr += 2; numPoints > 0; numPoints--, coordPtr += 2) { - sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); } } @@ -1081,7 +1143,8 @@ GetPostscriptPoints( return TCL_OK; error: - Tcl_AppendResult(interp, "bad distance \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "POINTS", NULL); return TCL_ERROR; } @@ -1195,15 +1258,15 @@ TkPostscriptImage( int width, int height) /* Width and height of area */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[256]; int xx, yy, band, maxRows; double red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; int level = psInfoPtr->colorLevel; Colormap cmap; int i, ncolors; Visual *visual; TkColormapData cdata; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1289,15 +1352,16 @@ TkPostscriptImage( if (bytesPerLine > 60000) { Tcl_ResetResult(interp); - sprintf(buffer, - "Can't generate Postscript for images more than %d pixels wide", - maxWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); ckfree(cdata.colors); return TCL_ERROR; } maxRows = 60000 / bytesPerLine; + psObj = GetPostscriptBuffer(interp); for (band = height-1; band >= 0; band -= maxRows) { int rows = (band >= maxRows) ? maxRows : band + 1; @@ -1305,16 +1369,13 @@ TkPostscriptImage( switch (level) { case 0: - sprintf(buffer, "%d %d 1 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 1 matrix {\n<", width, rows); break; case 1: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; default: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; } for (yy = band; yy > band - rows; yy--) { @@ -1336,22 +1397,20 @@ TkPostscriptImage( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - mask=0x80; - data=0x00; + mask = 0x80; + data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); - mask=0x80; - data=0x00; + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; } break; } @@ -1364,13 +1423,13 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx ++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 * + Tcl_AppendPrintfToObj(psObj, "%02X", + (int) floor(0.5 + 255.0 * (0.30 * red + 0.59 * green + 0.11 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1383,15 +1442,14 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", (int) floor(0.5 + 255.0 * red), (int) floor(0.5 + 255.0 * green), (int) floor(0.5 + 255.0 * blue)); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1399,13 +1457,11 @@ TkPostscriptImage( } switch (level) { case 0: case 1: - sprintf(buffer, ">\n} image\n"); break; + Tcl_AppendToObj(psObj, ">\n} image\n", -1); break; default: - sprintf(buffer, ">\n} false 3 colorimage\n"); break; + Tcl_AppendToObj(psObj, ">\n} false 3 colorimage\n", -1); break; } - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 %d translate\n", rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "0 %d translate\n", rows); } ckfree(cdata.colors); return TCL_OK; @@ -1441,15 +1497,15 @@ Tk_PostscriptPhoto( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int colorLevel = psInfoPtr->colorLevel; - const char *displayOperation; + const char *displayOperation, *decode; unsigned char *pixelPtr; - char buffer[256], cspace[40], decode[40]; int bpc, xx, yy, lineLen, alpha; float red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; unsigned char opaque = 255; unsigned char *alphaPtr; int alphaOffset, alphaPitch, alphaIncr; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1482,10 +1538,10 @@ Tk_PostscriptPhoto( } if (bytesPerLine > 60000) { Tcl_ResetResult(interp); - sprintf(buffer, - "Can't generate Postscript for images more than %d pixels wide", - maxWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); return TCL_ERROR; } @@ -1493,35 +1549,32 @@ Tk_PostscriptPhoto( * Set up the postscript code except for the image-data stream. */ + psObj = GetPostscriptBuffer(interp); switch (colorLevel) { case 0: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[1 0]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "1 0"; bpc = 1; break; case 1: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[0 1]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "0 1"; bpc = 8; break; default: - strcpy(cspace, "/DeviceRGB"); - strcpy(decode, "[0 1 0 1 0 1]"); + Tcl_AppendToObj(psObj, "/DeviceRGB setcolorspace\n\n", -1); + decode = "0 1 0 1 0 1"; bpc = 8; break; } - - Tcl_AppendResult(interp, cspace, " setcolorspace\n\n", NULL); - - sprintf(buffer, " /Width %d\n /Height %d\n /BitsPerComponent %d\n", - width, height, bpc); - Tcl_AppendResult(interp, "<<\n /ImageType 1\n", buffer, - " /DataSource currentfile /ASCIIHexDecode filter\n", NULL); - - sprintf(buffer, " /ImageMatrix [1 0 0 -1 0 %d]\n", height); - Tcl_AppendResult(interp, buffer, " /Decode ", decode, "\n>>\n1 ", - displayOperation, "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "<<\n /ImageType 1\n" + " /Width %d\n /Height %d\n /BitsPerComponent %d\n" + " /DataSource currentfile\n /ASCIIHexDecode filter\n" + " /ImageMatrix [1 0 0 -1 0 %d]\n /Decode [%s]\n>>\n" + "1 %s\n", + width, height, bpc, height, decode, displayOperation); /* * Check the PhotoImageBlock information. We assume that: @@ -1581,20 +1634,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1622,20 +1673,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1650,12 +1699,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1672,13 +1720,12 @@ Tk_PostscriptPhoto( green = pixelPtr[blockPtr->offset[1]]; blue = pixelPtr[blockPtr->offset[2]]; - sprintf(buffer, "%02X", (int) floor(0.5 + + Tcl_AppendPrintfToObj(psObj, "%02X", (int) floor(0.5 + ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1692,12 +1739,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1710,22 +1756,25 @@ Tk_PostscriptPhoto( pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + (xx * blockPtr->pixelSize); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", pixelPtr[blockPtr->offset[0]], pixelPtr[blockPtr->offset[1]], pixelPtr[blockPtr->offset[2]]); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; } } - Tcl_AppendResult(interp, ">\n", NULL); + /* + * The end-of-data marker. + */ + + Tcl_AppendToObj(psObj, ">\n", -1); return TCL_OK; } diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 0861a21..eb8dfe3 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -338,29 +338,32 @@ TextCoords( subobj = Tcl_NewDoubleObj(textPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } 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) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # coordinates: expected 2, got %d", objc)); - return TCL_ERROR; - } - } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], - &textPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], - &textPtr->y) != TCL_OK)) { - return TCL_ERROR; - } - ComputeTextBbox(canvas, textPtr); - } else { + return TCL_OK; + } else if (objc > 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); + return TCL_ERROR; + } + + if (objc == 1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { + return TCL_ERROR; + } else if (objc != 2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); + return TCL_ERROR; + } + } + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], + &textPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], + &textPtr->y) != TCL_OK)) { return TCL_ERROR; } + ComputeTextBbox(canvas, textPtr); return TCL_OK; } @@ -1356,14 +1359,18 @@ GetTextIndex( } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.first", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } *indexPtr = textInfoPtr->selectFirst; } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.last", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } *indexPtr = textInfoPtr->selectLast; @@ -1403,6 +1410,7 @@ GetTextIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "TEXT", NULL); return TCL_ERROR; } return TCL_OK; @@ -1536,6 +1544,8 @@ TextToPostscript( XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -1561,26 +1571,40 @@ TextToPostscript( } } + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Generate postscript. + */ + + Tcl_ResetResult(interp); if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (prepass != 0) { - return TCL_OK; + goto done; } + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "/StippleText {\n ", NULL); + Tcl_ResetResult(interp); Tk_CanvasPsStipple(interp, canvas, stipple); - Tcl_AppendResult(interp, "} bind def\n", NULL); + Tcl_AppendPrintfToObj(psObj, "/StippleText {\n %s} bind def\n", + Tcl_GetString(Tcl_GetObjResult(interp))); } - Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%.15g %.15g %.15g [\n", - textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); - - Tk_TextLayoutToPostscript(interp, textPtr->textLayout); - x = 0; y = 0; justify = NULL; /* lint. */ switch (textPtr->anchor) { case TK_ANCHOR_NW: x = 0; y = 0; break; @@ -1600,12 +1624,31 @@ TextToPostscript( } Tk_GetFontMetrics(textPtr->tkfont, &fm); - Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g %.15g [\n", + textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); + Tcl_ResetResult(interp); + Tk_TextLayoutToPostscript(interp, textPtr->textLayout); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendPrintfToObj(psObj, "] %d %g %g %s %s DrawText\n", fm.linespace, x / -2.0, y / 2.0, justify, ((stipple == None) ? "false" : "true")); + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index 1a6a8c4..23c73e5 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -49,9 +49,23 @@ static int DashConvert(char *l, const char *p, int n, double width); static void TranslateAndAppendCoords(TkCanvas *canvPtr, double x, double y, XPoint *outArr, int numOut); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); #define ABS(a) ((a>=0)?(a):(-(a))) +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *---------------------------------------------------------------------- * @@ -756,8 +770,10 @@ TkSmoothParseProc( while (methods != NULL) { if (strncmp(value, methods->smooth.name, length) == 0) { if (smooth != NULL) { - Tcl_AppendResult(interp, "ambiguous smooth method \"", value, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous smooth method \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "SMOOTH", value, + NULL); return TCL_ERROR; } smooth = &methods->smooth; @@ -878,7 +894,7 @@ Tk_GetDash( if ((unsigned) ABS(dash->number) > sizeof(char *)) { ckfree(dash->pattern.pt); } - if (argc > (int)sizeof(char *)) { + if (argc > (int) sizeof(char *)) { dash->pattern.pt = pt = ckalloc(argc); } else { pt = dash->pattern.array; @@ -886,12 +902,12 @@ Tk_GetDash( dash->number = argc; largv = argv; - while (argc>0) { + while (argc > 0) { if (Tcl_GetInt(interp, *largv, &i) != TCL_OK || i < 1 || i>255) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "expected integer in the range 1..255 but got \"", - *largv, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer in the range 1..255 but got \"%s\"", + *largv)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL); goto syntaxError; } *pt++ = i; @@ -909,8 +925,10 @@ Tk_GetDash( */ badDashList: - Tcl_AppendResult(interp, "bad dash list \"", value, - "\": must be a list of integers or a format like \"-..\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad dash list \"%s\": must be a list of integers or a format like \"-..\"", + value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL); syntaxError: if (argv != NULL) { ckfree(argv); @@ -1252,9 +1270,9 @@ Tk_ChangeOutlineGC( * * Tk_ResetOutlineGC * - * Restores the GC to the situation before Tk_ChangeOutlineGC() was called. - * This function should be called just after the dashed item is drawn, - * because the GC is supposed to be read-only. + * Restores the GC to the situation before Tk_ChangeOutlineGC() was + * called. This function should be called just after the dashed item is + * drawn, because the GC is supposed to be read-only. * * Results: * 1 if there is a stipple pattern, and 0 otherwise. @@ -1361,15 +1379,16 @@ Tk_CanvasPsOutline( Tk_Item *item, Tk_Outline *outline) { - char string[41], pattern[11]; + char pattern[11]; int i; - char *ptr, *str = string, *lptr = pattern; + char *ptr, *lptr = pattern; Tcl_Interp *interp = Canvas(canvas)->interp; double width = outline->width; Tk_Dash *dash = &outline->dash; XColor *color = outline->color; Pixmap stipple = outline->stipple; Tk_State state = item->state; + Tcl_Obj *psObj = GetPostscriptBuffer(interp); if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -1380,7 +1399,7 @@ Tk_CanvasPsOutline( width = outline->activeWidth; } if (outline->activeDash.number > 0) { - dash = &(outline->activeDash); + dash = &outline->activeDash; } if (outline->activeColor != NULL) { color = outline->activeColor; @@ -1393,7 +1412,7 @@ Tk_CanvasPsOutline( width = outline->disabledWidth; } if (outline->disabledDash.number > 0) { - dash = &(outline->disabledDash); + dash = &outline->disabledDash; } if (outline->disabledColor != NULL) { color = outline->disabledColor; @@ -1402,66 +1421,65 @@ Tk_CanvasPsOutline( stipple = outline->disabledStipple; } } - sprintf(string, "%.15g setlinewidth\n", width); - Tcl_AppendResult(interp, string, NULL); - if (dash->number > 10) { - str = ckalloc(1 + 4*dash->number); - } else if (dash->number < -5) { - str = ckalloc(1 - 8*dash->number); - lptr = ckalloc(1 - 2*dash->number); - } + Tcl_AppendPrintfToObj(psObj, "%.15g setlinewidth\n", width); + ptr = ((unsigned) ABS(dash->number) > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; + Tcl_AppendToObj(psObj, "[", -1); if (dash->number > 0) { - char *ptr0 = ptr; + Tcl_Obj *converted; + char *p = ptr; - sprintf(str, "[%d", *ptr++ & 0xff); - i = dash->number-1; - while (i--) { - sprintf(str+strlen(str), " %d", *ptr++ & 0xff); + converted = Tcl_ObjPrintf("%d", *p++ & 0xff); + for (i = dash->number-1 ; i>=0 ; i--) { + Tcl_AppendPrintfToObj(converted, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - if (dash->number&1) { - Tcl_AppendResult(interp, " ", str+1, NULL); + Tcl_AppendObjToObj(psObj, converted); + if (dash->number & 1) { + Tcl_AppendToObj(psObj, " ", -1); + Tcl_AppendObjToObj(psObj, converted); } - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - ptr = ptr0; + Tcl_DecrRefCount(converted); + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else if (dash->number < 0) { - if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) { - char *lptr0 = lptr; + if (dash->number < -5) { + lptr = ckalloc(1 - 2*dash->number); + } + i = DashConvert(lptr, ptr, -dash->number, width); + if (i > 0) { + char *p = lptr; - sprintf(str, "[%d", *lptr++ & 0xff); - while (--i) { - sprintf(str+strlen(str), " %d", *lptr++ & 0xff); + Tcl_AppendPrintfToObj(psObj, "%d", *p++ & 0xff); + for (; --i>0 ;) { + Tcl_AppendPrintfToObj(psObj, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - lptr = lptr0; + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); + } + if (lptr != pattern) { + ckfree(lptr); } } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); - } - if (str != string) { - ckfree(str); - } - if (lptr != pattern) { - ckfree(lptr); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); } + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { return TCL_ERROR; } + + /* + * Note that psObj might hold an invalid reference now. + */ + if (stipple != None) { - Tcl_AppendResult(interp, "StrokeClip ", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "StrokeClip ", -1); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "stroke\n", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "stroke\n", -1); } return TCL_OK; @@ -1731,7 +1749,7 @@ TkCanvTranslatePath( * This is the loop that makes the four passes through the data. */ - for (j=0; j<4; j++){ + for (j=0; j<4; j++) { double xClip = limit[j]; int inside = a[0] < xClip; double priorY = a[1]; @@ -1742,7 +1760,7 @@ TkCanvTranslatePath( * rotated by 90 degrees clockwise. */ - for (i=0; i<numVertex; i++){ + for (i=0; i<numVertex; i++) { double x = a[i*2]; double y = a[i*2 + 1]; @@ -1833,7 +1851,7 @@ TkCanvTranslatePath( * XPoints and translate the origin for the drawable. */ - for (i=0; i<numVertex; i++){ + for (i=0; i<numVertex; i++) { TranslateAndAppendCoords(canvPtr, a[i*2], a[i*2+1], outArr, i); } if (tempArr != staticSpace) { diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index f2cce7d..f183b35 100644 --- a/generic/tkCanvWind.c +++ b/generic/tkCanvWind.c @@ -246,22 +246,21 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", + NULL); return TCL_ERROR; } } @@ -272,10 +271,9 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", NULL); return TCL_ERROR; } return TCL_OK; @@ -342,8 +340,7 @@ ConfigureWinItem( */ parent = Tk_Parent(winItemPtr->tkwin); - for (ancestor = canvasTkwin; ; - ancestor = Tk_Parent(ancestor)) { + for (ancestor = canvasTkwin ;; ancestor = Tk_Parent(ancestor)) { if (ancestor == parent) { break; } @@ -375,8 +372,10 @@ ConfigureWinItem( return TCL_OK; badWindow: - Tcl_AppendResult(interp, "can't use ", Tk_PathName(winItemPtr->tkwin), - " in a window item of this canvas", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s in a window item of this canvas", + Tk_PathName(winItemPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); winItemPtr->tkwin = NULL; return TCL_ERROR; } @@ -827,45 +826,44 @@ CanvasPsWindow( double x, double y, /* origin of window. */ int width, int height) /* width/height of window. */ { - char buffer[256]; XImage *ximage; int result; - Tcl_DString buffer1, buffer2; #ifdef X_GetImage Tk_ErrorHandler handle; #endif + Tcl_Obj *cmdObj, *psObj; + Tcl_InterpState interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Locate the subwindow within the wider window. + */ - sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n", + psObj = Tcl_ObjPrintf( + "\n%%%% %s item (%s, %d x %d)\n" // Comment + "%.15g %.15g translate\n", // Position Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y); - Tcl_AppendResult(interp, buffer, NULL); /* * First try if the widget has its own "postscript" command. If it exists, * this will produce much better postscript than when a pixmap is used. */ - Tcl_DStringInit(&buffer1); - Tcl_DStringInit(&buffer2); - Tcl_DStringGetResult(interp, &buffer2); - sprintf(buffer, "%s postscript -prolog 0\n", Tk_PathName(tkwin)); - result = Tcl_Eval(interp, buffer); - Tcl_DStringGetResult(interp, &buffer1); - Tcl_DStringResult(interp, &buffer2); - Tcl_DStringFree(&buffer2); + Tcl_ResetResult(interp); + cmdObj = Tcl_ObjPrintf("%s postscript -prolog 0", Tk_PathName(tkwin)); + Tcl_IncrRefCount(cmdObj); + result = Tcl_EvalObjEx(interp, cmdObj, 0); + Tcl_DecrRefCount(cmdObj); if (result == TCL_OK) { - Tcl_AppendResult(interp, "50 dict begin\nsave\ngsave\n", NULL); - sprintf(buffer, "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d", - height, width, height, width); - Tcl_AppendResult(interp, buffer, NULL); - Tcl_AppendResult(interp, " 0 rlineto closepath\n", + Tcl_AppendPrintfToObj(psObj, + "50 dict begin\nsave\ngsave\n" + "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d 0 rlineto closepath\n" "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n", - Tcl_DStringValue(&buffer1), "\nrestore\nend\n\n\n", NULL); - Tcl_DStringFree(&buffer1); - - return result; + height, width, height, width); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "\nrestore\nend\n\n\n", -1); + goto done; } - Tcl_DStringFree(&buffer1); /* * If the window is off the screen it will generate a BadMatch/XError. We @@ -890,13 +888,27 @@ CanvasPsWindow( #endif if (ximage == NULL) { - return TCL_OK; + result = TCL_OK; + } else { + Tcl_ResetResult(interp); + result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, + ximage, 0, 0, width, height); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + XDestroyImage(ximage); } - result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, ximage, - 0, 0, width, height); + /* + * Plug the accumulated postscript back into the result. + */ - XDestroyImage(ximage); + done: + if (result == TCL_OK) { + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + } else { + Tcl_DiscardInterpState(interpState); + } + Tcl_DecrRefCount(psObj); return result; } diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 14d8261..07f1cfe 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -269,7 +269,7 @@ static int ConfigureCanvas(Tcl_Interp *interp, Tcl_Obj *const *argv, int flags); static void DestroyCanvas(char *memPtr); static void DisplayCanvas(ClientData clientData); -static void DoItem(Tcl_Interp *interp, +static void DoItem(Tcl_Obj *accumObj, Tk_Item *itemPtr, Tk_Uid tag); static void EventuallyRedrawItem(TkCanvas *canvasPtr, Tk_Item *itemPtr); @@ -333,10 +333,10 @@ static const Tk_ClassProcs canvasClass = { #ifdef USE_OLD_TAG_SEARCH #define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ - (itemPtr) = StartTagSearch(canvasPtr,(objPtr),&search) + itemPtr = StartTagSearch(canvasPtr,(objPtr),&search) #define FOR_EVERY_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ - for ((itemPtr) = StartTagSearch(canvasPtr, (objPtr), &search); \ - (itemPtr) != NULL; (itemPtr) = NextItem(&search)) + for (itemPtr = StartTagSearch(canvasPtr, (objPtr), &search); \ + itemPtr != NULL; itemPtr = NextItem(&search)) #define FIND_ITEMS(objPtr, n) \ FindItems(interp, canvasPtr, objc, objv, (objPtr), (n)) #define RELINK_ITEMS(objPtr, itemPtr) \ @@ -928,8 +928,10 @@ CanvasWidgetCmd( } if (object == NULL) { - Tcl_AppendResult(interp, "item \"", Tcl_GetString(objv[2]), - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item \"%s\" doesn't exist", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM", + Tcl_GetString(objv[2]), NULL); result = TCL_ERROR; goto done; } @@ -953,8 +955,10 @@ CanvasWidgetCmd( } if (object == 0) { - Tcl_AppendResult(interp, "item \"", Tcl_GetString(objv[2]), - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item \"%s\" doesn't exist", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM", + Tcl_GetString(objv[2]), NULL); result = TCL_ERROR; goto done; } @@ -1030,10 +1034,10 @@ CanvasWidgetCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, canvasPtr->bindingTable, object, Tcl_GetString(objv[3])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual", - " events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_EVENTS", NULL); result = TCL_ERROR; goto done; } @@ -1274,8 +1278,10 @@ CanvasWidgetCmd( Tcl_MutexUnlock(&typeListMutex); if (matchPtr == NULL) { badType: - Tcl_AppendResult(interp, - "unknown or ambiguous item type \"", arg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown or ambiguous item type \"%s\"", arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM_TYPE", arg, + NULL); result = TCL_ERROR; goto done; } @@ -1501,9 +1507,13 @@ CanvasWidgetCmd( FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); if (itemPtr != NULL) { int i; + Tcl_Obj *resultObj = Tcl_NewObj(); + for (i = 0; i < itemPtr->numTags; i++) { - Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(itemPtr->tagPtr[i], -1)); } + Tcl_SetObjResult(interp, resultObj); } break; case CANV_ICURSOR: { @@ -1545,8 +1555,10 @@ CanvasWidgetCmd( } } if (itemPtr == NULL) { - Tcl_AppendResult(interp, "can't find an indexable item \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find an indexable item \"%s\"", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "INDEXABLE_ITEM", NULL); result = TCL_ERROR; goto done; } @@ -1647,8 +1659,10 @@ CanvasWidgetCmd( } else { FIRST_CANVAS_ITEM_MATCHING(objv[3], &searchPtr, goto done); if (itemPtr == NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(objv[3]), - "\" doesn't match any items", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tagOrId \"%s\" doesn't match any items", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL); result = TCL_ERROR; goto done; } @@ -1772,8 +1786,10 @@ CanvasWidgetCmd( prevPtr = itemPtr; } if (prevPtr == NULL) { - Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetString(objv[3]), - "\" doesn't match any items", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tagOrId \"%s\" doesn't match any items", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL); result = TCL_ERROR; goto done; } @@ -1847,7 +1863,9 @@ CanvasWidgetCmd( goto done; } if ((xScale == 0.0) || (yScale == 0.0)) { - Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scale factor cannot be zero", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_SCALE", NULL); result = TCL_ERROR; goto done; } @@ -1925,9 +1943,11 @@ CanvasWidgetCmd( } } if (itemPtr == NULL) { - Tcl_AppendResult(interp, - "can't find an indexable and selectable item \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find an indexable and selectable item \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SELECTABLE_ITEM", + NULL); result = TCL_ERROR; goto done; } @@ -2019,6 +2039,7 @@ CanvasWidgetCmd( int newX = 0; /* Initialization needed only to prevent gcc * warnings. */ double fraction; + const char **args; if (objc == 2) { Tcl_SetObjResult(interp, ScrollFractions( @@ -2026,39 +2047,37 @@ CanvasWidgetCmd( canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollX1, canvasPtr->scrollX2)); - } else { - const char **args = TkGetStringsFromObjs(objc, objv); + break; + } - type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); - if (args != NULL) { - ckfree(args); - } - switch (type) { - case TK_SCROLL_ERROR: - result = TCL_ERROR; - goto done; - case TK_SCROLL_MOVETO: - newX = canvasPtr->scrollX1 - canvasPtr->inset - + (int) (fraction * (canvasPtr->scrollX2 - - canvasPtr->scrollX1) + 0.5); - break; - case TK_SCROLL_PAGES: - newX = (int) (canvasPtr->xOrigin + count * .9 + args = TkGetStringsFromObjs(objc, objv); + type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); + if (args != NULL) { + ckfree(args); + } + switch (type) { + case TK_SCROLL_ERROR: + result = TCL_ERROR; + goto done; + case TK_SCROLL_MOVETO: + newX = canvasPtr->scrollX1 - canvasPtr->inset + + (int) (fraction * (canvasPtr->scrollX2 + - canvasPtr->scrollX1) + 0.5); + break; + case TK_SCROLL_PAGES: + newX = (int) (canvasPtr->xOrigin + count * .9 + * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->xScrollIncrement > 0) { + newX = canvasPtr->xOrigin + count*canvasPtr->xScrollIncrement; + } else { + newX = (int) (canvasPtr->xOrigin + count * .1 * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); - break; - case TK_SCROLL_UNITS: - if (canvasPtr->xScrollIncrement > 0) { - newX = canvasPtr->xOrigin - + count*canvasPtr->xScrollIncrement; - } else { - newX = (int) (canvasPtr->xOrigin + count * .1 - * (Tk_Width(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - } - break; } - CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); + break; } + CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); break; } case CANV_YVIEW: { @@ -2066,6 +2085,7 @@ CanvasWidgetCmd( int newY = 0; /* Initialization needed only to prevent gcc * warnings. */ double fraction; + const char **args; if (objc == 2) { Tcl_SetObjResult(interp, ScrollFractions( @@ -2073,40 +2093,36 @@ CanvasWidgetCmd( canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollY1, canvasPtr->scrollY2)); - } else { - const char **args = TkGetStringsFromObjs(objc, objv); + break; + } - type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); - if (args != NULL) { - ckfree(args); - } - switch (type) { - case TK_SCROLL_ERROR: - result = TCL_ERROR; - goto done; - case TK_SCROLL_MOVETO: - newY = canvasPtr->scrollY1 - canvasPtr->inset - + (int) (fraction*(canvasPtr->scrollY2 - - canvasPtr->scrollY1) + 0.5); - break; - case TK_SCROLL_PAGES: - newY = (int) (canvasPtr->yOrigin + count * .9 - * (Tk_Height(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - break; - case TK_SCROLL_UNITS: - if (canvasPtr->yScrollIncrement > 0) { - newY = canvasPtr->yOrigin - + count*canvasPtr->yScrollIncrement; - } else { - newY = (int) (canvasPtr->yOrigin + count * .1 - * (Tk_Height(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - } - break; + args = TkGetStringsFromObjs(objc, objv); + type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); + if (args != NULL) { + ckfree(args); + } + switch (type) { + case TK_SCROLL_ERROR: + result = TCL_ERROR; + goto done; + case TK_SCROLL_MOVETO: + newY = canvasPtr->scrollY1 - canvasPtr->inset + (int) ( + fraction*(canvasPtr->scrollY2-canvasPtr->scrollY1) + 0.5); + break; + case TK_SCROLL_PAGES: + newY = (int) (canvasPtr->yOrigin + count * .9 + * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->yScrollIncrement > 0) { + newY = canvasPtr->yOrigin + count*canvasPtr->yScrollIncrement; + } else { + newY = (int) (canvasPtr->yOrigin + count * .1 + * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset)); } - CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); + break; } + CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); break; } } @@ -2302,8 +2318,9 @@ ConfigureCanvas( return TCL_ERROR; } if (argc2 != 4) { - Tcl_AppendResult(interp, "bad scrollRegion \"", - canvasPtr->regionString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scrollRegion \"%s\"", canvasPtr->regionString)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SCROLL_REGION", NULL); badRegion: ckfree(canvasPtr->regionString); ckfree(argv2); @@ -3583,8 +3600,10 @@ TagSearchScanExpr( case '!': /* Negate next tag or subexpr */ if (looking_for_tag > 1) { - Tcl_AppendResult(interp, - "Too many '!' in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many '!' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "COMPLEXITY", NULL); return TCL_ERROR; } looking_for_tag++; @@ -3631,15 +3650,18 @@ TagSearchScanExpr( *tag++ = c; } if (!found_endquote) { - Tcl_AppendResult(interp, - "Missing endquote in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing endquote in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "ENDQUOTE", NULL); return TCL_ERROR; } if (!(tag - searchPtr->rewritebuffer)) { - Tcl_AppendResult(interp, - "Null quoted tag string in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "null quoted tag string in tag search expression", + -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "EMPTY", NULL); return TCL_ERROR; } *tag++ = '\0'; @@ -3653,9 +3675,10 @@ TagSearchScanExpr( case '|': case '^': case ')': - Tcl_AppendResult(interp, - "Unexpected operator in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected operator in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "UNEXPECTED", NULL); return TCL_ERROR; default: /* Unquoted tag string */ @@ -3716,8 +3739,10 @@ TagSearchScanExpr( case '&': /* AND operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '&') { - Tcl_AppendResult(interp, - "Singleton '&' in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '&' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "INCOMPLETE_OP", NULL); return TCL_ERROR; } expr->uids[expr->index++] = searchUids->andUid; @@ -3727,8 +3752,10 @@ TagSearchScanExpr( case '|': /* OR operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '|') { - Tcl_AppendResult(interp, - "Singleton '|' in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '|' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "INCOMPLETE_OP", NULL); return TCL_ERROR; } expr->uids[expr->index++] = searchUids->orUid; @@ -3745,8 +3772,10 @@ TagSearchScanExpr( goto breakwhile; default: /* syntax error */ - Tcl_AppendResult(interp, - "Invalid boolean operator in tag search expression", + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid boolean operator in tag search expression", + -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "BAD_OP", NULL); return TCL_ERROR; } @@ -3757,7 +3786,9 @@ TagSearchScanExpr( if (found_tag && !looking_for_tag) { return TCL_OK; } - Tcl_AppendResult(interp, "Missing tag in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing tag in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "NO_TAG", NULL); return TCL_ERROR; } @@ -4138,23 +4169,23 @@ TagSearchNext( * DoItem -- * * This is a utility function called by FindItems. It either adds - * itemPtr's id to the result forming in interp, or it adds a new tag to + * itemPtr's id to the list being constructed, or it adds a new tag to * itemPtr, depending on the value of tag. * * Results: * None. * * Side effects: - * If tag is NULL then itemPtr's id is added as a list element to the - * interp's result; otherwise tag is added to itemPtr's list of tags. + * If tag is NULL then itemPtr's id is added as an element to the + * supplied object; otherwise tag is added to itemPtr's list of tags. * *-------------------------------------------------------------- */ static void DoItem( - Tcl_Interp *interp, /* Interpreter in which to (possibly) record - * item id. */ + Tcl_Obj *accumObj, /* Object in which to (possibly) record item + * id. */ Tk_Item *itemPtr, /* Item to (possibly) modify. */ Tk_Uid tag) /* Tag to add to those already present for * item, or NULL. */ @@ -4167,10 +4198,7 @@ DoItem( */ if (tag == NULL) { - char msg[TCL_INTEGER_SPACE]; - - sprintf(msg, "%d", itemPtr->id); - Tcl_AppendElement(interp, msg); + Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewIntObj(itemPtr->id)); return; } @@ -4257,6 +4285,7 @@ FindItems( Tk_Item *itemPtr; Tk_Uid uid; int index, result; + Tcl_Obj *resultObj; static const char *const optionStrings[] = { "above", "all", "below", "closest", "enclosed", "overlapping", "withtag", NULL @@ -4288,7 +4317,9 @@ FindItems( lastPtr = itemPtr; } if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) { - DoItem(interp, lastPtr->nextPtr, uid); + resultObj = Tcl_NewObj(); + DoItem(resultObj, lastPtr->nextPtr, uid); + Tcl_SetObjResult(interp, resultObj); } break; } @@ -4298,10 +4329,12 @@ FindItems( return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - DoItem(interp, itemPtr, uid); + DoItem(resultObj, itemPtr, uid); } + Tcl_SetObjResult(interp, resultObj); break; case CANV_BELOW: @@ -4311,10 +4344,10 @@ FindItems( } FIRST_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr, return TCL_ERROR); - if (itemPtr != NULL) { - if (itemPtr->prevPtr != NULL) { - DoItem(interp, itemPtr->prevPtr, uid); - } + if ((itemPtr != NULL) && (itemPtr->prevPtr != NULL)) { + resultObj = Tcl_NewObj(); + DoItem(resultObj, itemPtr->prevPtr, uid); + Tcl_SetObjResult(interp, resultObj); } break; case CANV_CLOSEST: { @@ -4339,8 +4372,8 @@ FindItems( return TCL_ERROR; } if (halo < 0.0) { - Tcl_AppendResult(interp, "can't have negative halo value \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't have negative halo value \"%f\"", halo)); return TCL_ERROR; } } else { @@ -4404,7 +4437,9 @@ FindItems( itemPtr = canvasPtr->firstItemPtr; } if (itemPtr == startPtr) { - DoItem(interp, closestPtr, uid); + resultObj = Tcl_NewObj(); + DoItem(resultObj, closestPtr, uid); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (itemPtr->state == TK_STATE_HIDDEN || @@ -4442,10 +4477,16 @@ FindItems( Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId"); return TCL_ERROR; } + resultObj = Tcl_NewObj(); FOR_EVERY_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr, - return TCL_ERROR) { - DoItem(interp, itemPtr, uid); + goto badWithTagSearch) { + DoItem(resultObj, itemPtr, uid); } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + badWithTagSearch: + Tcl_DecrRefCount(resultObj); + return TCL_ERROR; } return TCL_OK; } @@ -4490,6 +4531,7 @@ FindArea( double rect[4], tmp; int x1, y1, x2, y2; Tk_Item *itemPtr; + Tcl_Obj *resultObj; if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[0], &rect[0]) != TCL_OK) @@ -4517,6 +4559,7 @@ FindArea( y1 = (int) (rect[1] - 1.0); x2 = (int) (rect[2] + 1.0); y2 = (int) (rect[3] + 1.0); + resultObj = Tcl_NewObj(); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { if (itemPtr->state == TK_STATE_HIDDEN || @@ -4529,9 +4572,10 @@ FindArea( continue; } if (ItemOverlap(canvasPtr, itemPtr, rect) >= enclosed) { - DoItem(interp, itemPtr, uid); + DoItem(resultObj, itemPtr, uid); } } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index 043c167..604fa98 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -367,10 +367,12 @@ Tk_ClipboardAppend( Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, type, ClipboardHandler, targetPtr, format); } else if (targetPtr->format != format) { - Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format), - "\" does not match current format \"", - Tk_GetAtomName(tkwin, targetPtr->format),"\" for ", - Tk_GetAtomName(tkwin, type), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "format \"%s\" does not match current format \"%s\" for %s", + Tk_GetAtomName(tkwin, format), + Tk_GetAtomName(tkwin, targetPtr->format), + Tk_GetAtomName(tkwin, type))); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "FORMAT_MISMATCH", NULL); return TCL_ERROR; } @@ -474,8 +476,9 @@ Tk_ClipboardObjCmd( i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum appendOptions) subIndex) { @@ -563,8 +566,9 @@ Tk_ClipboardObjCmd( } i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum getOptions) subIndex) { @@ -699,12 +703,11 @@ ClipboardGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - const char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1); return TCL_OK; } - /* * Local Variables: diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 63f626e..4e9494b 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -233,7 +233,7 @@ Tk_BindObjCmd( Tcl_ResetResult(interp); return TCL_OK; } - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -361,30 +361,28 @@ Tk_BindtagsObjCmd( } if (objc == 2) { listPtr = Tcl_NewObj(); - Tcl_IncrRefCount(listPtr); if (winPtr->numTags == 0) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->classUid, -1)); winPtr2 = winPtr; while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) { winPtr2 = winPtr2->parentPtr; } if ((winPtr != winPtr2) && (winPtr2 != NULL)) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr2->pathName, -1)); } - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("all", -1)); } else { for (i = 0; i < winPtr->numTags; i++) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1)); + Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1)); } } Tcl_SetObjResult(interp, listPtr); - Tcl_DecrRefCount(listPtr); return TCL_OK; } if (winPtr->tagPtr != NULL) { @@ -555,9 +553,15 @@ Tk_LowerObjCmd( } } if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]), - "\" below \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + if (other) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't lower \"%s\" below \"%s\"", + Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't lower \"%s\" to bottom", Tcl_GetString(objv[1]))); + } + Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", NULL); return TCL_ERROR; } return TCL_OK; @@ -609,9 +613,15 @@ Tk_RaiseObjCmd( } } if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]), - "\" above \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + if (other) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't raise \"%s\" above \"%s\"", + Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't raise \"%s\" to top", Tcl_GetString(objv[1]))); + } + Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", NULL); return TCL_ERROR; } return TCL_OK; @@ -675,9 +685,9 @@ AppnameCmd( const char *string; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "appname not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "appname not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "APPLICATION", NULL); return TCL_ERROR; } @@ -691,7 +701,7 @@ AppnameCmd( string = Tcl_GetString(objv[1]); winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); } - Tcl_AppendResult(interp, winPtr->nameUid, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); return TCL_OK; } @@ -800,8 +810,9 @@ ScalingCmd( double d; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, "scaling not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scaling not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL); return TCL_ERROR; } @@ -849,9 +860,9 @@ UseinputmethodsCmd( int skip; if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "useinputmethods not accessible in a safe interpreter", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "useinputmethods not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "INPUT_METHODS", NULL); return TCL_ERROR; } @@ -933,22 +944,22 @@ InactiveCmd( inactive = (Tcl_IsSafe(interp) ? -1 : Tk_GetUserInactiveTime(Tk_Display(tkwin))); Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); - } else if (objc - skip == 2) { const char *string; string = Tcl_GetString(objv[objc-1]); if (strcmp(string, "reset") != 0) { - Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1); - - Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL); - Tcl_SetObjResult(interp, msg); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be reset", string)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string, NULL); return TCL_ERROR; } if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "resetting the user inactivity timer " - "is not allowed in a safe interpreter", TCL_STATIC); + "is not allowed in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "INACTIVITY_TIMER", NULL); return TCL_ERROR; } Tk_ResetUserInactiveTime(Tk_Display(tkwin)); @@ -1050,8 +1061,10 @@ Tk_TkwaitObjCmd( */ Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]), - "\" was deleted before its visibility changed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" was deleted before its visibility changed", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL); return TCL_ERROR; } Tk_DeleteEventHandler(window, @@ -1129,8 +1142,7 @@ WaitVisibilityProc( if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } - if (eventPtr->type == DestroyNotify) { + } else if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1584,8 +1596,10 @@ Tk_WinfoObjCmd( } name = Tk_GetAtomName(tkwin, (Atom) id); if (strcmp(name, "?bad atom?") == 0) { - Tcl_AppendResult(interp, "no atom exists with id \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no atom exists with id \"%s\"", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); @@ -1643,8 +1657,10 @@ Tk_WinfoObjCmd( winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id); if ((winPtr == NULL) || (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", string, - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, NULL); return TCL_ERROR; } @@ -1764,8 +1780,9 @@ Tk_WinfoObjCmd( visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask, &template, &count); if (visInfoPtr == NULL) { - Tcl_SetResult(interp, "can't find any visuals for screen", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find any visuals for screen", -1)); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", NULL); return TCL_ERROR; } resultPtr = Tcl_NewObj(); @@ -1860,8 +1877,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1886,8 +1903,10 @@ Tk_WmObjCmd( return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -2058,8 +2077,9 @@ TkGetDisplayOf( if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) { if (objc < 2) { - Tcl_SetResult(interp, "value for \"-displayof\" missing", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-displayof\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL); return -1; } *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr); @@ -2097,8 +2117,9 @@ TkDeadAppCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - Tcl_AppendResult(interp, "can't invoke \"", argv[0], - "\" command: application has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't invoke \"%s\" command: application has been destroyed", + argv[0])); return TCL_ERROR; } diff --git a/generic/tkColor.c b/generic/tkColor.c index 9383a92..1bfb037 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -224,11 +224,13 @@ Tk_GetColor( if (tkColPtr == NULL) { if (interp != NULL) { if (*name == '#') { - Tcl_AppendResult(interp, "invalid color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); } else { - Tcl_AppendResult(interp, "unknown color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color name \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "COLOR", name, NULL); } } 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..b3e76d2 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -205,7 +205,7 @@ Tk_CreateOptionTable( hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr, &newEntry); if (!newEntry) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + tablePtr = Tcl_GetHashValue(hashEntryPtr); tablePtr->refCount++; return (Tk_OptionTable) tablePtr; } @@ -391,12 +391,11 @@ DestroyOptionHashTable( Tcl_HashTable *hashTablePtr = clientData; Tcl_HashSearch search; Tcl_HashEntry *hashEntryPtr; - OptionTable *tablePtr; for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); hashEntryPtr != NULL; hashEntryPtr = Tcl_NextHashEntry(&search)) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + OptionTable *tablePtr = Tcl_GetHashValue(hashEntryPtr); /* * The following statements do two tricky things: @@ -946,16 +945,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 @@ -1161,7 +1157,9 @@ GetOptionFromObj( error: if (interp != NULL) { - Tcl_AppendResult(interp, "unknown option \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL); } return NULL; } @@ -1228,12 +1226,13 @@ SetOptionFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to option except via GetOptionFromObj API", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1346,8 +1345,10 @@ Tk_SetOptions( if (objc < 2) { if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetStringFromObj(*objv, NULL), "\" missing",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", + Tcl_GetStringFromObj(*objv, NULL))); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); goto error; } } @@ -1369,11 +1370,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 +1770,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 +2152,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/tkConsole.c b/generic/tkConsole.c index 53f49c1..434350a 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -747,7 +747,9 @@ ConsoleObjCmd( Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); Tcl_Release(consoleInterp); } else { - Tcl_AppendResult(interp, "no active console interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active console interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NONE", NULL); result = TCL_ERROR; } Tcl_DecrRefCount(cmd); @@ -796,7 +798,9 @@ InterpreterObjCmd( } if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) { - Tcl_AppendResult(interp, "no active master interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active master interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL); return TCL_ERROR; } diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 2bbf861..6b2d5f4 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -352,11 +352,15 @@ Tk_GetCursorFromData( */ if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", bg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 044a35b..d78f396 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -449,8 +449,8 @@ static int ComputeFormat(Spinbox *sbPtr); static const Tk_ClassProcs entryClass = { sizeof(Tk_ClassProcs), /* size */ EntryWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -612,6 +612,7 @@ EntryWidgetObjCmd( switch ((enum entryCmd) cmdIndex) { case COMMAND_BBOX: { int index, x, y, width, height; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -625,8 +626,11 @@ EntryWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height)); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -755,9 +759,11 @@ EntryWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -851,7 +857,7 @@ EntryWidgetObjCmd( goto error; } Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_NewBooleanObj(entryPtr->selectFirst >= 0)); goto done; case SELECTION_RANGE: @@ -912,7 +918,7 @@ EntryWidgetObjCmd( if (entryPtr->validate != VALIDATE_NONE) { entryPtr->validate = selIndex; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK)); break; } @@ -921,13 +927,12 @@ EntryWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -1165,9 +1170,11 @@ ConfigureEntry( if (entryPtr->type == TK_SPINBOX) { if (sbPtr->fromValue > sbPtr->toValue) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "-to value must be greater than -from value", - TCL_VOLATILE); + -1)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "RANGE_SANITY", + NULL); continue; } @@ -1184,9 +1191,12 @@ ConfigureEntry( formatLen = strlen(fmt); if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) { - badFormatOpt: - Tcl_AppendResult(interp, "bad spinbox format specifier \"", - sbPtr->reqFormat, "\"", NULL); + badFormatOpt: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad spinbox format specifier \"%s\"", + sbPtr->reqFormat)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "FORMAT_SANITY", + NULL); continue; } if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3) @@ -2528,8 +2538,12 @@ GetEntryIndex( case 's': if (entryPtr->selectFirst < 0) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "NO_SELECTION", NULL); return TCL_ERROR; } if (length < 5) { @@ -2589,6 +2603,9 @@ GetEntryIndex( badIndex: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad %s index \"%s\"", (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", string)); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "BAD_INDEX", NULL); return TCL_ERROR; } @@ -2935,10 +2952,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 +3157,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 +3170,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 +3296,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; @@ -3592,7 +3608,7 @@ Tk_SpinboxObjCmd( goto error; } - Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin)); return TCL_OK; error: @@ -3650,6 +3666,7 @@ SpinboxWidgetObjCmd( switch ((enum sbCmd) cmdIndex) { case SB_CMD_BBOX: { int index, x, y, width, height; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -3663,8 +3680,11 @@ SpinboxWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d %d", - x + entryPtr->layoutX, y + entryPtr->layoutY, width, height)); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -3830,9 +3850,11 @@ SpinboxWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -3925,8 +3947,8 @@ SpinboxWidgetObjCmd( Tcl_WrongNumArgs(interp, 3, objv, NULL); goto error; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + entryPtr->selectFirst >= 0)); goto done; case SB_SEL_RANGE: @@ -4030,13 +4052,12 @@ SpinboxWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -4284,7 +4305,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/tkEvent.c b/generic/tkEvent.c index 1fbf1dd..463379a 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -1336,7 +1336,7 @@ Tk_HandleEvent( } } else { for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) { - if ((handlerPtr->mask & mask) != 0) { + if (handlerPtr->mask & mask) { ip.nextHandler = handlerPtr->nextPtr; handlerPtr->proc(handlerPtr->clientData, eventPtr); handlerPtr = ip.nextHandler; diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c index fba570b..8588d70 100644 --- a/generic/tkFileFilter.c +++ b/generic/tkFileFilter.c @@ -120,10 +120,12 @@ TkGetFileFilters( } if (count != 2 && count != 3) { - Tcl_AppendResult(interp, "bad file type \"", - Tcl_GetString(listObjv[i]), "\", ", - "should be \"typeName {extension ?extensions ...?} ", - "?{macType ?macTypes ...?}?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad file type \"%s\", should be " + "\"typeName {extension ?extensions ...?} " + "?{macType ?macTypes ...?}?\"", + Tcl_GetString(listObjv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILE_TYPE", NULL); return TCL_ERROR; } @@ -289,8 +291,10 @@ AddClause( Tcl_DStringFree(&osTypeDS); } if (len != 4) { - Tcl_AppendResult(interp, "bad Macintosh file type \"", - Tcl_GetString(ostypeList[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad Macintosh file type \"%s\"", + Tcl_GetString(ostypeList[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MAC_TYPE", NULL); code = TCL_ERROR; goto done; } diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 2f50009..b5e2edf 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -115,7 +115,7 @@ Tk_FocusObjCmd( }; Tk_Window tkwin = clientData; TkWindow *winPtr = clientData; - TkWindow *newPtr, *focusWinPtr, *topLevelPtr; + TkWindow *newPtr, *topLevelPtr; ToplevelFocusInfo *tlFocusPtr; const char *windowName; int index; @@ -125,9 +125,10 @@ Tk_FocusObjCmd( */ if (objc == 1) { - focusWinPtr = TkGetFocusWin(winPtr); - if (focusWinPtr != NULL) { - Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC); + Tk_Window focusWin = (Tk_Window) TkGetFocusWin(winPtr); + + if (focusWin != NULL) { + Tcl_SetObjResult(interp, TkNewWindowObj(focusWin)); } return TCL_OK; } @@ -180,7 +181,7 @@ Tk_FocusObjCmd( } newPtr = TkGetFocusWin(newPtr); if (newPtr != NULL) { - Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) newPtr)); } break; case 1: /* -force */ @@ -213,12 +214,12 @@ Tk_FocusObjCmd( for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; tlFocusPtr = tlFocusPtr->nextPtr) { if (tlFocusPtr->topLevelPtr == topLevelPtr) { - Tcl_SetResult(interp, - tlFocusPtr->focusWinPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + tlFocusPtr->focusWinPtr)); return TCL_OK; } } - Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) topLevelPtr)); return TCL_OK; } break; diff --git a/generic/tkFont.c b/generic/tkFont.c index 32d0589..4485df8 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -439,7 +439,7 @@ TkFontPkgFree( hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&fiPtr->namedTable); - if (fiPtr->updatePending != 0) { + if (fiPtr->updatePending) { Tcl_CancelIdleCall(TheWorldHasChanged, fiPtr); } ckfree(fiPtr); @@ -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); @@ -615,9 +616,10 @@ Tk_FontObjCmd( if (namedHashPtr != NULL) { nfPtr = Tcl_GetHashValue(namedHashPtr); } - if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) { - Tcl_AppendResult(interp, "named font \"", string, - "\" doesn't exist", NULL); + if ((namedHashPtr == NULL) || nfPtr->deletePending) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); return TCL_ERROR; } if (objc == 3) { @@ -670,7 +672,7 @@ Tk_FontObjCmd( if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } - Tcl_AppendResult(interp, name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); break; } case FONT_DELETE: { @@ -686,7 +688,7 @@ Tk_FontObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?"); return TCL_ERROR; } - for (i = 2; i < objc && result == TCL_OK; i++) { + for (i = 2; (i < objc) && (result == TCL_OK); i++) { string = Tcl_GetString(objv[i]); result = TkDeleteNamedFont(interp, tkwin, string); } @@ -726,8 +728,8 @@ Tk_FontObjCmd( return TCL_ERROR; } string = Tcl_GetStringFromObj(objv[3 + skip], &length); - Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tk_TextWidth(tkfont, string, length))); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tk_TextWidth(tkfont, string, length))); Tk_FreeFont(tkfont); break; } @@ -792,7 +794,7 @@ Tk_FontObjCmd( while (namedHashPtr != NULL) { NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr); - if (nfPtr->deletePending == 0) { + if (!nfPtr->deletePending) { char *string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr); @@ -853,7 +855,7 @@ UpdateDependentFonts( fontPtr != NULL; fontPtr = fontPtr->nextPtr) { if (fontPtr->namedHashPtr == namedHashPtr) { TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa); - if (fiPtr->updatePending == 0) { + if (!fiPtr->updatePending) { fiPtr->updatePending = 1; Tcl_DoWhenIdle(TheWorldHasChanged, fiPtr); } @@ -947,10 +949,11 @@ TkCreateNamedFont( namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &isNew); if (!isNew) { nfPtr = Tcl_GetHashValue(namedHashPtr); - if (nfPtr->deletePending == 0) { + if (!nfPtr->deletePending) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" already exists", name)); + Tcl_SetErrorCode(interp, "TK", "FONT", "EXISTS", NULL); } return TCL_ERROR; } @@ -1000,8 +1003,9 @@ TkDeleteNamedFont( namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name); if (namedHashPtr == NULL) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL); } return TCL_ERROR; } @@ -1183,8 +1187,10 @@ Tk_AllocFontFromObj( if (isNew) { Tcl_DeleteHashEntry(cacheHashPtr); } - Tcl_AppendResult(interp, "failed to allocate font due to ", - "internal system font engine problem", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "failed to allocate font due to internal system font engine" + " problem", -1)); + Tcl_SetErrorCode(interp, "TK", "FONT", "INTERNAL_PROBLEM", NULL); return NULL; } @@ -1421,7 +1427,7 @@ Tk_FreeFont( nfPtr = Tcl_GetHashValue(fontPtr->namedHashPtr); nfPtr->refCount--; - if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) { + if ((nfPtr->refCount == 0) && nfPtr->deletePending) { Tcl_DeleteHashEntry(fontPtr->namedHashPtr); ckfree(nfPtr); } @@ -1749,7 +1755,7 @@ Tk_PostscriptFontName( slantString = NULL; if (fontPtr->fa.slant == TK_FS_ROMAN) { - ; + /* Do nothing */ } else if ((strcmp(family, "Helvetica") == 0) || (strcmp(family, "Courier") == 0) || (strcmp(family, "AvantGarde") == 0)) { @@ -2137,7 +2143,7 @@ Tk_ComputeTextLayout( * on the next line. Otherwise "Hello" and "Hello\n" are the same height. */ - if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) { + if ((layoutPtr->numChunks > 0) && !(flags & TK_IGNORE_NEWLINES)) { if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') { chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX, curX, baseline); @@ -2899,7 +2905,7 @@ Tk_IntersectTextLayout( result = 0; for (i = 0; i < layoutPtr->numChunks; i++) { - if ((chunkPtr->start[0] == '\n') || (chunkPtr->numBytes==0)) { + if ((chunkPtr->start[0] == '\n') || (chunkPtr->numBytes == 0)) { /* * Newline characters and empty chunks are not counted when * computing area intersection (but tab characters would still be @@ -3235,121 +3241,92 @@ Tk_TextLayoutToPostscript( Tk_TextLayout layout) /* The layout to be rendered. */ { TextLayout *layoutPtr = (TextLayout *) layout; -#define MAXUSE 128 - char buf[MAXUSE+30]; - LayoutChunk *chunkPtr; - int i, j, used, baseline, charsize; - Tcl_UniChar ch; + LayoutChunk *chunkPtr = layoutPtr->chunks; + int baseline = chunkPtr->y; + Tcl_Obj *psObj = Tcl_NewObj(); + int i, j, len; const char *p, *glyphname; + char uindex[5], c, *ps; + Tcl_UniChar ch; - chunkPtr = layoutPtr->chunks; - baseline = chunkPtr->y; - used = 0; - buf[used++] = '['; - buf[used++] = '('; - for (i = 0; i < layoutPtr->numChunks; i++) { + Tcl_AppendToObj(psObj, "[(", -1); + for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) { if (baseline != chunkPtr->y) { - buf[used++] = ')'; - buf[used++] = ']'; - buf[used++] = '\n'; - buf[used++] = '['; - buf[used++] = '('; + Tcl_AppendToObj(psObj, ")]\n[(", -1); baseline = chunkPtr->y; } if (chunkPtr->numDisplayChars <= 0) { if (chunkPtr->start[0] == '\t') { - buf[used++] = '\\'; - buf[used++] = 't'; + Tcl_AppendToObj(psObj, "\\t", -1); } - } else { - p = chunkPtr->start; - for (j = 0; j < chunkPtr->numDisplayChars; j++) { + continue; + } + + for (p=chunkPtr->start, j=0; j<chunkPtr->numDisplayChars; j++) { + /* + * INTL: We only handle symbols that have an encoding as a glyph + * from the standard set defined by Adobe. The rest get punted. + * Eventually this should be revised to handle more sophsticiated + * international postscript fonts. + */ + + p += Tcl_UtfToUniChar(p, &ch); + if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) { /* - * INTL: We only handle symbols that have an encoding as a - * flyph from the standard set defined by Adobe. The rest get - * punted. Eventually this should be revised to handle more - * sophsticiated international postscript fonts. + * Tricky point: the "03" is necessary in the sprintf below, + * so that a full three digits of octal are always generated. + * Without the "03", a number following this sequence could be + * interpreted by Postscript as part of this sequence. */ - charsize = Tcl_UtfToUniChar(p, &ch); - p += charsize; - - if ((ch == '(') || (ch == ')') || (ch == '\\') - || (ch < 0x20)) { - /* - * Tricky point: the "03" is necessary in the sprintf - * below, so that a full three digits of octal are always - * generated. Without the "03", a number following this - * sequence could be interpreted by Postscript as part of - * this sequence. - */ + Tcl_AppendPrintfToObj(psObj, "\\%03o", ch); + continue; + } else if (ch <= 0x7f) { + /* + * Normal ASCII character. + */ - sprintf(buf + used, "\\%03o", ch); - used += 4; - } else if (ch <= 0x7f) { - /* - * Normal ASCII character. - */ + c = (char) ch; + Tcl_AppendToObj(psObj, &c, 1); + continue; + } - buf[used++] = (char) ch; - } else { - char uindex[5]; + /* + * This character doesn't belong to the ASCII character set, so we + * use the full glyph name. + */ + sprintf(uindex, "%04X", ch); /* endianness? */ + glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0); + if (glyphname) { + ps = Tcl_GetStringFromObj(psObj, &len); + if (ps[len-1] == '(') { /* - * This character doesn't belong to the ASCII character - * set, so we use the full glyph name. + * In-place edit. Ewww! */ - sprintf(uindex, "%04X", ch); /* endianness? */ - glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, - 0); - if (glyphname) { - if (used > 0 && buf[used-1] == '(') { - used--; - } else { - buf[used++] = ')'; - } - buf[used++] = '/'; - while ((*glyphname) && (used < MAXUSE+27)) { - buf[used++] = *glyphname++; - } - buf[used++] = '('; - } else { - /* - * No known mapping for the character into the space - * of PostScript glyphs. Ignore it. :-( - */ + ps[len-1] = '/'; + } else { + Tcl_AppendToObj(psObj, ")/", -1); + } + Tcl_AppendToObj(psObj, glyphname, -1); + Tcl_AppendToObj(psObj, "(", -1); + } else { + /* + * No known mapping for the character into the space of + * PostScript glyphs. Ignore it. :-( + */ #ifdef TK_DEBUG_POSTSCRIPT_OUTPUT - fprintf(stderr, "Warning: no mapping to PostScript " - "glyphs for \\u%04x\n", ch); + fprintf(stderr, "Warning: no mapping to PostScript " + "glyphs for \\u%04x\n", ch); #endif - } - } - if (used >= MAXUSE) { - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); - used = 0; - } } } - if (used >= MAXUSE) { - /* - * If there are a whole bunch of returns or tabs in a row, then - * buf[] could get filled up. - */ - - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); - used = 0; - } - chunkPtr++; } - buf[used++] = ')'; - buf[used++] = ']'; - buf[used++] = '\n'; - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); + Tcl_AppendToObj(psObj, ")]\n", -1); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* @@ -3403,8 +3380,10 @@ ConfigAttributesObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(optionPtr), "\" option missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" option missing", + Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "FONT", "NO_ATTRIBUTE", NULL); } return TCL_ERROR; } @@ -3598,7 +3577,7 @@ ParseFontNameObj( } dash = strchr(string + 1, '-'); if ((dash != NULL) - && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */ + && !isspace(UCHAR(dash[-1]))) { /* INTL: ISO space */ goto xlfd; } @@ -3646,8 +3625,9 @@ ParseFontNameObj( if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK) || (objc < 1)) { if (interp != NULL) { - Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); } return TCL_ERROR; } @@ -3694,8 +3674,10 @@ ParseFontNameObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "unknown font style \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown font style \"%s\"", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT_STYLE", + Tcl_GetString(objv[i]), NULL); } return TCL_ERROR; } @@ -3848,7 +3830,7 @@ TkFontParseXLFD( * parsed set of attributes)". */ - if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) { + if ((i > XLFD_ADD_STYLE) && FieldSpecified(field[XLFD_ADD_STYLE])) { if (atoi(field[XLFD_ADD_STYLE]) != 0) { for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) { field[j + 1] = field[j]; @@ -4077,7 +4059,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: @@ -4247,12 +4228,11 @@ TkFontGetFirstTextLayout( Tk_Font *font, char *dst) { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr; int numBytesInChunk; - layoutPtr = (TextLayout *) layout; - if ((layoutPtr==NULL) || (layoutPtr->numChunks==0) + if ((layoutPtr == NULL) || (layoutPtr->numChunks == 0) || (layoutPtr->chunks->numDisplayChars <= 0)) { dst[0] = '\0'; return 0; diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 55f5d51..8bc44ce 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -334,8 +334,8 @@ static void MapFrame(ClientData clientData); static const Tk_ClassProcs frameClass = { sizeof(Tk_ClassProcs), /* size */ FrameWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -465,7 +465,7 @@ CreateFrame( Tk_Window newWin; const char *className, *screenName, *visualName, *colormapName; const char *arg, *useOption; - int i, c, length, depth; + int i, length, depth; unsigned int mask; Colormap colormap; Visual *visual; @@ -496,20 +496,19 @@ CreateFrame( if (length < 2) { continue; } - c = arg[1]; - if ((c == 'c') && (length >= 3) + if ((arg[1] == 'c') && (length >= 3) && (strncmp(arg, "-class", (unsigned) length) == 0)) { className = Tcl_GetString(objv[i+1]); - } else if ((c == 'c') + } else if ((arg[1] == 'c') && (length >= 3) && (strncmp(arg, "-colormap", (unsigned) length) == 0)) { colormapName = Tcl_GetString(objv[i+1]); - } else if ((c == 's') && (type == TYPE_TOPLEVEL) + } else if ((arg[1] == 's') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-screen", (unsigned) length) == 0)) { screenName = Tcl_GetString(objv[i+1]); - } else if ((c == 'u') && (type == TYPE_TOPLEVEL) + } else if ((arg[1] == 'u') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-use", (unsigned) length) == 0)) { useOption = Tcl_GetString(objv[i+1]); - } else if ((c == 'v') + } else if ((arg[1] == 'v') && (strncmp(arg, "-visual", (unsigned) length) == 0)) { visualName = Tcl_GetString(objv[i+1]); } @@ -548,9 +547,10 @@ CreateFrame( * are being destroyed. Let an error be thrown. */ - Tcl_AppendResult(interp, "unable to create widget \"", - Tcl_GetString(objv[1]), "\"", NULL); - newWin = NULL; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to create widget \"%s\"", Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "APPLICATION_GONE", NULL); + return TCL_ERROR; } else { /* * We were called from Tk_Init; create a new application. @@ -560,13 +560,14 @@ CreateFrame( } if (newWin == NULL) { goto error; - } else { - /* - * Mark Tk frames as suitable candidates for [wm manage] - */ - TkWindow *winPtr = (TkWindow *)newWin; - winPtr->flags |= TK_WM_MANAGEABLE; } + + /* + * Mark Tk frames as suitable candidates for [wm manage]. + */ + + ((TkWindow *) newWin)->flags |= TK_WM_MANAGEABLE; + if (className == NULL) { className = Tk_GetOption(newWin, "class", "Class"); if (className == NULL) { @@ -577,10 +578,9 @@ CreateFrame( if (useOption == NULL) { useOption = Tk_GetOption(newWin, "use", "Use"); } - if ((useOption != NULL) && (*useOption != 0)) { - if (TkpUseWindow(interp, newWin, useOption) != TCL_OK) { - goto error; - } + if ((useOption != NULL) && (*useOption != 0) + && (TkpUseWindow(interp, newWin, useOption) != TCL_OK)) { + goto error; } if (visualName == NULL) { visualName = Tk_GetOption(newWin, "visual", "Visual"); @@ -630,12 +630,11 @@ CreateFrame( framePtr = ckalloc(sizeof(Frame)); memset(framePtr, 0, sizeof(Frame)); } - framePtr->tkwin = newWin; - framePtr->display = Tk_Display(newWin); - framePtr->interp = interp; - framePtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(newWin), FrameWidgetObjCmd, framePtr, - FrameCmdDeletedProc); + framePtr->tkwin = newWin; + framePtr->display = Tk_Display(newWin); + framePtr->interp = interp; + framePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(newWin), + FrameWidgetObjCmd, framePtr, FrameCmdDeletedProc); framePtr->optionTable = optionTable; framePtr->type = type; framePtr->colormap = colormap; @@ -665,14 +664,15 @@ CreateFrame( (ConfigureFrame(interp, framePtr, objc-2, objv+2) != TCL_OK)) { goto error; } - if ((framePtr->isContainer)) { - if (framePtr->useThis == NULL) { - TkpMakeContainer(framePtr->tkwin); - } else { - Tcl_AppendResult(interp, "A window cannot have both the -use ", - "and the -container option set.", NULL); + if (framePtr->isContainer) { + if (framePtr->useThis != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "windows cannot have both the -use and the -container" + " option set", -1)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CONTAINMENT", NULL); goto error; } + TkpMakeContainer(framePtr->tkwin); } if (type == TYPE_TOPLEVEL) { Tcl_DoWhenIdle(MapFrame, framePtr); @@ -765,6 +765,7 @@ FrameWidgetObjCmd( for (i = 2; i < objc; i++) { const char *arg = Tcl_GetStringFromObj(objv[i], &length); + if (length < 2) { continue; } @@ -785,23 +786,22 @@ FrameWidgetObjCmd( #ifdef SUPPORT_CONFIG_EMBEDDED if (c == 'u') { const char *string = Tcl_GetString(objv[i+1]); + if (TkpUseWindow(interp, framePtr->tkwin, string) != TCL_OK) { result = TCL_ERROR; goto done; } - } else { - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; + continue; } -#else - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; #endif + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't modify %s option after widget is created", + arg)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CREATE_ONLY", + NULL); + result = TCL_ERROR; + goto done; } } result = ConfigureFrame(interp, framePtr, objc-2, objv+2); @@ -1011,19 +1011,14 @@ ConfigureFrame( } sibling = ancestor; if (Tk_IsTopLevel(ancestor)) { - badWindow: - Tcl_AppendResult(interp, "can't use ", - Tk_PathName(labelframePtr->labelWin), - " as label in this frame", NULL); - labelframePtr->labelWin = NULL; - return TCL_ERROR; + goto badLabelWindow; } } if (Tk_IsTopLevel(labelframePtr->labelWin)) { - goto badWindow; + goto badLabelWindow; } if (labelframePtr->labelWin == framePtr->tkwin) { - goto badWindow; + goto badLabelWindow; } Tk_CreateEventHandler(labelframePtr->labelWin, StructureNotifyMask, FrameStructureProc, framePtr); @@ -1044,6 +1039,14 @@ ConfigureFrame( FrameWorldChanged(framePtr); return TCL_OK; + + badLabelWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as label in this frame", + Tk_PathName(labelframePtr->labelWin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); + labelframePtr->labelWin = NULL; + return TCL_ERROR; } /* diff --git a/generic/tkGeometry.c b/generic/tkGeometry.c index 2c6c113..2e0009a 100644 --- a/generic/tkGeometry.c +++ b/generic/tkGeometry.c @@ -321,7 +321,8 @@ Tk_SetMinimumRequestSize( int TkSetGeometryMaster( Tcl_Interp *interp, /* Current interpreter, for error. */ - Tk_Window tkwin, /* Window that will have geometry master set. */ + Tk_Window tkwin, /* Window that will have geometry master + * set. */ const char *master) /* The master identity. */ { register TkWindow *winPtr = (TkWindow *) tkwin; @@ -332,10 +333,11 @@ TkSetGeometryMaster( } if (winPtr->geometryMaster != NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "cannot use geometry manager ", master, - " inside ", Tk_PathName(tkwin), - " which already has slaves managed by ", - winPtr->geometryMaster, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot use geometry manager %s inside %s which already" + " has slaves managed by %s", + master, Tk_PathName(tkwin), winPtr->geometryMaster)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "FIGHT", NULL); } return TCL_ERROR; } @@ -364,8 +366,9 @@ TkSetGeometryMaster( void TkFreeGeometryMaster( - Tk_Window tkwin, /* Window that will have geometry master cleared. */ - const char *master) /* The master identity. */ + Tk_Window tkwin, /* Window that will have geometry master + * cleared. */ + const char *master) /* The master identity. */ { register TkWindow *winPtr = (TkWindow *) tkwin; diff --git a/generic/tkGet.c b/generic/tkGet.c index bd63971..d58b4a5 100644 --- a/generic/tkGet.c +++ b/generic/tkGet.c @@ -152,8 +152,10 @@ Tk_GetAnchor( } error: - Tcl_AppendResult(interp, "bad anchor position \"", string, - "\": must be n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad anchor position \"%s\": must be" + " n, ne, e, se, s, sw, w, nw, or center", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ANCHOR", NULL); return TCL_ERROR; } @@ -237,8 +239,10 @@ Tk_GetJoinStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad join style \"", string, - "\": must be bevel, miter, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad join style \"%s\": must be bevel, miter, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JOIN", NULL); return TCL_ERROR; } @@ -316,8 +320,10 @@ Tk_GetCapStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad cap style \"", string, - "\": must be butt, projecting, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cap style \"%s\": must be butt, projecting, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CAP", NULL); return TCL_ERROR; } @@ -432,8 +438,10 @@ Tk_GetJustify( return TCL_OK; } - Tcl_AppendResult(interp, "bad justification \"", string, - "\": must be left, right, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad justification \"%s\": must be left, right, or center", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JUSTIFY", NULL); return TCL_ERROR; } @@ -568,9 +576,7 @@ Tk_GetScreenMM( d = strtod(string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -606,6 +612,12 @@ Tk_GetScreenMM( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCREEN_DISTANCE", NULL); + return TCL_ERROR; } /* @@ -684,9 +696,7 @@ TkGetDoublePixels( d = strtod((char *) string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -725,6 +735,12 @@ TkGetDoublePixels( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL); + return TCL_ERROR; } /* diff --git a/generic/tkGrab.c b/generic/tkGrab.c index 695690b..2df5552 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -211,10 +211,15 @@ Tk_GrabObjCmd( * is "grab", but if it has been aliased, the message will be * incorrect. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "wrong # args: should be \"", - Tcl_GetString(objv[0]), " ?-global? window\" or \"", - Tcl_GetString(objv[0]), " option ?arg ...?\"", NULL); + + Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), + " option ?arg ...?\"", NULL); + /* This API not exposed: + * + ((Interp *) interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS; + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); + */ return TCL_ERROR; } @@ -277,17 +282,20 @@ Tk_GrabObjCmd( } dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName, - TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + dispPtr->eventualGrabWinPtr)); } } else { + Tcl_Obj *resultObj = Tcl_NewObj(); + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_AppendElement(interp, - dispPtr->eventualGrabWinPtr->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, TkNewWindowObj( + (Tk_Window) dispPtr->eventualGrabWinPtr)); } } + Tcl_SetObjResult(interp, resultObj); } return TCL_OK; @@ -340,6 +348,7 @@ Tk_GrabObjCmd( case GRABCMD_STATUS: { /* [grab status window] */ TkWindow *winPtr; + const char *statusString; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "status window"); @@ -352,12 +361,13 @@ Tk_GrabObjCmd( } dispPtr = winPtr->dispPtr; if (dispPtr->eventualGrabWinPtr != winPtr) { - Tcl_SetResult(interp, "none", TCL_STATIC); + statusString = "none"; } else if (dispPtr->grabFlags & GRAB_GLOBAL) { - Tcl_SetResult(interp, "global", TCL_STATIC); + statusString = "global"; } else { - Tcl_SetResult(interp, "local", TCL_STATIC); + statusString = "local"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(statusString, -1)); break; } } @@ -410,10 +420,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 +430,7 @@ Tk_Grab( if (!grabGlobal) #else if (0) -#endif +#endif /* MAC_OSX_TK */ { Window dummy1, dummy2; int dummy3, dummy4, dummy5, dummy6; @@ -440,7 +447,7 @@ Tk_Grab( dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL); XQueryPointer(dispPtr->display, winPtr->window, &dummy1, &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state); - if ((state & ALL_BUTTONS) != 0) { + if (state & ALL_BUTTONS) { dispPtr->grabFlags |= GRAB_TEMP_GLOBAL; goto setGlobalGrab; } @@ -479,26 +486,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 +534,31 @@ Tk_Grab( } QueueGrabWindowChange(dispPtr, winPtr); return TCL_OK; + + grabError: + if (grabResult == GrabNotViewable) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: window not viewable", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL); + } else if (grabResult == AlreadyGrabbed) { + alreadyGrabbed: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: another application has grab", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL); + } else if (grabResult == GrabFrozen) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: keyboard or pointer frozen", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL); + } else if (grabResult == GrabInvalidTime) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: invalid time", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "BAD_TIME", 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; } /* @@ -846,7 +859,7 @@ TkPointerEvent( } } if (eventPtr->type == ButtonPress) { - if ((eventPtr->xbutton.state & ALL_BUTTONS) == 0) { + if (!(eventPtr->xbutton.state & ALL_BUTTONS)) { if (outsideGrabTree) { TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr); Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD); diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 70d463e..19e4442 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -301,7 +301,7 @@ static int SetSlaveColumn(Tcl_Interp *interp, Gridder *slavePtr, int column, int numCols); static int SetSlaveRow(Tcl_Interp *interp, Gridder *slavePtr, int row, int numRows); -static void StickyToString(int flags, char *result); +static Tcl_Obj * StickyToObj(int flags); static int StringToSticky(const char *string); static void Unlink(Gridder *gridPtr); @@ -402,7 +402,8 @@ Tk_GridObjCmd( } /* This should not happen */ - Tcl_SetResult(interp, "Internal error in grid.", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("internal error in grid", -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } @@ -447,8 +448,9 @@ GridAnchorCommand( if (objc == 3) { gridPtr = masterPtr->masterDataPtr; - Tcl_SetResult(interp, (char *) Tk_NameOfAnchor(gridPtr == NULL ? - GRID_DEFAULT_ANCHOR : gridPtr->anchor), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfAnchor(gridPtr?gridPtr->anchor:GRID_DEFAULT_ANCHOR), + -1)); return TCL_OK; } @@ -720,7 +722,7 @@ GridInfoCommand( { register Gridder *slavePtr; Tk_Window slave; - char buffer[64 + TCL_INTEGER_SPACE * 4]; + Tcl_Obj *infoObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -735,18 +737,24 @@ GridInfoCommand( return TCL_OK; } - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); - sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d", - slavePtr->column, slavePtr->row, - slavePtr->numCols, slavePtr->numRows); - Tcl_AppendResult(interp, buffer, NULL); - TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX); - TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY); - TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX); - TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY); - StickyToString(slavePtr->sticky, buffer); - Tcl_AppendResult(interp, " -sticky ", buffer, NULL); + infoObj = Tcl_NewObj(); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1), + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-column", -1), + Tcl_NewIntObj(slavePtr->column)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-row", -1), + Tcl_NewIntObj(slavePtr->row)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-columnspan", -1), + Tcl_NewIntObj(slavePtr->numCols)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-rowspan", -1), + Tcl_NewIntObj(slavePtr->numRows)); + TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX); + TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY); + TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft, slavePtr->padX); + TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-sticky", -1), + StickyToObj(slavePtr->sticky)); + Tcl_SetObjResult(interp, infoObj); return TCL_OK; } @@ -994,9 +1002,9 @@ GridRowColumnConfigureCommand( string = Tcl_GetString(objv[1]); slotType = (*string == 'c') ? COLUMN : ROW; if (lObjc == 0) { - Tcl_AppendResult(interp, "no ", - (slotType == COLUMN) ? "column" : "row", - " indices specified", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("no %s indices specified", + (slotType == COLUMN) ? "column" : "row")); + Tcl_SetErrorCode(interp, "TK", "GRID", "NO_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1007,16 +1015,17 @@ GridRowColumnConfigureCommand( if ((objc == 4) || (objc == 5)) { if (lObjc != 1) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), - ": must specify a single element on retrieval", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify a single element on retrieval", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, lObjv[0], &slot) != TCL_OK) { Tcl_AppendResult(interp, - " (when retreiving options only integer indices are " + " (when retrieving options only integer indices are " "allowed)", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1073,19 +1082,19 @@ GridRowColumnConfigureCommand( return TCL_ERROR; } if (index == ROWCOL_MINSIZE) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].minSize : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].minSize : 0)); } else if (index == ROWCOL_WEIGHT) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].weight : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].weight : 0)); } else if (index == ROWCOL_UNIFORM) { Tk_Uid value = (ok == TCL_OK) ? slotPtr[slot].uniform : ""; - Tcl_SetObjResult(interp, - Tcl_NewStringObj(value == NULL ? "" : value, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (value == NULL) ? "" : value, -1)); } else if (index == ROWCOL_PAD) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].pad : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].pad : 0)); } Tcl_DecrRefCount(listCopy); return TCL_OK; @@ -1118,17 +1127,17 @@ GridRowColumnConfigureCommand( slavePtr = GetGrid(slave); if (slavePtr->masterPtr != masterPtr) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": the window \"", - Tcl_GetString(lObjv[j]), "\" is not managed by \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the window \"%s\" is not managed by \"%s\"", + Tcl_GetString(lObjv[j]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NOT_MASTER", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } } else { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": illegal index \"", - Tcl_GetString(lObjv[j]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "illegal index \"%s\"", Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1148,10 +1157,11 @@ GridRowColumnConfigureCommand( for (slot = first; slot <= last; slot++) { ok = CheckSlotData(masterPtr, slot, slotType, /*checkOnly*/ 0); if (ok != TCL_OK) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": \"", - Tcl_GetString(lObjv[j]), - "\" is out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is out of range", + Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", + NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1185,11 +1195,8 @@ GridRowColumnConfigureCommand( Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (wt < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + goto negativeIndex; } else { slotPtr[slot].weight = wt; } @@ -1206,11 +1213,8 @@ GridRowColumnConfigureCommand( Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (size < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + goto negativeIndex; } else { slotPtr[slot].pad = size; } @@ -1259,6 +1263,13 @@ GridRowColumnConfigureCommand( Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } return TCL_OK; + + negativeIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid arg \"%s\": should be non-negative", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); + return TCL_ERROR; } /* @@ -1361,8 +1372,9 @@ GridSlavesCommand( return TCL_ERROR; } if (value < 0) { - Tcl_AppendResult(interp, Tcl_GetString(objv[i]), - " is an invalid value: should NOT be < 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%d is an invalid value: should NOT be < 0", value)); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); return TCL_ERROR; } if (index == SLAVES_COLUMN) { @@ -1380,11 +1392,11 @@ GridSlavesCommand( res = Tcl_NewListObj(0, NULL); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - if (column>=0 && (slavePtr->column > column + if ((column >= 0) && (slavePtr->column > column || slavePtr->column+slavePtr->numCols-1 < column)) { continue; } - if (row>=0 && (slavePtr->row > row || + if ((row >= 0) && (slavePtr->row > row || slavePtr->row+slavePtr->numRows-1 < row)) { continue; } @@ -2528,7 +2540,8 @@ SetSlaveColumn( lastCol = ((newColumn >= 0) ? newColumn : 0) + newNumCols; if (lastCol >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Column out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("column out of bounds",-1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_COLUMN", NULL); return TCL_ERROR; } @@ -2568,7 +2581,8 @@ SetSlaveRow( lastRow = ((newRow >= 0) ? newRow : 0) + newNumRows; if (lastRow >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Row out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("row out of bounds", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_ROW", NULL); return TCL_ERROR; } @@ -2992,24 +3006,27 @@ ConfigureSlaves( continue; } if (length > 1 && i == 0) { - Tcl_AppendResult(interp, "bad argument \"", string, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (length > 1 && firstChar == '-') { break; } if (length > 1) { - Tcl_AppendResult(interp, "unexpected parameter, \"", - string, "\", in configure list. ", - "Should be window name or option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unexpected parameter \"%s\" in configure list:" + " should be window name or option", string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if ((firstChar == REL_HORIZ) && ((numWindows == 0) || (prevChar == REL_SKIP) || (prevChar == REL_VERT))) { - Tcl_AppendResult(interp, - "Must specify window before shortcut '-'.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify window before shortcut '-'", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3018,14 +3035,18 @@ ConfigureSlaves( continue; } - Tcl_AppendResult(interp, "invalid window shortcut, \"", - string, "\" should be '-', 'x', or '^'", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid window shortcut, \"%s\" should be '-', 'x', or '^'", + string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } numWindows = i; if ((objc - numWindows) & 1) { - Tcl_AppendResult(interp, "extra option or option with no value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra option or option with no value", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3051,10 +3072,10 @@ ConfigureSlaves( } else if (index == CONF_ROW) { if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "POSITIVE_INT", NULL); return TCL_ERROR; } defaultRow = tmp; @@ -3116,8 +3137,10 @@ ConfigureSlaves( } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't manage \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetGrid(slave); @@ -3144,9 +3167,10 @@ ConfigureSlaves( case CONF_COLUMN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad column value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad column value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3156,9 +3180,10 @@ ConfigureSlaves( case CONF_COLUMNSPAN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp <= 0) { - Tcl_AppendResult(interp, "bad columnspan value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad columnspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3171,8 +3196,9 @@ ConfigureSlaves( return TCL_ERROR; } if (other == slave) { - Tcl_SetResult(interp, "Window can't be managed in itself", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "window can't be managed in itself", -1)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } positionGiven = 1; @@ -3183,9 +3209,11 @@ ConfigureSlaves( int sticky = StringToSticky(Tcl_GetString(objv[i+1])); if (sticky == -1) { - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a string containing n, e, s, and/or w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be" + " a string containing n, e, s, and/or w", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } slavePtr->sticky = sticky; @@ -3194,9 +3222,10 @@ ConfigureSlaves( case CONF_IPADX: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; @@ -3204,9 +3233,10 @@ ConfigureSlaves( case CONF_IPADY: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -3226,9 +3256,10 @@ ConfigureSlaves( case CONF_ROW: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), - "\": must be a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3238,9 +3269,10 @@ ConfigureSlaves( case CONF_ROWSPAN: if ((Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK) || tmp <= 0) { - Tcl_AppendResult(interp, "bad rowspan value \"", - Tcl_GetString(objv[i+1]), - "\": must be a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad rowspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3305,8 +3337,10 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3317,9 +3351,10 @@ ConfigureSlaves( */ if (masterPtr->masterPtr == slavePtr) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), - ", would cause management loop.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s, would cause management loop", + Tcl_GetString(objv[j]), Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3379,8 +3414,8 @@ ConfigureSlaves( numSkip = 0; for (j = 0; j < numWindows; j++) { struct Gridder *otherPtr; - int match; /* Found a match for the ^ */ - int lastRow, lastColumn; /* Implied end of table. */ + int match; /* Found a match for the ^ */ + int lastRow, lastColumn; /* Implied end of table. */ string = Tcl_GetString(objv[j]); firstChar = string[0]; @@ -3397,7 +3432,9 @@ ConfigureSlaves( } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't use '^', cant find master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't use '^', cant find master", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3449,14 +3486,17 @@ ConfigureSlaves( } } if (!match) { - Tcl_AppendResult(interp, "can't find slave to extend with \"^\".", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find slave to extend with \"^\"", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't determine master window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't determine master window", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } SetGridSize(masterPtr); @@ -3477,13 +3517,13 @@ ConfigureSlaves( /* *---------------------------------------------------------------------- * - * StickyToString + * StickyToObj * * Converts the internal boolean combination of "sticky" bits onto a Tcl * list element containing zero or more of n, s, e, or w. * * Results: - * A string is placed into the "result" pointer. + * A new object is returned that holds the sticky representation. * * Side effects: * none. @@ -3491,29 +3531,26 @@ ConfigureSlaves( *---------------------------------------------------------------------- */ -static void -StickyToString( - int flags, /* The sticky flags. */ - char *result) /* Where to put the result. */ +static Tcl_Obj * +StickyToObj( + int flags) /* The sticky flags. */ { int count = 0; - if (flags&STICK_NORTH) { - result[count++] = 'n'; - } - if (flags&STICK_EAST) { - result[count++] = 'e'; + char buffer[4]; + + if (flags & STICK_NORTH) { + buffer[count++] = 'n'; } - if (flags&STICK_SOUTH) { - result[count++] = 's'; + if (flags & STICK_EAST) { + buffer[count++] = 'e'; } - if (flags&STICK_WEST) { - result[count++] = 'w'; + if (flags & STICK_SOUTH) { + buffer[count++] = 's'; } - if (count) { - result[count] = '\0'; - } else { - sprintf(result, "{}"); + if (flags & STICK_WEST) { + buffer[count++] = 'w'; } + return Tcl_NewStringObj(buffer, count); } /* diff --git a/generic/tkImage.c b/generic/tkImage.c index 5fa3671..ffa6f22 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -225,6 +225,7 @@ Tk_ImageObjCmd( char idString[16 + TCL_INTEGER_SPACE]; TkDisplay *dispPtr = winPtr->dispPtr; const char *arg, *name; + Tcl_Obj *resultObj; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -271,8 +272,9 @@ Tk_ImageObjCmd( } } if (typePtr == NULL) { - Tcl_AppendResult(interp, "image type \"", arg, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image type \"%s\" doesn't exist", arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", arg, NULL); return TCL_ERROR; } @@ -304,8 +306,10 @@ Tk_ImageObjCmd( topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name); if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { - Tcl_AppendResult(interp, "images may not be named the ", - "same as the main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "images may not be named the same as the main window", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL); return TCL_ERROR; } } @@ -387,9 +391,8 @@ Tk_ImageObjCmd( imagePtr->instanceData = typePtr->getProc(imagePtr->tkwin, masterPtr->masterData); } - Tcl_SetResult(interp, - Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); break; } case IMAGE_DELETE: @@ -412,28 +415,34 @@ Tk_ImageObjCmd( return TCL_ERROR; } hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); + resultObj = Tcl_NewObj(); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { continue; } - Tcl_AppendElement(interp, Tcl_GetHashKey( - &winPtr->mainPtr->imageTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_TYPES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_HEIGHT: @@ -490,7 +499,8 @@ Tk_ImageObjCmd( return TCL_OK; alreadyDeleted: - Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" doesn't exist",arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", arg, NULL); return TCL_ERROR; } @@ -630,7 +640,9 @@ Tk_GetImage( noSuchImage: if (interp) { - Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", name, NULL); } return NULL; } diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 82374cb..cdd57dd 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -152,7 +152,7 @@ static void ImgBmapConfigureInstance(BitmapInstance *instancePtr); static int ImgBmapConfigureMaster(BitmapMaster *masterPtr, int argc, Tcl_Obj *const objv[], int flags); static int NextBitmapWord(ParseInfo *parseInfoPtr); - + /* *---------------------------------------------------------------------- * @@ -207,7 +207,7 @@ ImgBmapCreate( *clientDataPtr = masterPtr; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -242,7 +242,7 @@ ImgBmapConfigureMaster( const char **argv = ckalloc((objc+1) * sizeof(char *)); for (dummy1 = 0; dummy1 < objc; dummy1++) { - argv[dummy1]=Tcl_GetString(objv[dummy1]); + argv[dummy1] = Tcl_GetString(objv[dummy1]); } argv[objc] = NULL; @@ -277,8 +277,10 @@ ImgBmapConfigureMaster( if ((masterPtr->maskFileString != NULL) || (masterPtr->maskDataString != NULL)) { if (masterPtr->data == NULL) { - Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap", - TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "can't have mask without bitmap", -1)); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "NO_BITMAP", NULL); return TCL_ERROR; } masterPtr->maskData = TkGetBitmapData(masterPtr->interp, @@ -291,8 +293,10 @@ ImgBmapConfigureMaster( || (maskHeight != masterPtr->height)) { ckfree(masterPtr->maskData); masterPtr->maskData = NULL; - Tcl_SetResult(masterPtr->interp, - "bitmap and mask have different sizes", TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "bitmap and mask have different sizes", -1)); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "MASK_SIZE", NULL); return TCL_ERROR; } } @@ -311,7 +315,7 @@ ImgBmapConfigureMaster( masterPtr->height, masterPtr->width, masterPtr->height); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -446,7 +450,7 @@ ImgBmapConfigureInstance( masterPtr->tkMaster))); Tcl_BackgroundError(masterPtr->interp); } - + /* *---------------------------------------------------------------------- * @@ -473,7 +477,7 @@ char * TkGetBitmapData( Tcl_Interp *interp, /* For reporting errors, or NULL. */ const char *string, /* String describing bitmap. May be NULL. */ - const char *fileName, /* Name of file containing bitmap description. + const char *fileName, /* Name of file containing bitmap description. * Used only if string is NULL. Must not be * NULL if string is NULL. */ int *widthPtr, int *heightPtr, @@ -490,8 +494,10 @@ TkGetBitmapData( pi.string = string; if (string == NULL) { if ((interp != NULL) && Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get bitmap data from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get bitmap data from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); return NULL; } expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer); @@ -503,8 +509,9 @@ TkGetBitmapData( if (pi.chan == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read bitmap file \"", - fileName, "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read bitmap file \"%s\": %s", + fileName, Tcl_PosixError(interp))); } return NULL; } @@ -593,8 +600,11 @@ TkGetBitmapData( } } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) { if (interp != NULL) { - Tcl_AppendResult(interp, "format error in bitmap data; ", - "looks like it's an obsolete X10 bitmap file", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data; looks like it's an" + " obsolete X10 bitmap file", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OBSOLETE", + NULL); } goto errorCleanup; } @@ -636,7 +646,9 @@ TkGetBitmapData( error: if (interp != NULL) { - Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "FORMAT", NULL); } errorCleanup: @@ -648,7 +660,7 @@ TkGetBitmapData( } return NULL; } - + /* *---------------------------------------------------------------------- * @@ -718,7 +730,7 @@ NextBitmapWord( parseInfoPtr->word[parseInfoPtr->wordLength] = 0; return TCL_OK; } - + /* *-------------------------------------------------------------- * @@ -781,7 +793,7 @@ ImgBmapCmd( return TCL_OK; } } - + /* *---------------------------------------------------------------------- * @@ -852,7 +864,7 @@ ImgBmapGet( return instancePtr; } - + /* *---------------------------------------------------------------------- * @@ -912,7 +924,7 @@ ImgBmapDisplay( XSetClipOrigin(display, instancePtr->gc, 0, 0); } } - + /* *---------------------------------------------------------------------- * @@ -975,7 +987,7 @@ ImgBmapFree( } ckfree(instancePtr); } - + /* *---------------------------------------------------------------------- * @@ -1016,7 +1028,7 @@ ImgBmapDelete( Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0); ckfree(masterPtr); } - + /* *---------------------------------------------------------------------- * @@ -1046,7 +1058,7 @@ ImgBmapCmdDeletedProc( Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster)); } } - + /* *---------------------------------------------------------------------- * @@ -1077,8 +1089,7 @@ GetByte( return buffer; } } - - + /* *---------------------------------------------------------------------- * @@ -1100,28 +1111,22 @@ GetByte( * 3. The postscript coordinate system has been scaled so that the * entire bitmap is one unit squared. * - * Some postscript implementations cannot handle bitmap strings longer - * than about 60k characters. If the bitmap data is that big or bigger, - * then we render it by splitting it into several smaller bitmaps. - * * Results: - * Returns TCL_OK on success. Returns TCL_ERROR and leaves and error - * message in interp->result if there is a problem. + * None. * * Side effects: - * Postscript code is appended to interp->result. + * Postscript code is appended to psObj. * *---------------------------------------------------------------------- */ -static int +static void ImgBmapPsImagemask( - Tcl_Interp *interp, /* Append postscript to this interpreter */ + Tcl_Obj *psObj, /* Append postscript to this buffer. */ int width, int height, /* Width and height of the bitmap in pixels */ - char *data) /* Data for the bitmap */ + char *data) /* Data for the bitmap. */ { int i, j, nBytePerRow; - char buffer[200]; /* * The bit order of bitmaps in Tk is the opposite of the bit order that @@ -1150,31 +1155,22 @@ ImgBmapPsImagemask( 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255, }; - if (width*height > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unable to generate postscript for bitmaps " - "larger than 60000 pixels", NULL); - return TCL_ERROR; - } - - sprintf(buffer, "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n", + Tcl_AppendPrintfToObj(psObj, + "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n", width, height, width, -height, height); - Tcl_AppendResult(interp, buffer, NULL); - nBytePerRow = (width+7)/8; - for(i=0; i<height; i++){ - for(j=0; j<nBytePerRow; j++){ - sprintf(buffer, " %02x", + nBytePerRow = (width + 7) / 8; + for (i=0; i<height; i++) { + for (j=0; j<nBytePerRow; j++) { + Tcl_AppendPrintfToObj(psObj, " %02x", bit_reverse[0xff & data[i*nBytePerRow + j]]); - Tcl_AppendResult(interp, buffer, NULL); } - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - Tcl_AppendResult(interp, ">} imagemask \n", NULL); - return TCL_OK; + Tcl_AppendToObj(psObj, ">} imagemask \n", -1); } - + /* *---------------------------------------------------------------------- * @@ -1183,7 +1179,6 @@ ImgBmapPsImagemask( * This procedure generates postscript for rendering a bitmap image. * * Results: - * On success, this routine writes postscript code into interp->result * and returns TCL_OK TCL_ERROR is returned and an error message is left * in interp->result if anything goes wrong. @@ -1204,7 +1199,8 @@ ImgBmapPostscript( int prepass) { BitmapMaster *masterPtr = clientData; - char buffer[200]; + Tcl_InterpState interpState; + Tcl_Obj *psObj; if (prepass) { return TCL_OK; @@ -1214,11 +1210,32 @@ ImgBmapPostscript( * There is nothing to do for bitmaps with zero width or height. */ - if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<= 0){ + if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0){ return TCL_OK; } /* + * Some postscript implementations cannot handle bitmap strings longer + * than about 60k characters. If the bitmap data is that big or bigger, + * we bail out. + */ + + if (masterPtr->width*masterPtr->height > 60000) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to generate postscript for bitmaps larger than 60000" + " pixels", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + return TCL_ERROR; + } + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Translate the origin of the coordinate system to be the lower-left * corner of the bitmap and adjust the scale of the coordinate system so * that entire bitmap covers one square unit of the page. The calling @@ -1227,13 +1244,11 @@ ImgBmapPostscript( * necessary here. */ - if (x!=0 || y!=0) { - sprintf(buffer, "%d %d moveto\n", x, y); - Tcl_AppendResult(interp, buffer, NULL); + if (x != 0 || y != 0) { + Tcl_AppendPrintfToObj(psObj, "%d %d moveto\n", x, y); } - if (width!=1 || height!=1) { - sprintf(buffer, "%d %d scale\n", width, height); - Tcl_AppendResult(interp, buffer, NULL); + if (width != 1 || height != 1) { + Tcl_AppendPrintfToObj(psObj, "%d %d scale\n", width, height); } /* @@ -1249,16 +1264,19 @@ ImgBmapPostscript( TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid, &color); + Tcl_ResetResult(interp); if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (masterPtr->maskData == NULL) { - Tcl_AppendResult(interp, - "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto ", - "closepath fill\n", NULL); - } else if (ImgBmapPsImagemask(interp, masterPtr->width, - masterPtr->height, masterPtr->maskData) != TCL_OK) { - return TCL_ERROR; + Tcl_AppendToObj(psObj, + "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto " + "closepath fill\n", -1); + } else { + ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height, + masterPtr->maskData); } } @@ -1271,17 +1289,31 @@ ImgBmapPostscript( TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid, &color); + Tcl_ResetResult(interp); if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) { - return TCL_ERROR; - } - if (ImgBmapPsImagemask(interp, masterPtr->width, masterPtr->height, - masterPtr->data) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height, + masterPtr->data); } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; -} + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; +} + /* * Local Variables: * mode: c diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 4cbf94d..fed4da4 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -430,8 +430,10 @@ FileReadGIF( return TCL_ERROR; } if (i == (argc-1)) { - Tcl_AppendResult(interp, "no value given for \"", - Tcl_GetString(objv[i]), "\" option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no value given for \"%s\" option", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "OPT_VALUE", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) { @@ -444,13 +446,15 @@ FileReadGIF( */ if (!ReadGIFHeader(gifConfPtr, chan, &fileWidth, &fileHeight)) { - Tcl_AppendResult(interp, "couldn't read GIF header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read GIF header from file \"%s\"", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "GIF image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "GIF image file \"%s\" has dimension(s) <= 0", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BOGUS_SIZE", NULL); return TCL_ERROR; } @@ -465,7 +469,9 @@ FileReadGIF( if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); return TCL_ERROR; } } @@ -501,14 +507,18 @@ FileReadGIF( * Premature end of image. */ - Tcl_AppendResult(interp, - "premature end of image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "premature end of image data for this index", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", + NULL); goto error; } switch (buf[0]) { case GIF_TERMINATOR: - Tcl_AppendResult(interp, "no image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no image data for this index", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL); goto error; case GIF_EXTENSION: @@ -517,23 +527,29 @@ FileReadGIF( */ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "error reading extension function code in GIF image", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } if (DoExtension(gifConfPtr, chan, buf[0], gifConfPtr->workingBuffer, &transparent) < 0) { - Tcl_SetResult(interp, "error reading extension in GIF image", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading extension in GIF image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } continue; case GIF_START: if (Fread(gifConfPtr, buf, 1, 9, chan) != 9) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't read left/top/width/height in GIF image", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "DIMENSIONS", + NULL); goto error; } break; @@ -561,7 +577,10 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", + "COLOR_MAP", NULL); goto error; } } @@ -608,7 +627,9 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); goto error; } } @@ -659,7 +680,7 @@ FileReadGIF( block.pixelPtr = ckalloc(nBytes); if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth, - imageHeight, colorMap, srcX, srcY, BitSet(buf[8],INTERLACE), + imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE), transparent) != TCL_OK) { ckfree(block.pixelPtr); goto error; @@ -677,7 +698,7 @@ FileReadGIF( * which suits as well). We're done. */ - Tcl_AppendResult(interp, tkImgFmtGIF.name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1)); result = TCL_OK; error: @@ -903,19 +924,19 @@ DoExtension( int count; switch (label) { - case 0x01: /* Plain Text Extension */ + case 0x01: /* Plain Text Extension */ break; - case 0xff: /* Application Extension */ + case 0xff: /* Application Extension */ break; - case 0xfe: /* Comment Extension */ + case 0xfe: /* Comment Extension */ do { count = GetDataBlock(gifConfPtr, chan, buf); } while (count > 0); return count; - case 0xf9: /* Graphic Control Extension */ + case 0xf9: /* Graphic Control Extension */ count = GetDataBlock(gifConfPtr, chan, buf); if (count < 0) { return 1; @@ -1011,13 +1032,14 @@ ReadImage( */ if (Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) <= 0) { - Tcl_AppendResult(interp, "error reading GIF image: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading GIF image: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (initialCodeSize > MAX_LWZ_BITS) { - Tcl_SetResult(interp, "malformed image", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("malformed image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "MALFORMED", NULL); return TCL_ERROR; } @@ -1416,7 +1438,7 @@ Mgetc( handle->data++; } while (c == GIF_SPACE); - if (c>GIF_SPECIAL) { + if (c > GIF_SPECIAL) { handle->state = GIF_DONE; return handle->c; } @@ -1689,7 +1711,8 @@ CommonWriteGIF( state.pixelPitch = blockPtr->pitch; SaveMap(&state, blockPtr); if (state.num >= MAXCOLORMAPSIZE) { - Tcl_AppendResult(interp, "too many colors", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("too many colors", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLORFUL", NULL); return TCL_ERROR; } if (state.num<2) { diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 8d6721e..b159c45 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -334,7 +334,9 @@ InitPNGImage( if (Tcl_ZlibStreamInit(NULL, dir, TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_COMPRESS_DEFAULT, NULL, &pngPtr->stream) != TCL_OK) { - Tcl_SetResult(interp, "zlib initialization failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "zlib initialization failed", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL); if (objPtr) { Tcl_DecrRefCount(objPtr); } @@ -515,7 +517,9 @@ ReadBase64( } if (destSz) { - Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -557,7 +561,9 @@ ReadByteArray( */ if (pngPtr->strDataLen < destSz) { - Tcl_SetResult(interp, "Unexpected end of image data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); return TCL_ERROR; } @@ -618,14 +624,10 @@ ReadData( int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ); blockSz = Tcl_Read(pngPtr->channel, (char *)destPtr, blockSz); - - /* - * Check for read failure. - */ - if (blockSz < 0) { /* TODO: failure info... */ - Tcl_SetResult(interp, "Channel read failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel read failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -647,7 +649,9 @@ ReadData( */ if (destSz && Tcl_Eof(pngPtr->channel)) { - Tcl_SetResult(interp, "Unexpected end of file ", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of file", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EOF", NULL); return TCL_ERROR; } } @@ -732,7 +736,8 @@ CheckCRC( */ if (calculated != chunked) { - Tcl_SetResult(interp, "CRC check failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("CRC check failed", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "CRC", NULL); return TCL_ERROR; } @@ -882,8 +887,10 @@ ReadChunkHeader( temp = PNG_INT32(pc[0], pc[1], pc[2], pc[3]); if (temp > INT_MAX) { - Tcl_SetResult(interp, "Chunk size is out of supported range " - "on this architecture", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "chunk size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "OUTSIZE", NULL); return TCL_ERROR; } @@ -967,9 +974,29 @@ ReadChunkHeader( */ if (!(chunkType & PNG_CF_ANCILLARY)) { - Tcl_SetResult(interp, - "Encountered an unsupported criticial chunk type", - TCL_STATIC); + if (chunkType & PNG_INT32(128,128,128,128)) { + /* + * No nice ASCII conversion; shouldn't happen either, but + * we'll be doubly careful. + */ + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "encountered an unsupported criticial chunk type", + -1)); + } else { + char typeString[5]; + + typeString[0] = (char) ((chunkType >> 24) & 255); + typeString[1] = (char) ((chunkType >> 16) & 255); + typeString[2] = (char) ((chunkType >> 8) & 255); + typeString[3] = (char) (chunkType & 255); + typeString[4] = '\0'; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "encountered an unsupported criticial chunk type" + " \"%s\"", typeString)); + } + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "UNSUPPORTED_CRITICAL", NULL); return TCL_ERROR; } @@ -980,7 +1007,10 @@ ReadChunkHeader( for (i=0 ; i<4 ; i++) { if ((pc[i] < 65) || (pc[i] > 122) || ((pc[i] > 90) && (pc[i] < 97))) { - Tcl_SetResult(interp, "Invalid chunk type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid chunk type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "INVALID_CHUNK", NULL); return TCL_ERROR; } } @@ -1036,7 +1066,6 @@ CheckColor( Tcl_Interp *interp, PNGImage *pngPtr) { - int result = TCL_OK; int offset; /* @@ -1049,14 +1078,14 @@ CheckColor( if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_RGB: pngPtr->numChannels = 3; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; @@ -1064,32 +1093,32 @@ CheckColor( pngPtr->numChannels = 1; if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_GRAYALPHA: pngPtr->numChannels = 2; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + goto unsupportedDepth; } break; case PNG_COLOR_RGBA: pngPtr->numChannels = 4; if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { - result = TCL_ERROR; + unsupportedDepth: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bit depth is not allowed for given color type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_DEPTH", NULL); + return TCL_ERROR; } break; default: - Tcl_SetResult(interp, "Unknown Color Type field", TCL_STATIC); - return TCL_ERROR; - } - - if (TCL_ERROR == result) { - Tcl_SetResult(interp, "Bit depth is not allowed for given color type", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type field %d", pngPtr->colorType)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } @@ -1117,9 +1146,10 @@ CheckColor( */ if (pngPtr->block.width > INT_MAX / pngPtr->block.pixelSize) { - Tcl_SetResult(interp, - "Image pitch is out of supported range on this architecture", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image pitch is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PITCH", NULL); return TCL_ERROR; } @@ -1131,8 +1161,10 @@ CheckColor( */ if (pngPtr->block.height > INT_MAX / pngPtr->block.pitch) { - Tcl_SetResult(interp, "Image total size is out of supported range " - "on this architecture", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image total size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "SIZE", NULL); return TCL_ERROR; } @@ -1159,8 +1191,9 @@ CheckColor( pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 8 : 4; break; default: - Tcl_SetResult(interp, "internal error - unknown color type", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type %d", pngPtr->colorType)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); return TCL_ERROR; } @@ -1240,8 +1273,9 @@ ReadIHDR( } if (mismatch) { - Tcl_SetResult(interp, "Data stream does not have a PNG signature", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "data stream does not have a PNG signature", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_SIG", NULL); return TCL_ERROR; } @@ -1257,12 +1291,16 @@ ReadIHDR( */ if (chunkType != CHUNK_IHDR) { - Tcl_SetResult(interp, "Expected IHDR chunk type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "expected IHDR chunk type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_IHDR", NULL); return TCL_ERROR; } if (chunkSz != 13) { - Tcl_SetResult(interp, "Invalid IHDR chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid IHDR chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IHDR", NULL); return TCL_ERROR; } @@ -1281,9 +1319,10 @@ ReadIHDR( } if (!width || !height || (width > INT_MAX) || (height > INT_MAX)) { - Tcl_SetResult(interp, - "Image dimensions are invalid or beyond architecture limits", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image dimensions are invalid or beyond architecture limits", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DIMENSIONS", NULL); return TCL_ERROR; } @@ -1325,8 +1364,10 @@ ReadIHDR( return TCL_ERROR; } - if (PNG_COMPRESS_DEFLATE != pngPtr->compression) { - Tcl_SetResult(interp, "Unknown compression method", TCL_STATIC); + if (pngPtr->compression != PNG_COMPRESS_DEFLATE) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown compression method %d", pngPtr->compression)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_COMPRESS", NULL); return TCL_ERROR; } @@ -1339,8 +1380,10 @@ ReadIHDR( return TCL_ERROR; } - if (PNG_FILTMETH_STANDARD != pngPtr->filter) { - Tcl_SetResult(interp, "Unknown filter method", TCL_STATIC); + if (pngPtr->filter != PNG_FILTMETH_STANDARD) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown filter method %d", pngPtr->filter)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -1354,7 +1397,9 @@ ReadIHDR( break; default: - Tcl_SetResult(interp, "Unknown interlace method", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown interlace method %d", pngPtr->interlace)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_INTERLACE", NULL); return TCL_ERROR; } @@ -1397,8 +1442,10 @@ ReadPLTE( switch (pngPtr->colorType) { case PNG_COLOR_GRAY: case PNG_COLOR_GRAYALPHA: - Tcl_SetResult(interp, "PLTE chunk type forbidden for grayscale", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk type forbidden for grayscale", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PLTE_UNEXPECTED", + NULL); return TCL_ERROR; default: @@ -1412,7 +1459,9 @@ ReadPLTE( */ if (!chunkSz || (chunkSz > PNG_PLTE_MAXSZ) || (chunkSz % 3)) { - Tcl_SetResult(interp, "Invalid palette chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid palette chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PLTE", NULL); return TCL_ERROR; } @@ -1474,9 +1523,10 @@ ReadTRNS( int i; if (pngPtr->colorType & PNG_COLOR_ALPHA) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "tRNS chunk not allowed color types with a full alpha channel", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_TRNS", NULL); return TCL_ERROR; } @@ -1486,7 +1536,9 @@ ReadTRNS( */ if (chunkSz > PNG_TRNS_MAXSZ) { - Tcl_SetResult(interp, "Invalid tRNS chunk size", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1515,9 +1567,9 @@ ReadTRNS( */ if (chunkSz > pngPtr->paletteLen) { - Tcl_SetResult(interp, - "Size of tRNS chunk is too large for the palette", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "size of tRNS chunk is too large for the palette", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TRNS_SIZE", NULL); return TCL_ERROR; } @@ -1533,9 +1585,10 @@ ReadTRNS( */ if (chunkSz != 2) { - Tcl_SetResult(interp, - "Invalid tRNS chunk size - must 2 bytes for grayscale", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 2 bytes for grayscale", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1559,9 +1612,9 @@ ReadTRNS( */ if (chunkSz != 6) { - Tcl_SetResult(interp, - "Invalid tRNS chunk size - must 6 bytes for RGB", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 6 bytes for RGB", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); return TCL_ERROR; } @@ -1742,7 +1795,9 @@ UnfilterLine( } break; default: - Tcl_SetResult(interp, "Invalid filter type", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid filter type %d", *thisLine)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); return TCL_ERROR; } @@ -1909,7 +1964,7 @@ DecodeLine( */ if ((PNG_COLOR_PLTE != pngPtr->colorType) && - ((pngPtr->colorType & PNG_COLOR_ALPHA) == 0)) { + !(pngPtr->colorType & PNG_COLOR_ALPHA)) { unsigned char alpha; if (pngPtr->useTRNS) { @@ -2049,8 +2104,10 @@ ReadIDAT( */ if (Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_SetResult(interp, "Extra data after end of zlib stream", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after end of zlib stream", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); return TCL_ERROR; } @@ -2089,9 +2146,11 @@ ReadIDAT( if (len2 == pngPtr->phaseSize) { if (pngPtr->phase > 7) { - Tcl_SetResult(interp, - "Extra data after final scan line of final phase", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after final scan line of final phase", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); return TCL_ERROR; } @@ -2134,8 +2193,9 @@ ReadIDAT( */ if (chunkSz != 0) { - Tcl_AppendResult(interp, - "compressed data after stream finalize in PNG data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "compressed data after stream finalize in PNG data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2271,9 +2331,10 @@ ParseFormat( } if ((pngPtr->alpha < 0.0) || (pngPtr->alpha > 1.0)) { - Tcl_SetResult(interp, - "-alpha value must be between 0.0 and 1.0", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-alpha value must be between 0.0 and 1.0", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_ALPHA", + NULL); return TCL_ERROR; } break; @@ -2363,8 +2424,9 @@ DecodePNG( return TCL_ERROR; } } else if (PNG_COLOR_PLTE == pngPtr->colorType) { - Tcl_SetResult(interp, "PLTE chunk required for indexed color", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk required for indexed color", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_PLTE", NULL); return TCL_ERROR; } @@ -2399,9 +2461,10 @@ DecodePNG( * interested in IDAT. The others should have been skipped. */ - if (CHUNK_IDAT != chunkType) { - Tcl_SetResult(interp, "At least one IDAT chunk is required", - TCL_STATIC); + if (chunkType != CHUNK_IDAT) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "at least one IDAT chunk is required", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_IDAT", NULL); return TCL_ERROR; } @@ -2422,9 +2485,10 @@ DecodePNG( */ if (pngPtr->block.width > ((INT_MAX - 1) / (pngPtr->numChannels * 2))) { - Tcl_SetResult(interp, - "Line size is out of supported range on this architecture", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "line size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "LINE_SIZE", NULL); return TCL_ERROR; } @@ -2449,7 +2513,9 @@ DecodePNG( pngPtr->block.pixelPtr = attemptckalloc(pngPtr->blockLen); if (!pngPtr->block.pixelPtr) { - Tcl_SetResult(interp, "Memory allocation failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } @@ -2499,7 +2565,9 @@ DecodePNG( */ if (!Tcl_ZlibStreamEof(pngPtr->stream)) { - Tcl_AppendResult(interp, "unfinalized data stream in PNG data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unfinalized data stream in PNG data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); return TCL_ERROR; } @@ -2523,8 +2591,9 @@ DecodePNG( */ if (chunkSz) { - Tcl_SetResult(interp, "IEND chunk contents must be empty", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "IEND chunk contents must be empty", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } @@ -2543,7 +2612,9 @@ DecodePNG( #if 0 if (ReadData(interp, pngPtr, &c, 1, NULL) != TCL_ERROR) { - Tcl_SetResult(interp, "Extra data following IEND chunk", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data following IEND chunk", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); return TCL_ERROR; } #endif @@ -2795,24 +2866,25 @@ WriteData( Tcl_GetByteArrayFromObj(pngPtr->objDataPtr, &objSz); if (objSz > INT_MAX - srcSz) { - Tcl_SetResult(interp, - "Image too large to store completely in byte array", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image too large to store completely in byte array", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } destPtr = Tcl_SetByteArrayLength(pngPtr->objDataPtr, objSz + srcSz); if (!destPtr) { - Tcl_SetResult(interp, "Memory allocation failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } memcpy(destPtr+objSz, srcPtr, srcSz); } else if (Tcl_Write(pngPtr->channel, (const char *) srcPtr, srcSz) < 0) { - /* TODO: reason */ - - Tcl_SetResult(interp, "Write to channel failed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "write to channel failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -3127,7 +3199,9 @@ WriteIDAT( } if (Tcl_ZlibStreamPut(pngPtr->stream, pngPtr->thisLineObj, flush) != TCL_OK) { - Tcl_SetResult(interp, "deflate() returned error", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "deflate() returned error", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DEFLATE", NULL); return TCL_ERROR; } @@ -3301,8 +3375,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_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image is too large to encode pixel data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); return TCL_ERROR; } diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c index 527efa2..edd1b71 100644 --- a/generic/tkImgPPM.c +++ b/generic/tkImgPPM.c @@ -147,21 +147,22 @@ FileReadPPM( type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read raw PPM header from file \"%s\"", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has dimension(s) <= 0", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has bad maximum intensity value ", buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has bad maximum intensity value %d", + fileName, maxIntensity)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -218,10 +219,12 @@ FileReadPPM( } count = Tcl_Read(chan, (char *) pixelPtr, nBytes); if (count != nBytes) { - Tcl_AppendResult(interp, "error reading PPM image file \"", - fileName, "\": ", - Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading PPM image file \"%s\": %s", fileName, + Tcl_Eof(chan)?"not enough data":Tcl_PosixError(interp))); + if (Tcl_Eof(chan)) { + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "EOF", NULL); + } ckfree(pixelPtr); return TCL_ERROR; } @@ -325,8 +328,8 @@ FileWritePPM( chan = NULL; writeerror: - Tcl_AppendResult(interp, "error writing \"", fileName, "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", + fileName, Tcl_PosixError(interp))); if (chan != NULL) { Tcl_Close(NULL, chan); } @@ -482,22 +485,22 @@ StringReadPPM( type = ReadPPMStringHeader(dataObj, &fileWidth, &fileHeight, &maxIntensity, &dataBuffer, &dataSize); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from string", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't read raw PPM header from string", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image data has dimension(s) <= 0", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PPM image data has dimension(s) <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity >= 256)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, - "PPM image data has bad maximum intensity value ", buffer, - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image data has bad maximum intensity value %d", + maxIntensity)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } @@ -538,7 +541,9 @@ StringReadPPM( */ if (block.pitch*height > dataSize) { - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } block.pixelPtr = dataBuffer + srcX * block.pixelSize; @@ -572,7 +577,9 @@ StringReadPPM( } if (dataSize < nBytes) { ckfree(pixelPtr); - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } for (p=pixelPtr,count=nBytes ; count>0 ; count--,p++,dataBuffer++) { diff --git a/generic/tkImgPhInstance.c b/generic/tkImgPhInstance.c index 5429ee3..3097489 100644 --- a/generic/tkImgPhInstance.c +++ b/generic/tkImgPhInstance.c @@ -1068,8 +1068,7 @@ GetColorTable( * Allocate colors for this color table if necessary. */ - if ((colorPtr->numColors == 0) - && ((colorPtr->flags & BLACK_AND_WHITE) == 0)) { + if ((colorPtr->numColors == 0) && !(colorPtr->flags & BLACK_AND_WHITE)) { AllocateColors(colorPtr); } } @@ -1104,12 +1103,12 @@ FreeColorTable( } if (force) { - if ((colorPtr->flags & DISPOSE_PENDING) != 0) { + if (colorPtr->flags & DISPOSE_PENDING) { Tcl_CancelIdleCall(DisposeColorTable, colorPtr); colorPtr->flags &= ~DISPOSE_PENDING; } DisposeColorTable(colorPtr); - } else if ((colorPtr->flags & DISPOSE_PENDING) == 0) { + } else if (!(colorPtr->flags & DISPOSE_PENDING)) { Tcl_DoWhenIdle(DisposeColorTable, colorPtr); colorPtr->flags |= DISPOSE_PENDING; } @@ -1813,11 +1812,11 @@ TkImgDitherInstance( } c = ((c + 2056) >> 4) - 128; - if ((masterPtr->flags & COLOR_IMAGE) == 0) { - c += srcPtr[0]; - } else { + if (masterPtr->flags & COLOR_IMAGE) { c += (unsigned) (srcPtr[0] * 11 + srcPtr[1] * 16 + srcPtr[2] * 5 + 16) >> 5; + } else { + c += srcPtr[0]; } srcPtr += 4; @@ -1886,11 +1885,11 @@ TkImgDitherInstance( } c = ((c + 2056) >> 4) - 128; - if ((masterPtr->flags & COLOR_IMAGE) == 0) { - c += srcPtr[0]; - } else { + if (masterPtr->flags & COLOR_IMAGE) { c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16 + srcPtr[2] * 5 + 16) >> 5; + } else { + c += srcPtr[0]; } srcPtr += 4; diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 5b172f1..ce160a4 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -504,7 +504,7 @@ ImgPhotoCmd( * TODO: Modifying result is bad! */ - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), masterPtr->dataString); } else { Tcl_AppendResult(interp, " {}", NULL); @@ -518,7 +518,7 @@ ImgPhotoCmd( * TODO: Modifying result is bad! */ - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), masterPtr->format); } else { Tcl_AppendResult(interp, " {}", NULL); @@ -562,17 +562,21 @@ ImgPhotoCmd( srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name)); if (srcHandle == NULL) { - Tcl_AppendResult(interp, "image \"", - Tcl_GetString(options.name), "\" doesn't", - " exist or is not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist or is not a photo image", + Tcl_GetString(options.name))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO", + Tcl_GetString(options.name), NULL); return TCL_ERROR; } Tk_PhotoGetImage(srcHandle, &block); if ((options.fromX2 > block.width) || (options.fromY2 > block.height) || (options.fromX2 > block.width) || (options.fromY2 > block.height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -624,8 +628,9 @@ ImgPhotoCmd( if (options.options & OPT_SHRINK) { if (ImgPhotoSetSize(masterPtr, options.toX2, options.toY2) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -672,8 +677,9 @@ ImgPhotoCmd( || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -681,7 +687,7 @@ ImgPhotoCmd( * Fill in default values for unspecified parameters. */ - if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { + if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { options.fromX2 = masterPtr->width; options.fromY2 = masterPtr->height; } @@ -719,9 +725,12 @@ ImgPhotoCmd( } } if (stringWriteProc == NULL) { - Tcl_AppendResult(interp, "image string format \"", - Tcl_GetString(options.format), "\" is ", - (matched ? "not supported" : "unknown"), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image string format \"%s\" is %s", + Tcl_GetString(options.format), + (matched ? "not supported" : "unknown"))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + Tcl_GetString(options.format), NULL); return TCL_ERROR; } } else { @@ -770,7 +779,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"); @@ -782,8 +791,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ", - "coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s get: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -792,9 +804,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; } @@ -820,7 +833,7 @@ ImgPhotoCmd( &imageHeight, &oldformat) == TCL_OK) { Tcl_Obj *format, *data; - if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) { + if (!(options.options & OPT_TO) || (options.toX2 < 0)) { options.toX2 = options.toX + imageWidth; options.toY2 = options.toY + imageHeight; } @@ -876,8 +889,11 @@ ImgPhotoCmd( pixelPtr = ckalloc(dataWidth * dataHeight * 3); block.pixelPtr = pixelPtr; } else if (listObjc != dataWidth) { - Tcl_AppendResult(interp, "all elements of color list must", - " have the same number of elements", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "all elements of color list must have the same" + " number of elements", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NON_RECTANGULAR", NULL); break; } @@ -920,8 +936,9 @@ ImgPhotoCmd( if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), colorString, &color)) { - Tcl_AppendResult(interp, "can't parse color \"", - colorString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't parse color \"%s\"", colorString)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); break; } *pixelPtr++ = color.red >> 8; @@ -992,8 +1009,9 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get image from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); return TCL_ERROR; } @@ -1031,12 +1049,14 @@ ImgPhotoCmd( if ((options.fromX > imageWidth) || (options.fromY > imageHeight) || (options.fromX2 > imageWidth) || (options.fromY2 > imageHeight)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } - if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { + if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { width = imageWidth - options.fromX; height = imageHeight - options.fromY; } else { @@ -1052,7 +1072,9 @@ ImgPhotoCmd( if (ImgPhotoSetSize(masterPtr, options.toX + width, options.toY + height) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -1143,8 +1165,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency get: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency get: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1180,8 +1205,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency set: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency set: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1244,8 +1272,9 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't write image to a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't write image to a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); return TCL_ERROR; } @@ -1270,8 +1299,9 @@ ImgPhotoCmd( || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -1338,19 +1368,19 @@ ImgPhotoCmd( } if (imageFormat == NULL) { if (fmtString == NULL) { - Tcl_AppendResult(interp, "no available image file format ", - "has file writing capability", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no available image file format has file writing" + " capability", -1)); } else if (!matched) { - Tcl_AppendResult(interp, "image file format \"", - fmtString, "\" is unknown", NULL); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - fmtString, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is unknown", fmtString)); } else { - Tcl_AppendResult(interp, "image file format \"", - fmtString, "\" has no file writing capability", NULL); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - fmtString, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" has no file writing capability", + fmtString)); } + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + fmtString, NULL); return TCL_ERROR; } @@ -1441,10 +1471,16 @@ ParseSubcommandOptions( int objc, /* Number of arguments in objv[]. */ Tcl_Obj *const objv[]) /* Arguments to be parsed. */ { + static const char *const compositingRules[] = { + "overlay", "set", /* Note that these must match the + * TK_PHOTO_COMPOSITE_* constants. */ + NULL + }; int index, c, bit, currentBit, length; int values[4], numValues, maxValues, argIndex; - const char *option; + const char *option, *expandedOption, *needed; const char *const *listPtr; + Tcl_Obj *msgObj; for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) { /* @@ -1452,7 +1488,7 @@ ParseSubcommandOptions( * optPtr->name. */ - option = Tcl_GetStringFromObj(objv[index], &length); + expandedOption = option = Tcl_GetStringFromObj(objv[index], &length); if (option[0] != '-') { if (optPtr->name == NULL) { optPtr->name = objv[index]; @@ -1471,9 +1507,9 @@ ParseSubcommandOptions( for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((c == *listPtr[0]) && (strncmp(option, *listPtr, (size_t) length) == 0)) { + expandedOption = *listPtr; if (bit != 0) { - bit = 0; /* An ambiguous option. */ - break; + goto unknownOrAmbiguousOption; } bit = currentBit; } @@ -1485,24 +1521,8 @@ ParseSubcommandOptions( * in the interpreter and return. */ - if ((allowedOptions & bit) == 0) { - Tcl_AppendResult(interp, "unrecognized option \"", - Tcl_GetString(objv[index]), - "\": must be ", NULL); - bit = 1; - for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { - if ((allowedOptions & bit) != 0) { - if ((allowedOptions & (bit - 1)) != 0) { - Tcl_AppendResult(interp, ", ", NULL); - if ((allowedOptions & ~((bit << 1) - 1)) == 0) { - Tcl_AppendResult(interp, "or ", NULL); - } - } - Tcl_AppendResult(interp, *listPtr, NULL); - } - bit <<= 1; - } - return TCL_ERROR; + if (!(allowedOptions & bit)) { + goto unknownOrAmbiguousOption; } /* @@ -1515,16 +1535,13 @@ ParseSubcommandOptions( * The -background option takes a single XColor value. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp), - Tk_GetUid(Tcl_GetString(objv[index]))); - if (!optPtr->background) { - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "the \"-background\" option ", - "requires a value", NULL); + if (index + 1 >= objc) { + goto oneValueRequired; + } + *optIndexPtr = ++index; + optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp), + Tk_GetUid(Tcl_GetString(objv[index]))); + if (!optPtr->background) { return TCL_ERROR; } } else if (bit == OPT_FORMAT) { @@ -1533,45 +1550,31 @@ ParseSubcommandOptions( * parsing this is outside the scope of this function. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->format = objv[index]; - } else { - Tcl_AppendResult(interp, "the \"-format\" option ", - "requires a value", NULL); - return TCL_ERROR; + if (index + 1 >= objc) { + goto oneValueRequired; } + *optIndexPtr = ++index; + optPtr->format = objv[index]; } else if (bit == OPT_COMPOSITE) { /* * The -compositingrule option takes a single value from a * well-known set. */ - if (index + 1 < objc) { - /* - * Note that these must match the TK_PHOTO_COMPOSITE_* - * constants. - */ - - static const char *const compositingRules[] = { - "overlay", "set", NULL - }; - - index++; - if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules, - "compositing rule", 0, &optPtr->compositingRule) - != TCL_OK) { - return TCL_ERROR; - } - *optIndexPtr = index; - } else { - Tcl_AppendResult(interp, "the \"-compositingrule\" option ", - "requires a value", NULL); + if (index + 1 >= objc) { + goto oneValueRequired; + } + index++; + if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules, + "compositing rule", 0, &optPtr->compositingRule) + != TCL_OK) { return TCL_ERROR; } + *optIndexPtr = index; } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { const char *val; - maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2; + + maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2; argIndex = index + 1; for (numValues = 0; numValues < maxValues; ++numValues) { if (argIndex >= objc) { @@ -1591,10 +1594,7 @@ ParseSubcommandOptions( } if (numValues == 0) { - Tcl_AppendResult(interp, "the \"", option, "\" option ", - "requires one ", maxValues == 2? "or two": "to four", - " integer values", NULL); - return TCL_ERROR; + goto manyValuesRequired; } *optIndexPtr = (index += numValues); @@ -1618,9 +1618,8 @@ ParseSubcommandOptions( case OPT_FROM: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -from", - " option must be non-negative", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->fromX = values[0]; @@ -1641,9 +1640,8 @@ ParseSubcommandOptions( case OPT_TO: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -to", - " option must be non-negative", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->toX = values[0]; @@ -1659,9 +1657,8 @@ ParseSubcommandOptions( break; case OPT_ZOOM: if ((values[0] <= 0) || (values[1] <= 0)) { - Tcl_AppendResult(interp, "value(s) for the -zoom", - " option must be positive", NULL); - return TCL_ERROR; + needed = "positive"; + goto numberOutOfRange; } optPtr->zoomX = values[0]; optPtr->zoomY = values[1]; @@ -1675,8 +1672,50 @@ ParseSubcommandOptions( optPtr->options |= bit; } - return TCL_OK; + + /* + * Exception generation. + */ + + oneValueRequired: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires a value", expandedOption)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL); + return TCL_ERROR; + + manyValuesRequired: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires one %s integer values", + expandedOption, (maxValues == 2) ? "or two": "to four")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL); + return TCL_ERROR; + + numberOutOfRange: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value(s) for the %s option must be %s", expandedOption, needed)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_VALUE", NULL); + return TCL_ERROR; + + unknownOrAmbiguousOption: + msgObj = Tcl_ObjPrintf("unrecognized option \"%s\": must be ", option); + bit = 1; + for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { + if (allowedOptions & bit) { + if (allowedOptions & (bit - 1)) { + if (allowedOptions & ~((bit << 1) - 1)) { + Tcl_AppendToObj(msgObj, ", ", -1); + } else { + Tcl_AppendToObj(msgObj, ", or ", -1); + } + } + Tcl_AppendToObj(msgObj, *listPtr, -1); + } + bit <<= 1; + } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; } /* @@ -1730,8 +1769,10 @@ ImgPhotoConfigureMaster( j--; } else { ckfree(args); - Tcl_AppendResult(interp, - "value for \"-data\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-data\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); return TCL_ERROR; } } else if ((args[j][1] == 'f') && @@ -1741,8 +1782,10 @@ ImgPhotoConfigureMaster( j--; } else { ckfree(args); - Tcl_AppendResult(interp, - "value for \"-format\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-format\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); return TCL_ERROR; } } @@ -1832,8 +1875,9 @@ ImgPhotoConfigureMaster( if (ImgPhotoSetSize(masterPtr, masterPtr->width, masterPtr->height) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -1851,8 +1895,10 @@ ImgPhotoConfigureMaster( if (Tcl_IsSafe(interp)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "can't get image from a file in a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); goto errorExit; } @@ -1876,8 +1922,9 @@ ImgPhotoConfigureMaster( result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight); if (result != TCL_OK) { Tcl_Close(NULL, chan); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -1906,8 +1953,9 @@ ImgPhotoConfigureMaster( goto errorExit; } if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -2351,8 +2399,11 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_FILE_FORMAT", NULL); return TCL_ERROR; } } @@ -2382,8 +2433,11 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_FILE_FORMAT", NULL); return TCL_ERROR; } } @@ -2405,12 +2459,17 @@ MatchFileFormat( if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image file format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is not supported", + formatString)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + formatString, NULL); } else { - Tcl_AppendResult(interp, - "couldn't recognize data in image file \"", fileName, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't recognize data in image file \"%s\"", + fileName)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE", + "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; } @@ -2480,8 +2539,11 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_DATA_FORMAT", NULL); return TCL_ERROR; } } @@ -2504,8 +2566,11 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_DATA_FORMAT", NULL); return TCL_ERROR; } } @@ -2521,10 +2586,15 @@ MatchStringFormat( } if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image format \"%s\" is not supported", formatString)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + formatString, NULL); } else { - Tcl_AppendResult(interp, "couldn't recognize image data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't recognize image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; } @@ -2641,8 +2711,9 @@ Tk_PhotoPutBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3037,8 +3108,9 @@ Tk_PhotoPutZoomedBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3435,8 +3507,9 @@ Tk_PhotoExpand( if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width), MAX(height, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -3509,8 +3582,9 @@ Tk_PhotoSetSize( if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width), ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } diff --git a/generic/tkInt.h b/generic/tkInt.h index 88e0c25..833dd0c 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1168,7 +1168,7 @@ MODULE_SCOPE void TkpBuildRegionFromAlphaData(TkRegion region, unsigned x, unsigned y, unsigned width, unsigned height, unsigned char *dataPtr, unsigned pixelStride, unsigned lineStride); -MODULE_SCOPE void TkPrintPadAmount(Tcl_Interp *interp, +MODULE_SCOPE void TkAppendPadAmount(Tcl_Obj *bufferObj, const char *buffer, int pad1, int pad2); MODULE_SCOPE int TkParsePadAmount(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 7faa44b..620f82f 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) { @@ -872,8 +872,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", - Tcl_GetString(objv[2]), "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL); result = TCL_ERROR; break; } @@ -892,7 +894,6 @@ ListboxWidgetObjCmd( } case COMMAND_ITEMCONFIGURE: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc < 3) { @@ -908,8 +909,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", Tcl_GetString(objv[2]), - "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL); result = TCL_ERROR; break; } @@ -922,10 +925,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 +1009,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 +1017,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 +1092,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 +1113,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 +1202,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 +1236,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 +1314,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 +1331,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 +1392,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 +1918,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 +1927,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 +2009,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 +2245,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 +2446,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); @@ -2739,18 +2746,12 @@ GetListboxIndex( start = stringRep + 1; y = strtol(start, &end, 0); if ((start == end) || (*end != ',')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } start = end+1; y = strtol(start, &end, 0); if ((start == end) || (*end != '\0')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } *indexPtr = NearestListboxElement(listPtr, y); return TCL_OK; @@ -2768,10 +2769,11 @@ GetListboxIndex( * Everything failed, nothing matched. Throw up an error message. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad listbox index \"", - Tcl_GetString(indexObj), "\": must be active, anchor, ", - "end, @x,y, or a number", NULL); + badIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad listbox index \"%s\": must be active, anchor, end, @x,y," + " or a number", Tcl_GetString(indexObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", NULL); return TCL_ERROR; } @@ -2903,7 +2905,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 +2957,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 +3028,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 +3039,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 +3054,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 +3111,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 +3252,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 +3311,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 +3431,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 +3441,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 +3515,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/tkMenu.c b/generic/tkMenu.c index 49f49ad..12d6ebd 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -374,8 +374,8 @@ static void TkMenuCleanup(ClientData unused); static const Tk_ClassProcs menuClass = { sizeof(Tk_ClassProcs), /* size */ MenuWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -889,7 +889,7 @@ MenuWidgetObjCmd( goto error; } if (index < 0) { - Tcl_SetResult(interp, "none", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); } @@ -966,6 +966,7 @@ MenuWidgetObjCmd( } case MENU_TYPE: { int index; + const char *typeStr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -978,11 +979,11 @@ MenuWidgetObjCmd( goto done; } if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { - Tcl_SetResult(interp, "tearoff", TCL_STATIC); + typeStr = "tearoff"; } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - menuEntryTypeStrings[menuPtr->entries[index]->type], -1)); + typeStr = menuEntryTypeStrings[menuPtr->entries[index]->type]; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); break; } case MENU_UNPOST: @@ -2206,7 +2207,9 @@ TkGetMenuIndex( } } - Tcl_AppendResult(interp, "bad menu entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad menu entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; success: @@ -2390,9 +2393,9 @@ MenuAddOrInsert( index = menuPtr->numEntries; } if (index < 0) { - const char *indexString = Tcl_GetString(indexPtr); - - Tcl_AppendResult(interp, "bad index \"", indexString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\"", Tcl_GetString(indexPtr))); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; } if (menuPtr->tearoff && (index == 0)) { @@ -3265,6 +3268,7 @@ TkSetWindowMenuBar( && (cloneMenuRefPtr->menuPtr != NULL)) { Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1); Tcl_Obj *nullPtr = Tcl_NewObj(); + cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin; menuBarPtr = cloneMenuRefPtr->menuPtr; newObjv[0] = cursorPtr; @@ -3468,6 +3472,7 @@ TkFindMenuReferencesObj( Tcl_Obj *objPtr) /* The path of the menu widget. */ { const char *pathName = Tcl_GetString(objPtr); + return TkFindMenuReferences(interp, pathName); } diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 31dbfbb..545401c 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -23,8 +23,8 @@ static const Tk_ClassProcs menubuttonClass = { sizeof(Tk_ClassProcs), /* size */ TkMenuButtonWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* diff --git a/generic/tkMessage.c b/generic/tkMessage.c index 0787efc..4779e00 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -191,8 +191,8 @@ static void DisplayMessage(ClientData clientData); static const Tk_ClassProcs messageClass = { sizeof(Tk_ClassProcs), /* size */ MessageWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -277,7 +277,7 @@ Tk_MessageObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(msgPtr->tkwin)); return TCL_OK; } diff --git a/generic/tkObj.c b/generic/tkObj.c index 8877d42..ed947d3 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; } @@ -734,8 +735,9 @@ SetMMFromAny( */ error: - Tcl_AppendResult(interp, "bad screen distance \"", string, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DISTANCE", NULL); return TCL_ERROR; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { @@ -1032,10 +1034,10 @@ TkParsePadAmount( if (specObj->typePtr == &pixelObjType) { if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK){ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", - Tcl_GetString(specObj), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(specObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } secondInt = firstInt; @@ -1051,8 +1053,9 @@ TkParsePadAmount( return TCL_ERROR; } if (objc != 1 && objc != 2) { - Tcl_AppendResult(interp, - "wrong number of parts to pad specification", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong number of parts to pad specification", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "PARTS", NULL); return TCL_ERROR; } @@ -1062,9 +1065,10 @@ TkParsePadAmount( if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK || (firstInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1077,10 +1081,10 @@ TkParsePadAmount( secondInt = firstInt; } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1], &secondInt) != TCL_OK || (secondInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad 2nd pad value \"", - Tcl_GetString(objv[1]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad 2nd pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index 1ab6ab6..5496076 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -95,7 +95,8 @@ Tk_ConfigureWidget( * we're on our way out of the application */ - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return TCL_ERROR; } @@ -135,7 +136,9 @@ Tk_ConfigureWidget( */ if (argc < 2) { - Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", arg)); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); return TCL_ERROR; } if (flags & TK_CONFIG_OBJS) { @@ -144,11 +147,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 +181,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 +197,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; } } @@ -272,15 +267,18 @@ FindConfigSpec( goto gotMatch; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", argvName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL); return NULL; } matchPtr = specPtr; } if (matchPtr == NULL) { - Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL); return NULL; } @@ -294,8 +292,11 @@ FindConfigSpec( if (specPtr->type == TK_CONFIG_SYNONYM) { for (specPtr = specs; ; specPtr++) { if (specPtr->type == TK_CONFIG_END) { - Tcl_AppendResult(interp, "couldn't find synonym for option \"", - argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't find synonym for option \"%s\"", + argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, + NULL); return NULL; } if ((specPtr->dbName == matchPtr->dbName) @@ -546,14 +547,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; @@ -626,12 +625,13 @@ Tk_ConfigureInfo( Tcl_ResetResult(interp); if (argvName != NULL) { - specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags,hateFlags); + specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags, + hateFlags); if (specPtr == NULL) { return TCL_ERROR; } list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); - Tcl_SetResult(interp, list, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(list, -1)); ckfree(list); return TCL_OK; } @@ -936,7 +936,7 @@ Tk_ConfigureValue( } result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, &freeProc); - Tcl_SetResult(interp, (char *) result, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); if (freeProc != NULL) { if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { ckfree(result); diff --git a/generic/tkOption.c b/generic/tkOption.c index d5c423f..ec9e465 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; @@ -693,7 +690,7 @@ Tk_OptionObjCmd( value = Tk_GetOption(window, Tcl_GetString(objv[3]), Tcl_GetString(objv[4])); if (value != NULL) { - Tcl_SetResult(interp, (char *) value, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); } break; } @@ -880,9 +877,11 @@ ParsePriority( priority = strtoul(string, &end, 0); if ((end == string) || (*end != 0) || (priority < 0) || (priority > 100)) { - Tcl_AppendResult(interp, "bad priority level \"", string, - "\": must be widgetDefault, startupFile, userDefault, ", - "interactive, or a number between 0 and 100", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad priority level \"%s\": must be " + "widgetDefault, startupFile, userDefault, " + "interactive, or a number between 0 and 100", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PRIORITY", NULL); return -1; } } @@ -964,10 +963,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 +997,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 +1011,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')) { @@ -1066,7 +1062,7 @@ ReadOptionFile( Tcl_Interp *interp, /* Interpreter to use for reporting results. */ Tk_Window tkwin, /* Token for window: options are entered for * this window's main window. */ - const char *fileName, /* Name of file containing options. */ + const char *fileName, /* Name of file containing options. */ int priority) /* Priority level to use for options in this * file, such as TK_USER_DEFAULT_PRIO or * TK_INTERACTIVE_PRIO. Must be between 0 and @@ -1083,8 +1079,9 @@ ReadOptionFile( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't read options from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't read options from a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "OPTION_FILE", NULL); return TCL_ERROR; } @@ -1095,9 +1092,8 @@ ReadOptionFile( chan = Tcl_OpenFileChannel(interp, realName, "r", 0); Tcl_DStringFree(&newName); if (chan == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't open \"", fileName, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't open \"%s\": %s", + fileName, Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1110,8 +1106,9 @@ ReadOptionFile( Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error seeking to end of file \"", - fileName, "\":", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error seeking to end of file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1119,8 +1116,9 @@ ReadOptionFile( buffer = ckalloc(bufferSize + 1); bufferSize = Tcl_Read(chan, buffer, bufferSize); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error reading file \"", fileName, "\":", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1309,6 +1307,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..d91fda7 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -133,11 +133,11 @@ static int YExpansion(Packer *slavePtr, int cavityHeight); /* *------------------------------------------------------------------------ * - * TkPrintPadAmount -- + * TkAppendPadAmount -- * * This function generates a text value that describes one of the -padx, * -pady, -ipadx, or -ipady configuration options. The text value - * generated is appended to the interpreter result. + * generated is appended to the given Tcl_Obj. * * Results: * None. @@ -149,21 +149,25 @@ static int YExpansion(Packer *slavePtr, int cavityHeight); */ void -TkPrintPadAmount( - Tcl_Interp *interp, /* The interpreter into which the result is +TkAppendPadAmount( + Tcl_Obj *bufferObj, /* 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]; + Tcl_Obj *padding[2]; + if (halfSpace*2 == allSpace) { - sprintf(buffer, " -%.10s %d", switchName, halfSpace); + Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1), + Tcl_NewIntObj(halfSpace)); } else { - sprintf(buffer, " -%.10s {%d %d}", switchName, halfSpace, - allSpace - halfSpace); + padding[0] = Tcl_NewIntObj(halfSpace); + padding[1] = Tcl_NewIntObj(allSpace - halfSpace); + Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1), + Tcl_NewListObj(2, padding)); } - Tcl_AppendResult(interp, buffer, NULL); } /* @@ -238,8 +242,9 @@ Tk_PackObjCmd( } prevPtr = GetPacker(tkwin2); if (prevPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } return PackAfter(interp, prevPtr, prevPtr->masterPtr, objc-3, objv+3); @@ -271,8 +276,9 @@ Tk_PackObjCmd( } packPtr = GetPacker(tkwin2); if (packPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } masterPtr = packPtr->masterPtr; @@ -293,8 +299,9 @@ Tk_PackObjCmd( } case PACK_CONFIGURE: if (argv2[0] != '.') { - Tcl_AppendResult(interp, "bad argument \"", argv2, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", argv2)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); return TCL_ERROR; } return ConfigureSlaves(interp, tkwin, objc-2, objv+2); @@ -323,6 +330,7 @@ Tk_PackObjCmd( case PACK_INFO: { register Packer *slavePtr; Tk_Window slave; + Tcl_Obj *infoObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -333,35 +341,44 @@ Tk_PackObjCmd( } slavePtr = GetPacker(slave); if (slavePtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); - Tcl_AppendElement(interp, "-anchor"); - Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); - Tcl_AppendResult(interp, " -expand ", - (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ", NULL); + + infoObj = Tcl_NewObj(); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1), + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-anchor", -1), + Tcl_NewStringObj(Tk_NameOfAnchor(slavePtr->anchor), -1)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-expand", -1), + Tcl_NewBooleanObj(slavePtr->flags & EXPAND)); switch (slavePtr->flags & (FILLX|FILLY)) { case 0: - Tcl_AppendResult(interp, "none", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("none", -1)); break; case FILLX: - Tcl_AppendResult(interp, "x", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("x", -1)); break; case FILLY: - Tcl_AppendResult(interp, "y", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("y", -1)); break; case FILLX|FILLY: - Tcl_AppendResult(interp, "both", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("both", -1)); break; } - TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX); - TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY); - TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX); - TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY); - Tcl_AppendResult(interp, " -side ", sideNames[slavePtr->side], NULL); + TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX); + TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY); + TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft,slavePtr->padX); + TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-side", -1), + Tcl_NewStringObj(sideNames[slavePtr->side], -1)); + Tcl_SetObjResult(interp, infoObj); break; } case PACK_PROPAGATE: { @@ -1096,9 +1113,10 @@ PackAfter( for ( ; objc > 0; objc -= 2, objv += 2, prevPtr = packPtr) { if (objc < 2) { - Tcl_AppendResult(interp, "wrong # args: window \"", - Tcl_GetString(objv[0]), "\" should be followed by options", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: \"%s\" should be followed by options", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -1120,8 +1138,10 @@ PackAfter( } if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) { badWindow: - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[0]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[0]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } @@ -1179,8 +1199,10 @@ PackAfter( } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) { if (optionCount < (index+2)) { missingPad: - Tcl_AppendResult(interp, "wrong # args: \"", curOpt, - "\" option must be followed by screen distance", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: window \"%s\" option must be" + " followed by screen distance", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -1207,8 +1229,11 @@ PackAfter( } else if ((c == 'f') && (length > 1) && (strncmp(curOpt, "frame", (size_t) length) == 0)) { if (optionCount < (index+2)) { - Tcl_AppendResult(interp, "wrong # args: \"frame\" ", - "option must be followed by anchor point", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args: \"frame\"" + " option must be followed by anchor point", -1)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } if (Tk_GetAnchorFromObj(interp, options[index+1], @@ -1217,15 +1242,17 @@ PackAfter( } index++; } else { - Tcl_AppendResult(interp, "bad option \"", curOpt, - "\": should be top, bottom, left, right, expand, ", - "fill, fillx, filly, padx, pady, or frame", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": should be top, bottom, left," + " right, expand, fill, fillx, filly, padx, pady, or" + " frame", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } } if (packPtr != prevPtr) { - /* * Unpack this window if it's currently packed. */ @@ -1534,8 +1561,10 @@ ConfigureSlaves( return TCL_ERROR; } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't pack \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetPacker(slave); @@ -1558,9 +1587,10 @@ ConfigureSlaves( for (i = numWindows; i < objc; i+=2) { if ((i+2) > objc) { - Tcl_AppendResult(interp, "extra option \"", - Tcl_GetString(objv[i]), - "\" (option with no value?)", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "extra option \"%s\" (option with no value?)", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "PACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", @@ -1578,8 +1608,10 @@ ConfigureSlaves( prevPtr = GetPacker(other); if (prevPtr->masterPtr == NULL) { notPacked: - Tcl_AppendResult(interp, "window \"", - Tcl_GetString(objv[i+1]), "\" isn't packed", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } @@ -1635,8 +1667,10 @@ ConfigureSlaves( } else if (strcmp(string, "both") == 0) { slavePtr->flags |= FILLX|FILLY; } else { - Tcl_AppendResult(interp, "bad fill style \"", string, - "\": must be none, x, y, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad fill style \"%s\": must be " + "none, x, y, or both", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILL", NULL); return TCL_ERROR; } break; @@ -1658,24 +1692,22 @@ ConfigureSlaves( break; case CONF_IPADX: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; break; case CONF_IPADY: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -1752,14 +1784,17 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } if (slave == masterPtr->tkwin) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside itself", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside itself", Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 23ecf5d..4a4af53 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -658,10 +658,13 @@ PanedWindowWidgetObjCmd( objv[3], tkwin); } } - if (i == pwPtr->numSlaves) { - Tcl_SetResult(interp, "not managed by this window", TCL_STATIC); - } if (resultObj == NULL) { + if (i == pwPtr->numSlaves) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not managed by this window", -1)); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", + NULL); + } result = TCL_ERROR; } else { Tcl_SetObjResult(interp, resultObj); @@ -700,15 +703,11 @@ PanedWindowWidgetObjCmd( case PW_PANES: resultObj = Tcl_NewObj(); - - Tcl_IncrRefCount(resultObj); - for (i = 0; i < pwPtr->numSlaves; i++) { - Tcl_ListObjAppendElement(interp, resultObj, - Tcl_NewStringObj(Tk_PathName(pwPtr->slaves[i]->tkwin),-1)); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj(pwPtr->slaves[i]->tkwin)); } Tcl_SetObjResult(interp, resultObj); - Tcl_DecrRefCount(resultObj); break; case PW_PROXY: @@ -778,18 +777,19 @@ ConfigureSlaves( * A panedwindow cannot manage itself. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to itself", arg)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } else if (Tk_IsTopLevel(tkwin)) { /* * A panedwindow cannot manage a toplevel. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add toplevel ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add toplevel %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } else { /* @@ -803,9 +803,11 @@ ConfigureSlaves( break; } if (Tk_IsTopLevel(ancestor)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); return TCL_ERROR; } } @@ -862,9 +864,10 @@ ConfigureSlaves( */ if (haveLoc && index == -1) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkwin), - "\" is not managed by ", Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not managed by %s", + Tk_PathName(tkwin), Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", NULL); Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin); return TCL_ERROR; @@ -1086,7 +1089,6 @@ PanedWindowSashCommand( return TCL_ERROR; } - Tcl_ResetResult(interp); switch ((enum sashOptions) index) { case SASH_COORD: if (objc != 4) { @@ -1099,8 +1101,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } slavePtr = pwPtr->slaves[sash]; @@ -1121,8 +1124,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } @@ -1156,8 +1160,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } @@ -2398,10 +2403,11 @@ SetSticky( case ' ': case ',': case '\t': case '\r': case '\n': break; default: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(*value), "\": must be a string ", - "containing zero or more of n, e, s, and w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be a string" + " containing zero or more of n, e, s, and w", + Tcl_GetString(*value))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } } @@ -2654,7 +2660,7 @@ MoveSash( * None. * * Side effects: - * When the window gets deleted, internal structures get cleaned up. Whena + * When the window gets deleted, internal structures get cleaned up. When * it gets exposed, it is redisplayed. * *-------------------------------------------------------------- @@ -2958,10 +2964,8 @@ PanedWindowIdentifyCoords( Tcl_Interp *interp, /* Interpreter in which to store result. */ int x, int y) /* Coordinates of the point to identify. */ { - Tcl_Obj *list; int i, sashHeight, sashWidth, thisx, thisy; int found, isHandle, lpad, rpad, tpad, bpad; - list = Tcl_NewObj(); if (pwPtr->orient == ORIENT_HORIZONTAL) { if (Tk_IsMapped(pwPtr->tkwin)) { @@ -3036,16 +3040,17 @@ PanedWindowIdentifyCoords( } /* - * Set results. + * Set results. Note that the empty string is the default (this function + * is called inside the implementation of a command). */ if (found != -1) { - Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(found)); - Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj( - (isHandle ? "handle" : "sash"), -1)); - } + Tcl_Obj *list[2]; - Tcl_SetObjResult(interp, list); + list[0] = Tcl_NewIntObj(found); + list[1] = Tcl_NewStringObj((isHandle ? "handle" : "sash"), -1); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, list)); + } return TCL_OK; } diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 22072ce..afba488 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -343,7 +343,7 @@ Tk_PlaceObjCmd( for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, TkNewWindowObj(slavePtr->tkwin)); } Tcl_SetObjResult(interp, listPtr); @@ -619,8 +619,10 @@ ConfigureSlave( Tk_Window masterWin = (Tk_Window) NULL; if (Tk_TopWinHierarchy(tkwin)) { - Tcl_AppendResult(interp, "can't use placer on top-level window \"", - Tk_PathName(tkwin), "\"; use wm command instead", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use placer on top-level window \"%s\"; use " + "wm command instead", Tk_PathName(tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -652,7 +654,7 @@ ConfigureSlave( slavePtr->flags |= CHILD_WIDTH; } - if (((mask & IN_MASK) == 0) && (slavePtr->masterPtr != NULL)) { + if (!(mask & IN_MASK) && (slavePtr->masterPtr != NULL)) { /* * If no -in option was passed and the slave is already placed then * just recompute the placement. @@ -678,16 +680,18 @@ ConfigureSlave( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to ", - Tk_PathName(tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to %s", + Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } if (slavePtr->tkwin == tkwin) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to itself", + Tk_PathName(slavePtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } if ((slavePtr->masterPtr != NULL) @@ -771,54 +775,50 @@ PlaceInfoCommand( Tcl_Interp *interp, /* Interp into which to place result. */ Tk_Window tkwin) /* Token for the window to get info on. */ { - char buffer[32 + TCL_INTEGER_SPACE]; Slave *slavePtr; + Tcl_Obj *infoObj; slavePtr = FindSlave(tkwin); if (slavePtr == NULL) { return TCL_OK; } + infoObj = Tcl_NewObj(); if (slavePtr->masterPtr != NULL) { - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); + Tcl_AppendToObj(infoObj, "-in", -1); + Tcl_ListObjAppendElement(NULL, infoObj, + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_AppendToObj(infoObj, " ", -1); } - sprintf(buffer, " -x %d", slavePtr->x); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -relx %.4g", slavePtr->relX); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -y %d", slavePtr->y); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -rely %.4g", slavePtr->relY); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + "-x %d -relx %.4g -y %d -rely %.4g", + slavePtr->x, slavePtr->relX, slavePtr->y, slavePtr->relY); if (slavePtr->flags & CHILD_WIDTH) { - sprintf(buffer, " -width %d", slavePtr->width); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, " -width %d", slavePtr->width); } else { - Tcl_AppendResult(interp, " -width {}", NULL); + Tcl_AppendToObj(infoObj, " -width {}", -1); } if (slavePtr->flags & CHILD_REL_WIDTH) { - sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + " -relwidth %.4g", slavePtr->relWidth); } else { - Tcl_AppendResult(interp, " -relwidth {}", NULL); + Tcl_AppendToObj(infoObj, " -relwidth {}", -1); } if (slavePtr->flags & CHILD_HEIGHT) { - sprintf(buffer, " -height %d", slavePtr->height); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, " -height %d", slavePtr->height); } else { - Tcl_AppendResult(interp, " -height {}", NULL); + Tcl_AppendToObj(infoObj, " -height {}", -1); } if (slavePtr->flags & CHILD_REL_HEIGHT) { - sprintf(buffer, " -relheight %.4g", slavePtr->relHeight); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + " -relheight %.4g", slavePtr->relHeight); } else { - Tcl_AppendResult(interp, " -relheight {}", NULL); + Tcl_AppendToObj(infoObj, " -relheight {}", -1); } - Tcl_AppendElement(interp, "-anchor"); - Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); - Tcl_AppendElement(interp, "-bordermode"); - Tcl_AppendElement(interp, borderModeStrings[slavePtr->borderMode]); + Tcl_AppendPrintfToObj(infoObj, " -anchor %s -bordermode %s", + Tk_NameOfAnchor(slavePtr->anchor), + borderModeStrings[slavePtr->borderMode]); + Tcl_SetObjResult(interp, infoObj); return TCL_OK; } @@ -1183,8 +1183,8 @@ PlaceRequestProc( Slave *slavePtr = clientData; Master *masterPtr; - if (((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) != 0) - && ((slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) != 0)) { + if ((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) + && (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT))) { return; } masterPtr = slavePtr->masterPtr; diff --git a/generic/tkPointer.c b/generic/tkPointer.c index eab6e48..451373d 100644 --- a/generic/tkPointer.c +++ b/generic/tkPointer.c @@ -286,7 +286,7 @@ Tk_UpdatePointer( tsdPtr->restrictWinPtr = winPtr; TkpSetCapture(tsdPtr->restrictWinPtr); - } else if ((tsdPtr->lastState & ALL_BUTTONS) == 0) { + } else if (!(tsdPtr->lastState & ALL_BUTTONS)) { /* * Mouse is in a non-button grab, so ensure the button * grab is inside the grab tree. diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index 630737c..a51ca33 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -318,17 +318,13 @@ RectOvalCoords( */ if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[0])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[1])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[2])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[3])); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *bbox[4]; + + bbox[0] = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]); + bbox[1] = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]); + bbox[2] = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]); + bbox[3] = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); return TCL_OK; } @@ -348,10 +344,11 @@ 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)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", + (rectOvalPtr->header.typePtr == &tkRectangleType + ? "RECTANGLE" : "OVAL"), NULL); return TCL_ERROR; } @@ -515,9 +512,10 @@ ConfigureRectOval( } #ifdef MAC_OSX_TK /* - * Mac OS X CG drawing needs access to the outline linewidth - * even for fills (as linewidth controls antialiasing). + * Mac OS X CG drawing needs access to the outline linewidth even for + * fills (as linewidth controls antialiasing). */ + gcValues.line_width = rectOvalPtr->outline.gc != None ? rectOvalPtr->outline.gc->line_width : 0; mask |= GCLineWidth; @@ -677,7 +675,7 @@ ComputeRectOvalBbox( bloat = 1; #else bloat = 0; -#endif +#endif /* __WIN32__ */ } else { #ifdef MAC_OSX_TK /* @@ -689,7 +687,7 @@ ComputeRectOvalBbox( bloat = (int) (width+1.5)/2; #else bloat = (int) (width+1)/2; -#endif +#endif /* MAC_OSX_TK */ } /* @@ -757,9 +755,9 @@ DisplayRectOval( * will die if it isn't. */ - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0],rectOvalPtr->bbox[1], &x1, &y1); - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2],rectOvalPtr->bbox[3], &x2, &y2); if (x2 <= x1) { x2 = x1+1; @@ -1293,13 +1291,14 @@ RectOvalToPostscript( * information; 0 means final Postscript is * being created. */ { - char pathCmd[500]; + Tcl_Obj *pathObj, *psObj; RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; double y1, y2; XColor *color; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]); @@ -1310,12 +1309,23 @@ RectOvalToPostscript( */ if (rectOvalPtr->header.typePtr == &tkRectangleType) { - sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n", + pathObj = Tcl_ObjPrintf( + "%.15g %.15g moveto " + "%.15g 0 rlineto " + "0 %.15g rlineto " + "%.15g 0 rlineto " + "closepath\n", rectOvalPtr->bbox[0], y1, - rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1, + rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], + y2-y1, rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]); } else { - sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", + pathObj = Tcl_ObjPrintf( + "matrix currentmatrix\n" + "%.15g %.15g translate " + "%.15g %.15g scale " + "1 0 moveto 0 0 1 0 360 arc\n" + "setmatrix\n", (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2, (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2); } @@ -1349,24 +1359,38 @@ RectOvalToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * First draw the filled area of the rectangle. */ if (fillColor != NULL) { - Tcl_AppendResult(interp, pathCmd, NULL); + Tcl_AppendObjToObj(psObj, pathObj); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1375,14 +1399,32 @@ RectOvalToPostscript( */ if (color != NULL) { - Tcl_AppendResult(interp, pathCmd, "0 setlinejoin 2 setlinecap\n", - NULL); + Tcl_AppendObjToObj(psObj, pathObj); + Tcl_AppendToObj(psObj, "0 setlinejoin 2 setlinecap\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &rectOvalPtr->outline)!= TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); + Tcl_DecrRefCount(pathObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + Tcl_DecrRefCount(pathObj); + return TCL_ERROR; } /* diff --git a/generic/tkScale.c b/generic/tkScale.c index 5e577e9..3ca4a67 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -376,6 +376,7 @@ ScaleWidgetObjCmd( case COMMAND_COORDS: { int x, y; double value; + Tcl_Obj *coords[2]; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); @@ -397,7 +398,9 @@ ScaleWidgetObjCmd( y = scalePtr->horizTroughY + scalePtr->width/2 + scalePtr->borderWidth; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d", x, y)); + coords[0] = Tcl_NewIntObj(x); + coords[1] = Tcl_NewIntObj(y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); break; } case COMMAND_GET: { @@ -421,7 +424,8 @@ ScaleWidgetObjCmd( break; } case COMMAND_IDENTIFY: { - int x, y, thing; + int x, y; + const char *zone = ""; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); @@ -431,18 +435,12 @@ ScaleWidgetObjCmd( || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScaleElement(scalePtr, x,y); - switch (thing) { - case TROUGH1: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case TROUGH2: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; + switch (TkpScaleElement(scalePtr, x, y)) { + case TROUGH1: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case TROUGH2: zone = "trough2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); break; } case COMMAND_SET: { diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 49ddca0..2d91db6 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -12,6 +12,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +/* + * TODO: Convert scrollbars to the Tcl_Obj API. + */ + #include "tkInt.h" #include "tkScrollbar.h" #include "default.h" @@ -132,8 +136,10 @@ Tk_ScrollbarCmd( Tk_Window newWin; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?-option value ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s pathName ?-option value ...?\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -230,8 +236,9 @@ ScrollbarWidgetCmd( int c; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg ...?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s option ?arg ...?\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } Tcl_Preserve(scrollPtr); @@ -239,23 +246,23 @@ ScrollbarWidgetCmd( length = strlen(argv[1]); if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { int oldActiveField; + if (argc == 2) { + const char *zone = ""; + switch (scrollPtr->activeField) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + case TOP_ARROW: zone = "arrow1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); goto done; } if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " activate element\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s activate element\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } c = argv[2][0]; @@ -276,9 +283,9 @@ ScrollbarWidgetCmd( } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) && (length >= 2)) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " cget option\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s cget option\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } result = Tk_ConfigureValue(interp, scrollPtr->tkwin, @@ -300,8 +307,10 @@ ScrollbarWidgetCmd( double fraction; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delta xDelta yDelta\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s delta xDelta yDelta\"", + argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK) @@ -328,8 +337,9 @@ ScrollbarWidgetCmd( double fraction; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " fraction x y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s fraction x y\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) @@ -357,20 +367,19 @@ ScrollbarWidgetCmd( } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + Tcl_Obj *resObjs[4]; + if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s get\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if (scrollPtr->flags & NEW_STYLE_COMMANDS) { - Tcl_Obj *resObjs[2]; - resObjs[0] = Tcl_NewDoubleObj(scrollPtr->firstFraction); resObjs[1] = Tcl_NewDoubleObj(scrollPtr->lastFraction); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resObjs)); } else { - Tcl_Obj *resObjs[4]; - resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits); resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits); resObjs[2] = Tcl_NewIntObj(scrollPtr->firstUnit); @@ -378,35 +387,27 @@ ScrollbarWidgetCmd( Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs)); } } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { - int x, y, thing; + int x, y; + const char *zone = ""; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " identify x y\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s identify x y\"", argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScrollbarPosition(scrollPtr, x,y); - switch (thing) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case TOP_GAP: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_GAP: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + switch (TkpScrollbarPosition(scrollPtr, x, y)) { + case TOP_ARROW: zone = "arrow1"; break; + case TOP_GAP: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_GAP: zone = "trough2"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { int totalUnits, windowUnits, firstUnit, lastUnit; @@ -473,18 +474,22 @@ ScrollbarWidgetCmd( } scrollPtr->flags &= ~NEW_STYLE_COMMANDS; } else { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " set firstFraction lastFraction\" or \"", - argv[0], - " set totalUnits windowUnits firstUnit lastUnit\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be " + "\"%s set firstFraction lastFraction\" or " + "\"%s set totalUnits windowUnits firstUnit lastUnit\"", + argv[0], argv[0])); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); goto error; } TkpComputeScrollbarGeometry(scrollPtr); TkScrollbarEventuallyRedraw(scrollPtr); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be activate, cget, configure, delta, fraction, ", - "get, identify, or set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be activate, cget, configure," + " delta, fraction, get, identify, or set", argv[1])); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + argv[1], NULL); goto error; } @@ -538,7 +543,7 @@ ConfigureScrollbar( */ if (scrollPtr->command != NULL) { - scrollPtr->commandSize = (int)strlen(scrollPtr->command); + scrollPtr->commandSize = (int) strlen(scrollPtr->command); } else { scrollPtr->commandSize = 0; } @@ -602,8 +607,7 @@ TkScrollbarEventProc( * Tk_FreeOptions handle all the standard option-related stuff. */ - Tk_FreeOptions(configSpecs, (char *) scrollPtr, - scrollPtr->display, 0); + Tk_FreeOptions(configSpecs, (char*) scrollPtr, scrollPtr->display, 0); Tcl_EventuallyFree(scrollPtr, TCL_DYNAMIC); } else if (eventPtr->type == ConfigureNotify) { TkpComputeScrollbarGeometry(scrollPtr); @@ -683,10 +687,10 @@ void TkScrollbarEventuallyRedraw( TkScrollbar *scrollPtr) /* Information about widget. */ { - if ((scrollPtr->tkwin == NULL) || (!Tk_IsMapped(scrollPtr->tkwin))) { + if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(scrollPtr->tkwin)) { return; } - if ((scrollPtr->flags & REDRAW_PENDING) == 0) { + if (!(scrollPtr->flags & REDRAW_PENDING)) { Tcl_DoWhenIdle(TkpDisplayScrollbar, scrollPtr); scrollPtr->flags |= REDRAW_PENDING; } diff --git a/generic/tkSelect.c b/generic/tkSelect.c index ee52ba1..2414b3d 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -638,9 +638,10 @@ Tk_GetSelection( clientData); cantget: - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), + Tk_GetAtomName(tkwin, target))); return TCL_ERROR; } @@ -708,8 +709,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -767,8 +769,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -844,8 +847,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -868,7 +872,8 @@ Tk_SelectionObjCmd( } if ((count < 2) || (count > 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? window command"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? window command"); return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin); @@ -929,8 +934,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -972,7 +978,7 @@ Tk_SelectionObjCmd( if (tkwin == NULL) { return TCL_ERROR; } - winPtr = (TkWindow *)tkwin; + winPtr = (TkWindow *) tkwin; for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->selection == selection) { @@ -986,7 +992,7 @@ Tk_SelectionObjCmd( if ((infoPtr != NULL) && (infoPtr->owner != winPtr->dispPtr->clipWindow)) { - Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner)); } return TCL_OK; } @@ -1285,7 +1291,7 @@ SelGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - const char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend(clientData, portion, -1); return TCL_OK; @@ -1320,13 +1326,11 @@ HandleTclCommand( int maxBytes) /* Maximum # of bytes to store at buffer. */ { CommandInfo *cmdInfoPtr = clientData; - int spaceNeeded, length; -#define MAX_STATIC_SIZE 100 - char staticSpace[MAX_STATIC_SIZE]; - char *command; + int length; + Tcl_Obj *command; const char *string; Tcl_Interp *interp = cmdInfoPtr->interp; - Tcl_DString oldResult; + Tcl_InterpState savedState; int extraBytes, charOffset, count, numChars, code; const char *p; @@ -1363,23 +1367,23 @@ HandleTclCommand( * the offset and maximum # of bytes. */ - spaceNeeded = cmdInfoPtr->cmdLength + 30; - if (spaceNeeded < MAX_STATIC_SIZE) { - command = staticSpace; - } else { - command = ckalloc(spaceNeeded); - } - sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes); + command = Tcl_ObjPrintf("%s %d %d", + cmdInfoPtr->command, charOffset, maxBytes); + Tcl_IncrRefCount(command); /* * Execute the command. Be sure to restore the state of the interpreter * after executing the command. */ - Tcl_DStringInit(&oldResult); - Tcl_DStringGetResult(interp, &oldResult); - code = Tcl_EvalEx(interp, command, -1, TCL_EVAL_GLOBAL); + savedState = Tcl_SaveInterpState(interp, TCL_OK); + code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(command); if (code == TCL_OK) { + /* + * TODO: This assumes that bytes are characters; that's not true! + */ + string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); count = (length > maxBytes) ? maxBytes : length; memcpy(buffer, string, (size_t) count); @@ -1424,11 +1428,7 @@ HandleTclCommand( } count = -1; } - Tcl_DStringResult(interp, &oldResult); - - if (command != staticSpace) { - ckfree(command); - } + (void) Tcl_RestoreInterpState(interp, savedState); Tcl_Release(clientData); Tcl_Release(interp); @@ -1498,6 +1498,7 @@ TkSelDefaultSelection( && (selPtr->target != dispPtr->windowAtom)) { const char *atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target); + Tcl_DStringAppendElement(&ds, atomString); } } @@ -1564,11 +1565,10 @@ LostSelection( ClientData clientData) /* Pointer to LostCommand structure. */ { LostCommand *lostPtr = clientData; - Tcl_Obj *objPtr; - Tcl_Interp *interp; + Tcl_Interp *interp = lostPtr->interp; + Tcl_InterpState savedState; int code; - interp = lostPtr->interp; Tcl_Preserve(interp); /* @@ -1576,19 +1576,13 @@ LostSelection( * it after executing the command. */ - objPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(objPtr); + savedState = Tcl_SaveInterpState(interp, TCL_OK); Tcl_ResetResult(interp); - code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } - - Tcl_SetObjResult(interp, objPtr); - Tcl_DecrRefCount(objPtr); - - Tcl_Release(interp); + (void) Tcl_RestoreInterpState(interp, savedState); /* * Free the storage for the command, since we're done with it now. @@ -1596,6 +1590,7 @@ LostSelection( Tcl_DecrRefCount(lostPtr->cmdObj); ckfree(lostPtr); + Tcl_Release(interp); } /* diff --git a/generic/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/tkStubLib.c b/generic/tkStubLib.c index 53f177d..b4063b5 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -124,9 +124,8 @@ Tk_InitStubs( } if (!stubsPtr) { - Tcl_SetResult(interp, - "This implementation of Tk does not support stubs", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this implementation of Tk does not support stubs", -1)); return NULL; } diff --git a/generic/tkStyle.c b/generic/tkStyle.c index 76291fa..d5e1407 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -1356,8 +1356,9 @@ Tk_GetStyle( entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name!=NULL?name:"")); if (entryPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "style \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "STYLE", name, NULL); } return (Tk_Style) NULL; } diff --git a/generic/tkText.c b/generic/tkText.c index 56a98e7..e7b1c4d 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -760,13 +760,13 @@ TextWidgetObjCmd( } else { Tcl_Obj *objPtr = Tk_GetOptionValue(interp, (char *) textPtr, textPtr->optionTable, objv[2], textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } break; case TEXT_COMPARE: { @@ -792,12 +792,7 @@ TextWidgetObjCmd( if ((p[1] == '=') && (p[2] == 0)) { value = (relation <= 0); } else if (p[1] != 0) { - compareError: - Tcl_AppendResult(interp, "bad comparison operator \"", - Tcl_GetString(objv[3]), - "\": must be <, <=, ==, >=, >, or !=", NULL); - result = TCL_ERROR; - goto done; + goto compareError; } } else if (p[0] == '>') { value = (relation > 0); @@ -815,18 +810,26 @@ TextWidgetObjCmd( } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); break; + + compareError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad comparison operator \"%s\": must be" + " <, <=, ==, >=, >, or !=", Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COMPARISON", NULL); + result = TCL_ERROR; + goto done; } case TEXT_CONFIGURE: if (objc <= 3) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) textPtr, textPtr->optionTable, ((objc == 3) ? objv[2] : NULL), textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureText(interp, textPtr, objc-2, objv+2); } @@ -837,7 +840,8 @@ TextWidgetObjCmd( Tcl_Obj *objPtr = NULL; if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? index1 index2"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? index1 index2"); result = TCL_ERROR; goto done; } @@ -859,15 +863,7 @@ TextWidgetObjCmd( char c; if (length < 2 || option[0] != '-') { - badOption: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad option \"", - Tcl_GetString(objv[i]), - "\" must be -chars, -displaychars, -displayindices, ", - "-displaylines, -indices, -lines, -update, ", - "-xpixels, or -ypixels", NULL); - result = TCL_ERROR; - goto done; + goto badOption; } c = option[1]; if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) { @@ -1037,6 +1033,15 @@ TextWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); } break; + + badOption: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\" must be -chars, -displaychars, " + "-displayindices, -displaylines, -indices, -lines, -update, " + "-xpixels, or -ypixels", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_OPTION", NULL); + result = TCL_ERROR; + goto done; } case TEXT_DEBUG: if (objc > 3) { @@ -1257,7 +1262,7 @@ TextWidgetObjCmd( if (objc > 3) { name = Tcl_GetStringFromObj(objv[i], &length); if (length > 1 && name[0] == '-') { - if (strncmp("-displaychars", name, (unsigned)length)==0) { + if (strncmp("-displaychars", name, (unsigned) length) == 0) { i++; visible = 1; name = Tcl_GetStringFromObj(objv[i], &length); @@ -1395,9 +1400,10 @@ TextWidgetObjCmd( goto done; } if (TkTextIndexCmp(indexFromPtr, indexToPtr) > 0) { - Tcl_AppendResult(interp, "Index \"", Tcl_GetString(objv[3]), - "\" before \"", Tcl_GetString(objv[2]), - "\" in the text", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" before \"%s\" in the text", + Tcl_GetString(objv[3]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL); result = TCL_ERROR; goto done; } @@ -1663,7 +1669,7 @@ TextPeerCmd( return TCL_ERROR; } - switch ((enum peerOptions)index) { + switch ((enum peerOptions) index) { case PEER_CREATE: if (objc < 4) { Tcl_WrongNumArgs(interp, 3, objv, "pathName ?-option value ...?"); @@ -1673,17 +1679,21 @@ TextPeerCmd( objc-2, objv+2); case PEER_NAMES: { TkText *tPtr = textPtr->sharedTextPtr->peers; + Tcl_Obj *peersObj; if (objc > 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + peersObj = Tcl_NewObj(); while (tPtr != NULL) { if (tPtr != textPtr) { - Tcl_AppendElement(interp, Tk_PathName(tPtr->tkwin)); + Tcl_ListObjAppendElement(NULL, peersObj, + TkNewWindowObj(tPtr->tkwin)); } tPtr = tPtr->next; } + Tcl_SetObjResult(interp, peersObj); } } @@ -2054,9 +2064,9 @@ ConfigureText( end = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL); } if (start > end) { - Tcl_AppendResult(interp, - "-startline must be less than or equal to -endline", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-startline must be less than or equal to -endline", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -2089,6 +2099,7 @@ ConfigureText( /* Nothing tagged with "sel" */ } else { int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr); + if (line < start) { selChanged = 1; } else { @@ -3657,13 +3668,14 @@ TextSearchCmd( SearchSpec searchSpec; static const char *const switchStrings[] = { + "-hidden", "--", "-all", "-backwards", "-count", "-elide", "-exact", "-forwards", - "-hidden", "-nocase", "-nolinestop", "-overlap", "-regexp", - "-strictlimits", NULL + "-nocase", "-nolinestop", "-overlap", "-regexp", "-strictlimits", NULL }; enum SearchSwitches { + SEARCH_HIDDEN, SEARCH_END, SEARCH_ALL, SEARCH_BACK, SEARCH_COUNT, SEARCH_ELIDE, - SEARCH_EXACT, SEARCH_FWD, SEARCH_HIDDEN, SEARCH_NOCASE, + SEARCH_EXACT, SEARCH_FWD, SEARCH_NOCASE, SEARCH_NOLINESTOP, SEARCH_OVERLAP, SEARCH_REGEXP, SEARCH_STRICTLIMITS }; @@ -3696,21 +3708,20 @@ TextSearchCmd( for (i=2 ; i<objc ; i++) { int index; + if (Tcl_GetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], switchStrings, "switch", 0, + if (Tcl_GetIndexFromObj(NULL, objv[i], switchStrings, "switch", 0, &index) != TCL_OK) { /* - * Hide the -hidden option. + * Hide the -hidden option, generating the error description with + * the side effects of T_GIFO. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad switch \"", Tcl_GetString(objv[i]), - "\": must be --, -all, -backward, -count, -elide, ", - "-exact, -forward, -nocase, -nolinestop, -overlap, ", - "-regexp, or -strictlimits", NULL); + (void) Tcl_GetIndexFromObj(interp, objv[i], switchStrings+1, + "switch", 0, &index); return TCL_ERROR; } @@ -3726,8 +3737,9 @@ TextSearchCmd( break; case SEARCH_COUNT: if (i >= objc-1) { - Tcl_SetResult(interp, "no value given for \"-count\" option", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no value given for \"-count\" option", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "VALUE", NULL); return TCL_ERROR; } i++; @@ -3778,14 +3790,18 @@ TextSearchCmd( } if (searchSpec.noLineStop && searchSpec.exact) { - Tcl_SetResult(interp, "the \"-nolinestop\" option requires the " - "\"-regexp\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-nolinestop\" option requires the \"-regexp\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } if (searchSpec.overlap && !searchSpec.all) { - Tcl_SetResult(interp, "the \"-overlap\" option requires the " - "\"-all\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-overlap\" option requires the \"-all\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } @@ -4402,8 +4418,10 @@ TkTextGetTabs( } if (tabPtr->location <= 0) { - Tcl_AppendResult(interp, "tab stop \"", Tcl_GetString(objv[i]), - "\" is not at a positive distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab stop \"%s\" is not at a positive distance", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL); goto error; } @@ -4433,11 +4451,11 @@ TkTextGetTabs( } lastStop = tabPtr->location; #else - Tcl_AppendResult(interp, - "tabs must be monotonically increasing, but \"", - Tcl_GetString(objv[i]), - "\" is smaller than or equal to the previous tab", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tabs must be monotonically increasing, but \"%s\" is " + "smaller than or equal to the previous tab", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL); goto error; #endif /* _TK_ALLOW_DECREASING_TABS */ } @@ -4568,10 +4586,7 @@ TextDumpCmd( case DUMP_CMD: arg++; if (arg >= objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); - return TCL_ERROR; + goto wrongArgs; } command = objv[arg]; break; @@ -4580,9 +4595,11 @@ TextDumpCmd( } } if (arg >= objc || arg+2 < objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); + wrongArgs: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Usage: %s dump ?-all -image -text -mark -tag -window? " + "?-command script? index ?index2?", Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (what == 0) { @@ -4603,7 +4620,7 @@ TextDumpCmd( return TCL_ERROR; } str = Tcl_GetStringFromObj(objv[arg], &length); - if (strncmp(str, "end", (unsigned)length) == 0) { + if (strncmp(str, "end", (unsigned) length) == 0) { atEnd = 1; } } @@ -4748,8 +4765,7 @@ DumpLine( int length = last - first; char *range = ckalloc(length + 1); - memcpy(range, segPtr->body.chars + first, - length * sizeof(char)); + memcpy(range, segPtr->body.chars + first, length); range[length] = '\0'; TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, @@ -4826,6 +4842,7 @@ DumpLine( command, &index, what); } } + offset += currentSize; if (lineChanged) { TkTextSegment *newSegPtr; @@ -4843,9 +4860,7 @@ DumpLine( linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineno); newSegPtr = linePtr->segPtr; - if (segPtr == newSegPtr) { - segPtr = segPtr->nextPtr; - } else { + if (segPtr != newSegPtr) { while ((newOffset < endByte) && (newOffset < offset) && (newSegPtr != NULL)) { newOffset += currentSize; @@ -4867,11 +4882,9 @@ DumpLine( } } segPtr = newSegPtr; - if (segPtr != NULL) { - segPtr = segPtr->nextPtr; - } } - } else { + } + if (segPtr != NULL) { segPtr = segPtr->nextPtr; } } @@ -4910,31 +4923,25 @@ DumpSegment( int what) /* Look for TK_DUMP_INDEX bit. */ { char buffer[TK_POS_CHARS]; + Tcl_Obj *values[3], *tuple; TkTextPrintIndex(textPtr, index, buffer); + values[0] = Tcl_NewStringObj(key, -1); + values[1] = Tcl_NewStringObj(value, -1); + values[2] = Tcl_NewStringObj(buffer, -1); + tuple = Tcl_NewListObj(3, values); if (command == NULL) { - Tcl_AppendElement(interp, key); - Tcl_AppendElement(interp, value); - Tcl_AppendElement(interp, buffer); + Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple); + Tcl_DecrRefCount(tuple); return 0; } else { - const char *argv[4]; - char *list; int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree); - argv[0] = key; - argv[1] = value; - argv[2] = buffer; - argv[3] = NULL; - list = Tcl_Merge(3, argv); - Tcl_VarEval(interp, Tcl_GetString(command), " ", list, NULL); - ckfree(list); - if ((textPtr->flags & DESTROYED) || - TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch) { - return 1; - } else { - return 0; - } + Tcl_VarEval(interp, Tcl_GetString(command), " ", Tcl_GetString(tuple), + NULL); + Tcl_DecrRefCount(tuple); + return ((textPtr->flags & DESTROYED) || + TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch); } } @@ -5057,8 +5064,7 @@ TextEditCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; - + int index, setModified, oldModified; static const char *const editOptionStrings[] = { "modified", "redo", "reset", "separator", "undo", NULL }; @@ -5081,39 +5087,36 @@ TextEditCmd( if (objc == 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(textPtr->sharedTextPtr->isDirty)); + return TCL_OK; } else if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "?boolean?"); return TCL_ERROR; - } else { - int setModified, oldModified; - - if (Tcl_GetBooleanFromObj(interp, objv[3], - &setModified) != TCL_OK) { - return TCL_ERROR; - } + } else if (Tcl_GetBooleanFromObj(interp, objv[3], + &setModified) != TCL_OK) { + return TCL_ERROR; + } - /* - * Set or reset the dirty info, and trigger a Modified event. - */ + /* + * Set or reset the dirty info, and trigger a Modified event. + */ - setModified = setModified ? 1 : 0; + setModified = setModified ? 1 : 0; - oldModified = textPtr->sharedTextPtr->isDirty; - textPtr->sharedTextPtr->isDirty = setModified; - if (setModified) { - textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED; - } else { - textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; - } + oldModified = textPtr->sharedTextPtr->isDirty; + textPtr->sharedTextPtr->isDirty = setModified; + if (setModified) { + textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED; + } else { + textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; + } - /* - * Only issue the <<Modified>> event if the flag actually changed. - * However, degree of modified-ness doesn't matter. [Bug 1799782] - */ + /* + * Only issue the <<Modified>> event if the flag actually changed. + * However, degree of modified-ness doesn't matter. [Bug 1799782] + */ - if ((!oldModified) != (!setModified)) { - GenerateModifiedEvent(textPtr); - } + if ((!oldModified) != (!setModified)) { + GenerateModifiedEvent(textPtr); } break; case EDIT_REDO: @@ -5122,7 +5125,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditRedo(textPtr)) { - Tcl_AppendResult(interp, "nothing to redo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL); return TCL_ERROR; } break; @@ -5146,7 +5150,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditUndo(textPtr)) { - Tcl_AppendResult(interp, "nothing to undo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL); return TCL_ERROR; } break; @@ -5206,11 +5211,10 @@ TextGetText( if (TkTextIndexCmp(indexPtr1, indexPtr2) < 0) { while (1) { - int offset, last; - TkTextSegment *segPtr; + int offset; + TkTextSegment *segPtr = TkTextIndexToSeg(&tmpIndex, &offset); + int last = segPtr->size, last2; - segPtr = TkTextIndexToSeg(&tmpIndex, &offset); - last = segPtr->size; if (tmpIndex.linePtr == indexPtr2->linePtr) { /* * The last line that was requested must be handled carefully, @@ -5220,21 +5224,17 @@ TextGetText( if (indexPtr2->byteIndex == tmpIndex.byteIndex) { break; - } else { - int last2 = indexPtr2->byteIndex - tmpIndex.byteIndex - + offset; - - if (last2 < last) { - last = last2; - } } - } - if (segPtr->typePtr == &tkTextCharType) { - if (!visibleOnly || !TkTextIsElided(textPtr,&tmpIndex,NULL)) { - Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, - last - offset); + last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset; + if (last2 < last) { + last = last2; } } + if (segPtr->typePtr == &tkTextCharType && + !(visibleOnly && TkTextIsElided(textPtr,&tmpIndex,NULL))){ + Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, + last - offset); + } TkTextIndexForwBytes(textPtr, &tmpIndex, last-offset, &tmpIndex); } } @@ -5262,7 +5262,10 @@ static void GenerateModifiedEvent( TkText *textPtr) /* Information about text widget. */ { - union {XEvent general; XVirtualEvent virtual;} event; + union { + XEvent general; + XVirtualEvent virtual; + } event; Tk_MakeWindowExist(textPtr->tkwin); @@ -5398,14 +5401,9 @@ SearchPerform( * wrap when given a negative search range). */ - if (searchSpecPtr->backwards) { - if (TkTextIndexCmp(indexFromPtr, indexToPtr) == -1) { - return TCL_OK; - } - } else { - if (TkTextIndexCmp(indexFromPtr, indexToPtr) == 1) { - return TCL_OK; - } + if (TkTextIndexCmp(indexFromPtr, indexToPtr) == + (searchSpecPtr->backwards ? -1 : 1)) { + return TCL_OK; } if (searchSpecPtr->lineIndexProc(interp, toPtr, searchSpecPtr, @@ -5712,7 +5710,7 @@ SearchCore( } while (p >= startOfLine + firstOffset) { if (p[0] == c && !strncmp(p, pattern, - (unsigned)matchLength)) { + (unsigned) matchLength)) { goto backwardsMatch; } p--; @@ -5741,7 +5739,7 @@ SearchCore( */ p = startOfLine + lastOffset - firstNewLine - 1; - if (strncmp(p, pattern, (unsigned)(firstNewLine + 1))) { + if (strncmp(p, pattern, (unsigned) firstNewLine + 1)) { /* * No match. */ @@ -6701,9 +6699,7 @@ TkpTesttextCmd( TkTextSetMark(textPtr, "insert", &index); TkTextPrintIndex(textPtr, &index, buf); - sprintf(buf + strlen(buf), " %d", index.byteIndex); - Tcl_AppendResult(interp, buf, NULL); - + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s %d", buf, index.byteIndex)); return TCL_OK; } diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 1b41e31..d75f61c 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -5987,8 +5987,11 @@ TkTextScanCmd( dInfoPtr->scanTotalYScroll = 0; dInfoPtr->scanMarkY = y; } else { - Tcl_AppendResult(interp, "bad scan option \"", Tcl_GetString(objv[2]), - "\": must be mark or dragto", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } return TCL_OK; @@ -7299,7 +7302,7 @@ CharChunkMeasureChars( return MeasureChars(tkfont, chars, charsLen, start, end-start, startX, maxX, flags, nextXPtr); -#else +#else /* TK_LAYOUT_WITH_BASE_CHUNKS */ { int xDisplacement; int fit, bstart = start, bend = end; @@ -7339,7 +7342,7 @@ CharChunkMeasureChars( return fit - bstart; } } -#endif +#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ } /* diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index 47ee49a..1770cb6 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -155,8 +155,10 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } objPtr = Tk_GetOptionValue(interp, (char *) &eiPtr->body.ei, @@ -178,14 +180,17 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } if (objc <= 5) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, (objc == 5) ? objv[4] : NULL, textPtr->tkwin); + if (objPtr == NULL) { return TCL_ERROR; } else { @@ -272,16 +277,20 @@ TkTextImageCmd( case CMD_NAMES: { Tcl_HashSearch search; Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } default: @@ -323,11 +332,12 @@ EmbImageConfigure( Tcl_HashEntry *hPtr; Tcl_HashSearch search; char *name; + int dummy; int count = 0; /* The counter for picking a unique name */ int conflict = 0; /* True if we have a name conflict */ - size_t len; /* length of image name */ + size_t len; /* length of image name */ - if (Tk_SetOptions(textPtr->interp, (char*)&eiPtr->body.ei, + if (Tk_SetOptions(textPtr->interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, objc, objv, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; @@ -369,9 +379,11 @@ EmbImageConfigure( name = eiPtr->body.ei.imageString; } if (name == NULL) { - Tcl_AppendResult(textPtr->interp, "Either a \"-name\" ", - "or a \"-image\" argument must be provided ", - "to the \"image create\" subcommand.", NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj( + "Either a \"-name\" or a \"-image\" argument must be" + " provided to the \"image create\" subcommand", -1)); + Tcl_SetErrorCode(textPtr->interp, "TK", "TEXT", "IMAGE_CREATE_USAGE", + NULL); return TCL_ERROR; } len = strlen(name); @@ -403,14 +415,10 @@ EmbImageConfigure( Tcl_DStringAppend(&newName, buf, -1); } name = Tcl_DStringValue(&newName); - { - int dummy; - - hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, - &dummy); - } + hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, + &dummy); Tcl_SetHashValue(hPtr, eiPtr); - Tcl_AppendResult(textPtr->interp, name, NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj(name, -1)); eiPtr->body.ei.name = ckalloc(Tcl_DStringLength(&newName) + 1); strcpy(eiPtr->body.ei.name, name); Tcl_DStringFree(&newName); diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index c11ce0b..25888d8 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -84,6 +84,7 @@ FreeTextIndexInternalRep( * free. */ { TkTextIndex *indexPtr = GET_TEXTINDEX(indexObjPtr); + if (indexPtr->textPtr != NULL) { if (--indexPtr->textPtr->refCount == 0) { /* @@ -133,7 +134,6 @@ UpdateStringOfTextIndex( { char buffer[TK_POS_CHARS]; register int len; - const TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); len = TkTextPrintIndex(indexPtr->textPtr, indexPtr, buffer); @@ -148,8 +148,10 @@ SetTextIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_AppendResult(interp, "can't convert value to textindex except " - "via TkTextGetIndexFromObj API", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't convert value to textindex except via" + " TkTextGetIndexFromObj API", -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } @@ -830,15 +832,14 @@ GetIndex( if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) { if (tagPtr == textPtr->selTagPtr) { tagName = "sel"; - } else { - if (hPtr != NULL) { - tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr); - } + } else if (hPtr != NULL) { + tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr); } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "text doesn't contain any characters tagged with \"", - tagName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "text doesn't contain any characters tagged with \"%s\"", + tagName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_INDEX", tagName, + NULL); Tcl_DStringFree(©); return TCL_ERROR; } @@ -1001,8 +1002,8 @@ GetIndex( error: Tcl_DStringFree(©); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad text index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad text index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "BAD_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 76ab1a9..a306a05 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -26,6 +26,7 @@ * Forward references for functions defined in this file: */ +static Tcl_Obj * GetMarkName(TkText *textPtr, TkTextSegment *segPtr); static void InsertUndisplayProc(TkText *textPtr, TkTextDispChunk *chunkPtr); static int MarkDeleteProc(TkTextSegment *segPtr, @@ -132,7 +133,7 @@ TkTextMarkCmd( Tcl_WrongNumArgs(interp, 3, objv, "markName ?gravity?"); return TCL_ERROR; } - str = Tcl_GetStringFromObj(objv[3],&length); + str = Tcl_GetStringFromObj(objv[3], &length); if (length == 6 && !strcmp(str, "insert")) { markPtr = textPtr->insertMarkPtr; } else if (length == 7 && !strcmp(str, "current")) { @@ -140,18 +141,23 @@ TkTextMarkCmd( } else { hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, str); if (hPtr == NULL) { - Tcl_AppendResult(interp, "there is no mark named \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "there is no mark named \"%s\"", str)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_MARK", str, + NULL); return TCL_ERROR; } markPtr = Tcl_GetHashValue(hPtr); } if (objc == 4) { + const char *typeStr; + if (markPtr->typePtr == &tkTextRightMarkType) { - Tcl_SetResult(interp, "right", TCL_STATIC); + typeStr = "right"; } else { - Tcl_SetResult(interp, "left", TCL_STATIC); + typeStr = "left"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); return TCL_OK; } str = Tcl_GetStringFromObj(objv[4],&length); @@ -162,8 +168,9 @@ TkTextMarkCmd( (strncmp(str, "right", (unsigned) length) == 0)) { newTypePtr = &tkTextRightMarkType; } else { - Tcl_AppendResult(interp, "bad mark gravity \"", str, - "\": must be left or right", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mark gravity \"%s\": must be left or right", str)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MARK_GRAVITY", NULL); return TCL_ERROR; } TkTextMarkSegToIndex(textPtr, markPtr, &index); @@ -172,19 +179,27 @@ TkTextMarkCmd( TkBTreeLinkSegment(markPtr, &index); break; } - case MARK_NAMES: + case MARK_NAMES: { + Tcl_Obj *resultObj; + if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } - Tcl_AppendElement(interp, "insert"); - Tcl_AppendElement(interp, "current"); + resultObj = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + "insert", -1)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + "current", -1)); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->markTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); break; + } case MARK_NEXT: if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "index"); @@ -843,28 +858,12 @@ MarkFindNext( for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) { if (segPtr->typePtr == &tkTextRightMarkType || segPtr->typePtr == &tkTextLeftMarkType) { - if (segPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - } else if (segPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - } else if (segPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - continue; - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - segPtr->body.mark.hPtr), TCL_STATIC); + Tcl_Obj *markName = GetMarkName(textPtr, segPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } - return TCL_OK; } } index.linePtr = TkBTreeNextLine(textPtr, index.linePtr); @@ -962,28 +961,11 @@ MarkFindPrev( } } if (prevPtr != NULL) { - if (prevPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - return TCL_OK; - } else if (prevPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - return TCL_OK; - } else if (prevPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - prevPtr->body.mark.hPtr), TCL_STATIC); - return TCL_OK; + Tcl_Obj *markName = GetMarkName(textPtr, prevPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } } index.linePtr = TkBTreePreviousLine(textPtr, index.linePtr); @@ -995,6 +977,46 @@ MarkFindPrev( } /* + * ------------------------------------------------------------------------ + * + * GetMarkName -- + * Returns the name of the mark that is the given text segment, or NULL + * if it is unnamed (i.e., a widget-specific mark that isn't "current" or + * "insert"). + * + * ------------------------------------------------------------------------ + */ + +static Tcl_Obj * +GetMarkName( + TkText *textPtr, + TkTextSegment *segPtr) +{ + const char *markName; + + if (segPtr == textPtr->currentMarkPtr) { + markName = "current"; + } else if (segPtr == textPtr->insertMarkPtr) { + markName = "insert"; + } else if (segPtr->body.mark.hPtr == NULL) { + /* + * Ignore widget-specific marks for the other widgets. This is either + * an insert or a current mark (markPtr->body.mark.hPtr actually + * receives NULL for these marks in TkTextSetMark). The insert and + * current marks for textPtr having already been tested above, the + * current segment is an insert or current mark from a peer of + * textPtr, which we don't want to return. + */ + + return NULL; + } else { + markName = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, + segPtr->body.mark.hPtr); + } + return Tcl_NewStringObj(markName, -1); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index 6cd018a..beb7eb5 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -100,7 +100,7 @@ static TkTextTag * FindTag(Tcl_Interp *interp, TkText *textPtr, Tcl_Obj *tagName); static void SortTags(int numTags, TkTextTag **tagArrayPtr); static int TagSortProc(const void *first, const void *second); -static void TagBindEvent(TkText *textPtr, XEvent *eventPtr, +static void TagBindEvent(TkText *textPtr, XEvent *eventPtr, int numTags, TkTextTag **tagArrayPtr); /* @@ -213,7 +213,7 @@ TkTextTagCmd( if (tagPtr == textPtr->selTagPtr) { /* - * Send an event that the selection changed. This is + * Send an event that the selection changed. This is * equivalent to: * event generate $textWidget <<Selection>> */ @@ -276,10 +276,10 @@ TkTextTagCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable, (ClientData) tagPtr->name, Tcl_GetString(objv[4])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual ", - "events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL); return TCL_ERROR; } } else if (objc == 5) { @@ -302,7 +302,7 @@ TkTextTagCmd( } Tcl_ResetResult(interp); } else { - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } } else { Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable, @@ -457,11 +457,14 @@ TkTextTagCmd( &tagPtr->elide) != TCL_OK) { return TCL_ERROR; } - /* Indices are potentially obsolete after changing -elide, - * especially those computed with "display" or "any" - * submodifier, therefore increase the epoch. - */ - textPtr->sharedTextPtr->stateEpoch++; + + /* + * Indices are potentially obsolete after changing -elide, + * especially those computed with "display" or "any" + * submodifier, therefore increase the epoch. + */ + + textPtr->sharedTextPtr->stateEpoch++; } /* @@ -646,6 +649,7 @@ TkTextTagCmd( TkTextIndex last; TkTextSearch tSearch; char position[TK_POS_CHARS]; + Tcl_Obj *resultObj; if ((objc != 5) && (objc != 6)) { Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); @@ -714,11 +718,15 @@ TkTextTagCmd( if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) { return TCL_OK; } + resultObj = Tcl_NewObj(); TkTextPrintIndex(textPtr, &tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position, -1)); TkBTreeNextTag(&tSearch); TkTextPrintIndex(textPtr, &tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position, -1)); + Tcl_SetObjResult(interp, resultObj); break; } case TAG_PREVRANGE: { @@ -726,6 +734,7 @@ TkTextTagCmd( TkTextSearch tSearch; char position1[TK_POS_CHARS]; char position2[TK_POS_CHARS]; + Tcl_Obj *resultObj; if ((objc != 5) && (objc != 6)) { Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); @@ -773,8 +782,7 @@ TkTextTagCmd( TkTextPrintIndex(textPtr, &index2, position1); TkTextPrintIndex(textPtr, &index1, position2); - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + goto gotPrevIndexPair; } return TCL_OK; } @@ -824,8 +832,14 @@ TkTextTagCmd( } } } - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + + gotPrevIndexPair: + resultObj = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position1, -1)); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position2, -1)); + Tcl_SetObjResult(interp, resultObj); break; } case TAG_RAISE: { @@ -884,12 +898,12 @@ TkTextTagCmd( 0, &last); TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); if (TkBTreeCharTagged(&first, tagPtr)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &first)); count++; } while (TkBTreeNextTag(&tSearch)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &tSearch.curIndex)); count++; } @@ -900,7 +914,7 @@ TkTextTagCmd( * closed. In this case we add the end of the range. */ - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &last)); } Tcl_SetObjResult(interp, listObj); @@ -941,15 +955,15 @@ TkTextCreateTag( const char *name; if (!strcmp(tagName, "sel")) { - if (textPtr->selTagPtr != NULL) { + if (textPtr->selTagPtr != NULL) { if (newTag != NULL) { - *newTag = 0; + *newTag = 0; } - return textPtr->selTagPtr; - } + return textPtr->selTagPtr; + } if (newTag != NULL) { *newTag = 1; - } + } name = "sel"; } else { hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->tagTable, @@ -1048,15 +1062,15 @@ FindTag( * NULL, then don't record an error * message. */ TkText *textPtr, /* Widget in which tag is being used. */ - Tcl_Obj *tagName) /* Name of desired tag. */ + Tcl_Obj *tagName) /* Name of desired tag. */ { Tcl_HashEntry *hPtr; int len; const char *str; str = Tcl_GetStringFromObj(tagName, &len); - if (len == 3 && !strcmp(str,"sel")) { - return textPtr->selTagPtr; + if (len == 3 && !strcmp(str, "sel")) { + return textPtr->selTagPtr; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable, Tcl_GetString(tagName)); @@ -1064,8 +1078,11 @@ FindTag( return Tcl_GetHashValue(hPtr); } if (interp != NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(tagName), - "\" isn't defined in text widget", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tag \"%s\" isn't defined in text widget", + Tcl_GetString(tagName))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_TAG", + Tcl_GetString(tagName), NULL); } return NULL; } @@ -1385,7 +1402,7 @@ TkTextBindProc( XEvent *eventPtr) /* Pointer to X event that just happened. */ { TkText *textPtr = clientData; - int repick = 0; + int repick = 0; # define AnyButtonMask \ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask) @@ -1429,7 +1446,7 @@ TkTextBindProc( } } else if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) { - if (eventPtr->xcrossing.state & AnyButtonMask) { + if (eventPtr->xcrossing.state & AnyButtonMask) { textPtr->flags |= BUTTON_DOWN; } else { textPtr->flags &= ~BUTTON_DOWN; @@ -1437,7 +1454,7 @@ TkTextBindProc( TkTextPickCurrent(textPtr, eventPtr); goto done; } else if (eventPtr->type == MotionNotify) { - if (eventPtr->xmotion.state & AnyButtonMask) { + if (eventPtr->xmotion.state & AnyButtonMask) { textPtr->flags |= BUTTON_DOWN; } else { textPtr->flags &= ~BUTTON_DOWN; @@ -1561,7 +1578,7 @@ TkTextPickCurrent( = eventPtr->xmotion.same_screen; textPtr->pickEvent.xcrossing.focus = False; textPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state; - } else { + } else { textPtr->pickEvent = *eventPtr; } } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index 58d3198..d2998da 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -173,8 +173,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } @@ -210,8 +212,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } if (objc <= 5) { @@ -331,16 +335,20 @@ TkTextWindowCmd( case WIND_NAMES: { Tcl_HashSearch search; Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->windowTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); break; } } @@ -436,9 +444,12 @@ EmbWinConfigure( } if (Tk_TopWinHierarchy(ancestor)) { badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " in ", - Tk_PathName(textPtr->tkwin), NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s in %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); ewPtr->body.ew.tkwin = NULL; if (client != NULL) { client->tkwin = NULL; @@ -846,7 +857,8 @@ EmbWinLayoutProc( Tk_Window ancestor; Tcl_HashEntry *hPtr; const char *before, *string; - Tcl_DString name, buf, *dsPtr = NULL; + Tcl_DString buf, *dsPtr = NULL; + Tcl_Obj *nameObj; before = ewPtr->body.ew.create; @@ -905,36 +917,40 @@ EmbWinLayoutProc( code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create); } if (code != TCL_OK) { - createError: Tcl_BackgroundException(textPtr->interp, code); goto gotWindow; } - Tcl_DStringInit(&name); - Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1); + nameObj = Tcl_GetObjResult(textPtr->interp); + Tcl_IncrRefCount(nameObj); Tcl_ResetResult(textPtr->interp); ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp, - Tcl_DStringValue(&name), textPtr->tkwin); - Tcl_DStringFree(&name); + Tcl_GetString(nameObj), textPtr->tkwin); + Tcl_DecrRefCount(nameObj); if (ewPtr->body.ew.tkwin == NULL) { - goto createError; + Tcl_BackgroundError(textPtr->interp); + goto gotWindow; } + for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { - badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " relative to ", - Tk_PathName(textPtr->tkwin), NULL); - Tcl_BackgroundError(textPtr->interp); - ewPtr->body.ew.tkwin = NULL; - goto gotWindow; + goto badMaster; } } if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin) || (textPtr->tkwin == ewPtr->body.ew.tkwin)) { - goto badMaster; + badMaster: + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s relative to %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", "HIERARCHY", + NULL); + Tcl_BackgroundError(textPtr->interp); + ewPtr->body.ew.tkwin = NULL; + goto gotWindow; } if (client == NULL) { diff --git a/generic/tkTrig.c b/generic/tkTrig.c index d999062..a2bf456 100644 --- a/generic/tkTrig.c +++ b/generic/tkTrig.c @@ -1375,7 +1375,7 @@ TkMakeBezierPostscript( int closed, i; int numCoords = numPoints*2; double control[8]; - char buffer[200]; + Tcl_Obj *psObj; /* * If the curve is a closed one then generate a special spline that spans @@ -1394,7 +1394,9 @@ TkMakeBezierPostscript( control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - sprintf(buffer, "%.15g %.15g moveto\n%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + psObj = Tcl_ObjPrintf( + "%.15g %.15g moveto\n" + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[0], Tk_CanvasPsY(canvas, control[1]), control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), @@ -1403,10 +1405,9 @@ TkMakeBezierPostscript( closed = 0; control[6] = pointPtr[0]; control[7] = pointPtr[1]; - sprintf(buffer, "%.15g %.15g moveto\n", + psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n", control[6], Tk_CanvasPsY(canvas, control[7])); } - Tcl_AppendResult(interp, buffer, NULL); /* * Cycle through all the remaining points in the curve, generating a curve @@ -1432,12 +1433,15 @@ TkMakeBezierPostscript( control[4] = 0.333*control[6] + 0.667*pointPtr[0]; control[5] = 0.333*control[7] + 0.667*pointPtr[1]; - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), control[6], Tk_CanvasPsY(canvas, control[7])); - Tcl_AppendResult(interp, buffer, NULL); } + + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* @@ -1472,15 +1476,14 @@ TkMakeRawCurvePostscript( { int i; double *segPtr; - char buffer[200]; + Tcl_Obj *psObj; /* * Put the first point into the path. */ - sprintf(buffer, "%.15g %.15g moveto\n", + psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n", pointPtr[0], Tk_CanvasPsY(canvas, pointPtr[1])); - Tcl_AppendResult(interp, buffer, NULL); /* * Loop through all the remaining points in the curve, generating a @@ -1495,19 +1498,19 @@ TkMakeRawCurvePostscript( * neighbouring knots, so this segment is just a straight line. */ - sprintf(buffer, "%.15g %.15g lineto\n", + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", segPtr[6], Tk_CanvasPsY(canvas, segPtr[7])); } else { /* * This is a generic Bezier curve segment. */ - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", segPtr[2], Tk_CanvasPsY(canvas, segPtr[3]), segPtr[4], Tk_CanvasPsY(canvas, segPtr[5]), segPtr[6], Tk_CanvasPsY(canvas, segPtr[7])); } - Tcl_AppendResult(interp, buffer, NULL); } /* @@ -1532,20 +1535,23 @@ TkMakeRawCurvePostscript( * Straight line. */ - sprintf(buffer, "%.15g %.15g lineto\n", + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", control[6], Tk_CanvasPsY(canvas, control[7])); } else { /* * Bezier curve segment. */ - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), control[6], Tk_CanvasPsY(canvas, control[7])); } - Tcl_AppendResult(interp, buffer, NULL); } + + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 5282708..a8d2884 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -56,6 +56,7 @@ TkStateParseProc( int c; int flags = PTR2INT(clientData); size_t length; + Tcl_Obj *msgObj; register Tk_State *statePtr = (Tk_State *) (widgRec + offset); @@ -84,18 +85,20 @@ TkStateParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", - " value \"", value, "\": must be normal", NULL); - if (flags&1) { - Tcl_AppendResult(interp, ", active", NULL); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal", + ((flags & 4) ? "-default" : "state"), value); + if (flags & 1) { + Tcl_AppendToObj(msgObj, ", active", -1); } - if (flags&2) { - Tcl_AppendResult(interp, ", hidden", NULL); + if (flags & 2) { + Tcl_AppendToObj(msgObj, ", hidden", -1); } - if (flags&3) { - Tcl_AppendResult(interp, ",", NULL); + if (flags & 3) { + Tcl_AppendToObj(msgObj, ",", -1); } - Tcl_AppendResult(interp, " or disabled", NULL); + Tcl_AppendToObj(msgObj, " or disabled", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL); *statePtr = TK_STATE_NORMAL; return TCL_ERROR; } @@ -195,8 +198,10 @@ TkOrientParseProc( *orientPtr = 1; return TCL_OK; } - Tcl_AppendResult(interp, "bad orientation \"", value, - "\": must be vertical or horizontal", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad orientation \"%s\": must be vertical or horizontal", + value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL); *orientPtr = 0; return TCL_ERROR; } @@ -265,6 +270,7 @@ TkOffsetParseProc( Tk_TSOffset tsoffset; const char *q, *p; int result; + Tcl_Obj *msgObj; if ((value == NULL) || (*value == 0)) { tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; @@ -376,15 +382,16 @@ TkOffsetParseProc( return TCL_OK; badTSOffset: - Tcl_AppendResult(interp, "bad offset \"", value, - "\": expected \"x,y\"", NULL); + msgObj = Tcl_ObjPrintf("bad offset \"%s\": expected \"x,y\"", value); if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { - Tcl_AppendResult(interp, ", \"#x,y\"", NULL); + Tcl_AppendToObj(msgObj, ", \"#x,y\"", -1); } if (PTR2INT(clientData) & TK_OFFSET_INDEX) { - Tcl_AppendResult(interp, ", <index>", NULL); + Tcl_AppendToObj(msgObj, ", <index>", -1); } - Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL); return TCL_ERROR; } @@ -481,7 +488,9 @@ TkPixelParseProc( result = TkGetDoublePixels(interp, tkwin, value, doublePtr); if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { - Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); return TCL_ERROR; } return result; @@ -644,8 +653,10 @@ Tk_GetScrollInfo( if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " moveto fraction\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "moveto fraction")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { @@ -655,8 +666,10 @@ Tk_GetScrollInfo( } else if ((c == 's') && (strncmp(argv[2], "scroll", length) == 0)) { if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " scroll number units|pages\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "scroll number units|pages")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { @@ -670,12 +683,15 @@ Tk_GetScrollInfo( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", argv[4], - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", argv[4])); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", argv[2], - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", argv[2])); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2], + NULL); return TK_SCROLL_ERROR; } @@ -744,12 +760,14 @@ Tk_GetScrollInfoObj( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", arg, - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", arg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", arg, - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL); return TK_SCROLL_ERROR; } @@ -913,14 +931,17 @@ TkFindStateNum( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, - "\": must be ", mPtr->strKey, NULL); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be %s", + option, strKey, mPtr->strKey); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, - ((mPtr[1].strKey != NULL) ? ", " : ", or "), - mPtr->strKey, NULL); + Tcl_AppendPrintfToObj(msgObj, ",%s %s", + ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey); } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", option, strKey, NULL); } return mPtr->numKey; } @@ -969,14 +990,19 @@ TkFindStateNumObj( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), - " value \"", key, "\": must be ", mPtr->strKey, NULL); + msgObj = Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + Tcl_GetString(optionPtr), key, mPtr->strKey); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, - ((mPtr[1].strKey != NULL) ? ", " : ", or "), - mPtr->strKey, NULL); + Tcl_AppendPrintfToObj(msgObj, ",%s %s", + ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey); } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", Tcl_GetString(optionPtr), + key, NULL); } return mPtr->numKey; } @@ -1007,24 +1033,15 @@ TkBackgroundEvalObjv( Tcl_Obj *const *objv, int flags) { - Tcl_DString errorInfo, errorCode; - Tcl_SavedResult state; + Tcl_InterpState state; int n, r = TCL_OK; - Tcl_DStringInit(&errorInfo); - Tcl_DStringInit(&errorCode); - - Tcl_Preserve(interp); - /* - * Record the state of the interpreter + * Record the state of the interpreter. */ - Tcl_SaveResult(interp, &state); - Tcl_DStringAppend(&errorInfo, - Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); - Tcl_DStringAppend(&errorCode, - Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); + Tcl_Preserve(interp); + state = Tcl_SaveInterpState(interp, TCL_OK); /* * Evaluate the command and handle any error. @@ -1042,24 +1059,12 @@ TkBackgroundEvalObjv( Tcl_BackgroundException(interp, r); } - Tcl_Release(interp); - - /* - * Restore the state of the interpreter - */ - - Tcl_SetVar(interp, "errorInfo", - Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "errorCode", - Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); - Tcl_RestoreResult(interp, &state); - /* - * Clean up references. + * Restore the state of the interpreter. */ - Tcl_DStringFree(&errorInfo); - Tcl_DStringFree(&errorCode); + (void) Tcl_RestoreInterpState(interp, state); + Tcl_Release(interp); return r; } diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 3602088..8b0c155 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -20,7 +20,7 @@ */ typedef struct VisualDictionary { - const char *name; /* Textual name of class. */ + const char *name; /* Textual name of class. */ int minLength; /* Minimum # characters that must be specified * for an unambiguous match. */ int class; /* X symbol for class. */ @@ -173,9 +173,9 @@ Tk_GetVisual( */ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad X identifier for visual: \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad X identifier for visual: \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL); return NULL; } template.visualid = visualId; @@ -202,12 +202,16 @@ Tk_GetVisual( } } if (template.class == -1) { - Tcl_AppendResult(interp, "unknown or ambiguous visual name \"", - string, "\": class must be ", NULL); + Tcl_Obj *msgObj = Tcl_ObjPrintf( + "unknown or ambiguous visual name \"%s\": class must be ", + string); + for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { - Tcl_AppendResult(interp, dictPtr->name, ", ", NULL); + Tcl_AppendPrintfToObj(msgObj, "%s, ", dictPtr->name); } - Tcl_AppendResult(interp, "or default", NULL); + Tcl_AppendToObj(msgObj, "or default", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "VISUAL", string, NULL); return NULL; } while (isspace(UCHAR(*p))) { @@ -215,10 +219,8 @@ Tk_GetVisual( } if (*p == 0) { template.depth = 10000; - } else { - if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { - return NULL; - } + } else if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { + return NULL; } if (c == 'b') { mask = 0; @@ -237,8 +239,9 @@ Tk_GetVisual( visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template, &numVisuals); if (visInfoList == NULL) { - Tcl_SetResult(interp, "couldn't find an appropriate visual", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find an appropriate visual", -1)); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "INAPPROPRIATE", NULL); return NULL; } @@ -403,13 +406,15 @@ Tk_GetColormap( return None; } if (Tk_Screen(other) != Tk_Screen(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": not on same screen", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: not on same screen", string)); + Tcl_SetErrorCode(interp, "TK", "COLORMAP", "SCREEN", NULL); return None; } if (Tk_Visual(other) != Tk_Visual(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": incompatible visuals", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: incompatible visuals", string)); + Tcl_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", NULL); return None; } colormap = Tk_Colormap(other); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index b04b95f..f4138b2 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) { @@ -383,7 +387,7 @@ CreateTopLevelWindow( } else { dispPtr = GetScreen(interp, screenName, &screenId); if (dispPtr == NULL) { - return (Tk_Window) NULL; + return NULL; } } @@ -416,7 +420,7 @@ CreateTopLevelWindow( if (parent != NULL) { if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) { Tk_DestroyWindow((Tk_Window) winPtr); - return (Tk_Window) NULL; + return NULL; } } TkWmNewWindow(winPtr); @@ -467,9 +471,9 @@ GetScreen( screenName = TkGetDefaultScreenName(interp, screenName); if (screenName == NULL) { - Tcl_SetResult(interp, - "no display name and no $DISPLAY environment variable", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no display name and no $DISPLAY environment variable", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL); return NULL; } length = strlen(screenName); @@ -497,9 +501,9 @@ GetScreen( dispPtr = TkpOpenDisplay(screenName); if (dispPtr == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't connect to display \"", - screenName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't connect to display \"%s\"", screenName)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL); return NULL; } dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */ @@ -531,10 +535,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,24 +777,25 @@ 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. */ if (isupper(UCHAR(name[0]))) { - Tcl_AppendResult(interp, - "window name starts with an upper-case letter: \"", - name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name starts with an upper-case letter: \"%s\"", + name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL); return TCL_ERROR; } /* + * 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. @@ -799,7 +803,7 @@ NameWindow( length1 = strlen(parentPtr->pathName); length2 = strlen(name); - if ((length1+length2+2) <= FIXED_SIZE) { + if ((length1 + length2 + 2) <= FIXED_SIZE) { pathName = staticSpace; } else { pathName = ckalloc(length1 + length2 + 2); @@ -818,8 +822,9 @@ NameWindow( ckfree(pathName); } if (!isNew) { - Tcl_AppendResult(interp, "window name \"", name, - "\" already exists in parent", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name \"%s\" already exists in parent", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL); return TCL_ERROR; } Tcl_SetHashValue(hPtr, winPtr); @@ -856,7 +861,7 @@ TkCreateMainWindow( const char *screenName, /* Name of screen on which to create window. * Empty or NULL string means use DISPLAY * environment variable. */ - const char *baseName) /* Base name for application; usually of the + const char *baseName) /* Base name for application; usually of the * form "prog instance". */ { Tk_Window tkwin; @@ -949,22 +954,27 @@ TkCreateMainWindow( isSafe = Tcl_IsSafe(interp); for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { - if ((cmdPtr->objProc == NULL)) { + if (cmdPtr->objProc == NULL) { Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs"); } + #if defined(__WIN32__) && !defined(STATIC_BUILD) if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) { - /* We are running on Cygwin, so don't use the win32 dialogs */ + /* + * We are running on Cygwin, so don't use the win32 dialogs. + */ + continue; } -#endif +#endif /* __WIN32__ && !STATIC_BUILD */ + if (cmdPtr->flags & PASSMAINWINDOW) { clientData = tkwin; } else { 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 +982,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); } } @@ -1032,13 +1040,15 @@ Tk_CreateWindow( if (parentPtr) { if (parentPtr->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't create window: its parent has -container = yes", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, @@ -1094,13 +1104,15 @@ Tk_CreateAnonymousWindow( if (parentPtr) { if (parentPtr->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; } else if (parentPtr->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't create window: its parent has -container = yes", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } else if (screenName == NULL) { TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, @@ -1176,8 +1188,9 @@ Tk_CreateWindowFromPath( p = strrchr(pathName, '.'); if (p == NULL) { - Tcl_AppendResult(interp, "bad window path name \"", pathName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); return NULL; } numChars = (int) (p-pathName); @@ -1206,13 +1219,14 @@ Tk_CreateWindowFromPath( return NULL; } if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; - } - if (((TkWindow *) parent)->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, - "can't create window: its parent has -container = yes", NULL); + } else if (((TkWindow *) parent)->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } @@ -1354,8 +1368,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 +1396,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); @@ -1528,7 +1542,7 @@ Tk_DestroyWindow( */ if ((winPtr->mainPtr->interp != NULL) && - (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) { + !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name, TkDeadAppCmd, NULL, NULL); @@ -1613,7 +1627,7 @@ Tk_DestroyWindow( TkCloseDisplay(dispPtr); } -#endif +#endif /* !WIN32 && NOT_YET */ } } Tcl_EventuallyFree(winPtr, TCL_DYNAMIC); @@ -1751,6 +1765,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 +2343,8 @@ Tk_NameToWindow( */ if (interp != NULL) { - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); } return NULL; } @@ -2337,8 +2353,10 @@ Tk_NameToWindow( pathName); if (hPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad window path name \"", - pathName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName, + NULL); } return NULL; } @@ -2432,8 +2450,8 @@ Tcl_Interp * Tk_Interp( Tk_Window tkwin) { - if (tkwin != NULL && ((TkWindow *)tkwin)->mainPtr != NULL) { - return ((TkWindow *)tkwin)->mainPtr->interp; + if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) { + return ((TkWindow *) tkwin)->mainPtr->interp; } return NULL; } @@ -2591,9 +2609,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) { @@ -2652,7 +2669,9 @@ Tk_MainWindow( return (Tk_Window) mainPtr->winPtr; } } - Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this isn't a Tk application", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return NULL; } @@ -2840,44 +2859,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 +2929,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 +3002,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 +3021,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 @@ -3082,7 +3106,9 @@ Initialize( while (1) { master = Tcl_GetMaster(master); if (master == NULL) { - Tcl_AppendResult(interp, "NULL master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no controlling master interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL); code = TCL_ERROR; goto done; } @@ -3098,7 +3124,9 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { - Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error in Tcl_GetInterpPath", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } @@ -3123,8 +3151,9 @@ Initialize( */ Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "not allowed to start Tk by master's safe::TkInit", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not allowed to start Tk by master's safe::TkInit", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } Tcl_DStringFree(&ds); @@ -3389,6 +3418,7 @@ Tk_PkgInitStubsCheck( } return actualVersion; } + /* * Local Variables: * mode: c diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index a3d0179..136d4af 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -1177,13 +1177,13 @@ static void EntryDisplay(void *clientData, Drawable d) textarea = Ttk_ClientRegion(entryPtr->core.layout, "textarea"); showCursor = - (entryPtr->core.flags & CURSOR_ON) != 0 + (entryPtr->core.flags & CURSOR_ON) && EntryEditable(entryPtr) && entryPtr->entry.insertPos >= leftIndex && entryPtr->entry.insertPos <= rightIndex ; showSelection = - (entryPtr->core.state & TTK_STATE_DISABLED) == 0 + !(entryPtr->core.state & TTK_STATE_DISABLED) && selFirst > -1 && selLast > leftIndex && selFirst <= rightIndex @@ -1322,9 +1322,10 @@ EntryIndex( *indexPtr = entryPtr->entry.xscroll.last; } else if (strncmp(string, "sel.", 4) == 0) { if (entryPtr->entry.selectFirst < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->core.tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->core.tkwin))); + Tcl_SetErrorCode(interp, "TTK", "ENTRY", "NO_SELECTION", NULL); return TCL_ERROR; } if (strncmp(string, "sel.first", length) == 0) { @@ -1376,8 +1377,9 @@ EntryIndex( return TCL_OK; badIndex: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TTK", "ENTRY", "INDEX", NULL); return TCL_ERROR; } @@ -1452,7 +1454,7 @@ EntryGetCommand( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetResult(interp, entryPtr->entry.string, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->entry.string, -1)); return TCL_OK; } @@ -1782,9 +1784,9 @@ static int ComboboxCurrentCommand( return TCL_ERROR; } if (currentIndex < 0 || currentIndex >= nValues) { - Tcl_AppendResult(interp, - "Index ", Tcl_GetString(objv[2]), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Index %s out of range", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_RANGE", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c index 7860024..3e50a7f 100644 --- a/generic/ttk/ttkFrame.c +++ b/generic/ttk/ttkFrame.c @@ -206,10 +206,9 @@ int TtkGetLabelAnchorFromObj( error: if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Bad label anchor specification ", Tcl_GetString(objPtr), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Bad label anchor specification %s", Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "LABEL", "ANCHOR", NULL); } return TCL_ERROR; } diff --git a/generic/ttk/ttkImage.c b/generic/ttk/ttkImage.c index 0de5fc0..1d455d9 100644 --- a/generic/ttk/ttkImage.c +++ b/generic/ttk/ttkImage.c @@ -59,9 +59,10 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr) if ((objc % 2) != 1) { if (interp) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "image specification must contain an odd number of elements", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "SPEC", NULL); } goto error; } @@ -324,7 +325,9 @@ Ttk_CreateImageElement( int i; if (objc <= 0) { - Tcl_AppendResult(interp, "Must supply a base image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Must supply a base image", -1)); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "BASE", NULL); return TCL_ERROR; } @@ -347,9 +350,9 @@ Ttk_CreateImageElement( int option; if (i == objc - 1) { - Tcl_AppendResult(interp, - "Value for ", Tcl_GetString(objv[i]), " missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Value for %s missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "VALUE", NULL); goto error; } @@ -362,12 +365,16 @@ Ttk_CreateImageElement( #endif if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, - "option", 0, &option) != TCL_OK) { goto error; } + "option", 0, &option) != TCL_OK) { + goto error; + } switch (option) { case O_BORDER: if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->border) - != TCL_OK) { goto error; } + != TCL_OK) { + goto error; + } if (!padding_specified) { imageData->padding = imageData->border; } diff --git a/generic/ttk/ttkLayout.c b/generic/ttk/ttkLayout.c index d248dcb..de9d795 100644 --- a/generic/ttk/ttkLayout.c +++ b/generic/ttk/ttkLayout.c @@ -326,8 +326,9 @@ int Ttk_GetPaddingFromObj( if (padc > 4) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Wrong #elements in padding spec", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Wrong #elements in padding spec", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "PADDING", NULL); } goto error; } @@ -363,8 +364,9 @@ int Ttk_GetBorderFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad) if (padc > 4) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Wrong #elements in border spec", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Wrong #elements in padding spec", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "BORDER", NULL); } goto error; } @@ -476,11 +478,10 @@ int Ttk_GetStickyFromObj( case 's': case 'S': sticky |= TTK_STICK_S; break; default: if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Bad -sticky specification ", - Tcl_GetString(objPtr), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Bad -sticky specification %s", + Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STICKY", NULL); } return TCL_ERROR; } @@ -643,10 +644,10 @@ Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr) } if (++i >= objc) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Missing value for option ",Tcl_GetString(objv[i-1]), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Missing value for option %s", + Tcl_GetString(objv[i-1]))); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "LAYOUT", NULL); goto error; } @@ -790,7 +791,7 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node) int side = 0; unsigned sideFlags = flags & _TTK_MASK_PACK; - while ((sideFlags & TTK_PACK_LEFT) == 0) { + while (!(sideFlags & TTK_PACK_LEFT)) { ++side; sideFlags >>= 1; } @@ -799,9 +800,11 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node) } } - /* In Ttk_ParseLayoutTemplate, default -sticky is "nsew", - * so always include this even if no sticky bits are set. + /* + * In Ttk_ParseLayoutTemplate, default -sticky is "nsew", so always + * include this even if no sticky bits are set. */ + APPENDSTR("-sticky"); APPENDOBJ(Ttk_NewStickyObj(flags & _TTK_MASK_STICK)); @@ -875,8 +878,9 @@ Ttk_Layout Ttk_CreateLayout( Ttk_LayoutNode *bgnode; if (!layoutTemplate) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", styleName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL); return 0; } @@ -915,8 +919,9 @@ Ttk_CreateSublayout( layoutTemplate = Ttk_FindLayoutTemplate(themePtr, styleName); if (!layoutTemplate) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", styleName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL); return 0; } diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c index 256573f..cf98a6d 100644 --- a/generic/ttk/ttkManager.c +++ b/generic/ttk/ttkManager.c @@ -455,10 +455,9 @@ int Ttk_GetSlaveIndexFromObj( */ if (Tcl_GetIntFromObj(NULL, objPtr, &slaveIndex) == TCL_OK) { if (slaveIndex < 0 || slaveIndex >= mgr->nSlaves) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Slave index ", Tcl_GetString(objPtr), " out of bounds", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Slave index %d out of bounds", slaveIndex)); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "INDEX", NULL); return TCL_ERROR; } *indexPtr = slaveIndex; @@ -467,23 +466,23 @@ int Ttk_GetSlaveIndexFromObj( /* Try interpreting as a slave window name; */ - if ( (*string == '.') - && (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) - { + if ((*string == '.') && + (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) { slaveIndex = Ttk_SlaveIndex(mgr, tkwin); if (slaveIndex < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - string, " is not managed by ", Tk_PathName(mgr->masterWindow), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is not managed by %s", string, + Tk_PathName(mgr->masterWindow))); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "MANAGER", NULL); return TCL_ERROR; } *indexPtr = slaveIndex; return TCL_OK; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Invalid slave specification ", string, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid slave specification %s", string)); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "SPEC", NULL); return TCL_ERROR; } @@ -542,10 +541,9 @@ int Ttk_Maintainable(Tcl_Interp *interp, Tk_Window slave, Tk_Window master) return 1; badWindow: - Tcl_AppendResult(interp, - "can't add ", Tk_PathName(slave), - " as slave of ", Tk_PathName(master), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't add %s as slave of %s", + Tk_PathName(slave), Tk_PathName(master))); + Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL); return 0; } diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 551f4a6..6849135 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -727,9 +727,9 @@ static int AddTab( } #if 0 /* can't happen */ if (Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow) >= 0) { - Tcl_AppendResult(interp, - Tk_PathName(slaveWindow), " already added", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s already added", + Tk_PathName(slaveWindow))); + Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "PRESENT", NULL); return TCL_ERROR; } #endif @@ -859,10 +859,9 @@ static int GetTabIndex( int status = FindTabIndex(interp, nb, objPtr, index_rtn); if (status == TCL_OK && *index_rtn < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "tab '", Tcl_GetString(objPtr), "' not found", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab '%s' not found", Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "TAB", NULL); status = TCL_ERROR; } return status; @@ -1082,7 +1081,8 @@ static int NotebookIdentifyCommand( case IDENTIFY_ELEMENT: if (element) { const char *elementName = Ttk_ElementName(element); - Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1)); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1)); } break; case IDENTIFY_TAB: @@ -1173,10 +1173,10 @@ static int NotebookTabsCommand( result = Tcl_NewListObj(0, NULL); for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) { const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(pathName,-1)); + + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(pathName,-1)); } Tcl_SetObjResult(interp, result); - return TCL_OK; } diff --git a/generic/ttk/ttkPanedwindow.c b/generic/ttk/ttkPanedwindow.c index b301372..f4b14c9 100644 --- a/generic/ttk/ttkPanedwindow.c +++ b/generic/ttk/ttkPanedwindow.c @@ -157,7 +157,9 @@ static int ConfigurePane( /* Sanity-check: */ if (pane->weight < 0) { - Tcl_AppendResult(interp, "-weight must be nonnegative", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-weight must be nonnegative", -1)); + Tcl_SetErrorCode(interp, "TTK", "PANE", "WEIGHT", NULL); goto error; } @@ -419,9 +421,9 @@ static int AddPane( return TCL_ERROR; } if (Ttk_SlaveIndex(pw->paned.mgr, slaveWindow) >= 0) { - Tcl_AppendResult(interp, - Tk_PathName(slaveWindow), " already added", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s already added", Tk_PathName(slaveWindow))); + Tcl_SetErrorCode(interp, "TTK", "PANE", "PRESENT", NULL); return TCL_ERROR; } @@ -844,9 +846,9 @@ static int PanedSashposCommand( return TCL_ERROR; } if (sashIndex < 0 || sashIndex >= Ttk_NumberSlaves(pw->paned.mgr) - 1) { - Tcl_AppendResult(interp, - "sash index ", Tcl_GetString(objv[2]), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "sash index %d out of range", sashIndex)); + Tcl_SetErrorCode(interp, "TTK", "PANE", "SASH_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c index a71ae21..c34b900 100644 --- a/generic/ttk/ttkState.c +++ b/generic/ttk/ttkState.c @@ -98,8 +98,9 @@ static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) if (stateNames[j] == 0) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Invalid state name ", stateName,NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid state name %s", stateName)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATE", NULL); } return TCL_ERROR; } @@ -216,8 +217,8 @@ Tcl_Obj *Ttk_StateMapLookup( return specs[j+1]; } if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "No match in state map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("No match in state map", -1)); + Tcl_SetErrorCode(interp, "TTK", "STATE", "UNMATCHED", NULL); } return NULL; } @@ -240,10 +241,11 @@ Ttk_StateMap Ttk_GetStateMapFromObj( return NULL; if (nSpecs % 2 != 0) { - if (interp) - Tcl_SetResult(interp, - "State map must have an even number of elements", - TCL_STATIC); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "State map must have an even number of elements", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATEMAP", NULL); + } return 0; } diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c index b0e9171..5097abc 100644 --- a/generic/ttk/ttkTheme.c +++ b/generic/ttk/ttkTheme.c @@ -548,8 +548,9 @@ Ttk_CreateTheme( entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry); if (!newEntry) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Theme ", name, " already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Theme %s already exists", name)); + Tcl_SetErrorCode(interp, "TTK", "THEME", "EXISTS", NULL); return NULL; } @@ -591,8 +592,9 @@ static Ttk_Theme LookupTheme( entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name); if (!entryPtr) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "theme \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "theme \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "THEME", name, NULL); return NULL; } @@ -875,9 +877,10 @@ Ttk_ElementClass *Ttk_RegisterElement( if (specPtr->version != TK_STYLE_VERSION_2) { /* Version mismatch */ if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Internal error: Ttk_RegisterElement (", - name, "): invalid version", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Internal error: Ttk_RegisterElement (%s): invalid version", + name)); + Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "VERSION", NULL); } return 0; @@ -887,7 +890,9 @@ Ttk_ElementClass *Ttk_RegisterElement( if (!newEntry) { if (interp) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Duplicate element ", name, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Duplicate element %s", name)); + Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "DUPE", NULL); } return 0; } @@ -1355,8 +1360,9 @@ static int StyleThemeCurrentCmd( } if (name == NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("error: failed to get theme name", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error: failed to get theme name", -1)); + Tcl_SetErrorCode(interp, "TTK", "THEME", "NAMELESS", NULL); return TCL_ERROR; } @@ -1491,7 +1497,10 @@ static int StyleElementCreateCmd( entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName); if (!entryPtr) { - Tcl_AppendResult(interp, "No such element type ", factoryName, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "No such element type %s", factoryName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT_TYPE", factoryName, + NULL); return TCL_ERROR; } @@ -1550,7 +1559,9 @@ static int StyleElementOptionsCmd( return TCL_OK; } - Tcl_AppendResult(interp, "element ", elementName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "element %s not found", elementName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL); return TCL_ERROR; } @@ -1574,7 +1585,10 @@ static int StyleLayoutCmd( if (objc == 3) { layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName); if (!layoutTemplate) { - Tcl_AppendResult(interp, "Layout ", layoutName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", layoutName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", layoutName, + NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate)); diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c index 1ed2742..dc0206c 100644 --- a/generic/ttk/ttkTreeview.c +++ b/generic/ttk/ttkTreeview.c @@ -534,21 +534,18 @@ static TreeColumn *GetColumn( */ if (Tcl_GetIntFromObj(NULL, columnIDObj, &columnIndex) == TCL_OK) { if (columnIndex < 0 || columnIndex >= tv->tree.nColumns) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Column index ", - Tcl_GetString(columnIDObj), - " out of bounds", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Column index %s out of bounds", + Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLBOUND", NULL); return NULL; } return tv->tree.columns + columnIndex; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Invalid column index ", Tcl_GetString(columnIDObj), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid column index %s", Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL); return NULL; } @@ -566,10 +563,9 @@ static TreeColumn *FindColumn( return tv->tree.displayColumns[colno]; } /* else */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Column ", Tcl_GetString(columnIDObj), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Column %s out of range", Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL); return NULL; } @@ -587,8 +583,9 @@ static TreeItem *FindItem( Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tv->tree.items, itemName); if (!entryPtr) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Item ", itemName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Item %s not found", itemName)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM", NULL); return 0; } return Tcl_GetHashValue(entryPtr); @@ -1222,8 +1219,9 @@ static int ConfigureColumn( } if (mask & READONLY_OPTION) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Attempt to change read-only option", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Attempt to change read-only option", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "READONLY", NULL); goto error; } @@ -1912,11 +1910,10 @@ static int AncestryCheck( TreeItem *p = parent; while (p) { if (p == item) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Cannot insert ", ItemName(tv, item), - " as a descendant of ", ItemName(tv, parent), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Cannot insert %s as descendant of %s", + ItemName(tv, item), ItemName(tv, parent))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ANCESTRY", NULL); return 0; } p = p->parent; @@ -2318,9 +2315,7 @@ static int TreeviewIdentifyCommand( case I_COLUMN : if (colno >= 0) { - char dcolbuf[16]; - sprintf(dcolbuf, "#%d", colno); - Tcl_SetObjResult(interp, Tcl_NewStringObj(dcolbuf, -1)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%d", colno)); } break; @@ -2488,9 +2483,9 @@ static int TreeviewSetCommand( for (columnNumber=0; columnNumber<tv->tree.nColumns; ++columnNumber) { Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &value); if (value) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, tv->tree.columns[columnNumber].idObj); - Tcl_ListObjAppendElement(interp, result, value); + Tcl_ListObjAppendElement(NULL, result, value); } } Tcl_SetObjResult(interp, result); @@ -2504,7 +2499,9 @@ static int TreeviewSetCommand( if (column == &tv->tree.column0) { /* @@@ Maybe set -text here instead? */ - Tcl_AppendResult(interp, "Display column #0 cannot be set", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Display column #0 cannot be set", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_0", NULL); return TCL_ERROR; } @@ -2587,9 +2584,12 @@ static int TreeviewInsertCommand( objc -= 4; objv += 4; if (objc >= 2 && !strcmp("-id", Tcl_GetString(objv[0]))) { const char *itemName = Tcl_GetString(objv[1]); + entryPtr = Tcl_CreateHashEntry(&tv->tree.items, itemName, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "Item ",itemName," already exists",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Item %s already exists", itemName)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM_EXISTS", NULL); return TCL_ERROR; } objc -= 2; objv += 2; @@ -2646,7 +2646,9 @@ static int TreeviewDetachCommand( /* Sanity-check */ for (i = 0; items[i]; ++i) { if (items[i] == tv->tree.root) { - Tcl_AppendResult(interp, "Cannot detach root item", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot detach root item", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL); ckfree(items); return TCL_ERROR; } @@ -2694,7 +2696,9 @@ static int TreeviewDeleteCommand( for (i=0; items[i]; ++i) { if (items[i] == tv->tree.root) { ckfree(items); - Tcl_AppendResult(interp, "Cannot delete root item", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot delete root item", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL); return TCL_ERROR; } } @@ -2885,10 +2889,9 @@ static int TreeviewDragCommand( left = right; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "column ", Tcl_GetString(objv[2]), " is not displayed", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "column %s is not displayed", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_INVISIBLE", NULL); return TCL_ERROR; } @@ -2953,8 +2956,7 @@ static int TreeviewSelectionCommand( } if (Tcl_GetIndexFromObj(interp, objv[2], selopStrings, - "selection operation", 0, &selop) != TCL_OK) - { + "selection operation", 0, &selop) != TCL_OK) { return TCL_ERROR; } @@ -3040,10 +3042,10 @@ static int TreeviewTagBindCommand( */ if (mask & (~TreeviewBindEventMask)) { Tk_DeleteBinding(interp, bindingTable, tag, sequence); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unsupported event ", sequence, - "\nonly key, button, motion, and virtual events supported", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unsupported event %s\nonly key, button, motion, and" + " virtual events supported", sequence)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "BIND_EVENTS", NULL); return TCL_ERROR; } } diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c index d5e0484..016653d 100644 --- a/generic/ttk/ttkWidget.c +++ b/generic/ttk/ttkWidget.c @@ -440,7 +440,8 @@ int TtkWidgetConstructorObjCmd( error: if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); } else { Tk_DestroyWindow(tkwin); } @@ -634,8 +635,8 @@ int TtkWidgetConfigureCommand( return status; if (mask & READONLY_OPTION) { - Tcl_SetResult(interp, - "Attempt to change read-only option", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to change read-only option", -1)); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -649,7 +650,8 @@ int TtkWidgetConfigureCommand( status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask); if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); status = TCL_ERROR; } if (status != TCL_OK) { |