From 27b42b57118a651074b7f1fcc859fc4ae00090d0 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 29 Jul 2012 17:55:29 +0000 Subject: Purged Tcl_AppendElement from all non-test code. --- carbon/tkMacOSXWm.c | 55 +++-- generic/tkBind.c | 100 ++++----- generic/tkCanvas.c | 65 ++++-- generic/tkFont.c | 155 ++++++------- generic/tkGrid.c | 70 +++--- generic/tkImgBmap.c | 155 +++++++------ generic/tkImgPhoto.c | 175 +++++++-------- generic/tkInt.h | 2 +- generic/tkPack.c | 59 +++-- generic/tkPlace.c | 52 ++--- generic/tkRectOval.c | 70 ++++-- generic/tkText.c | 51 ++--- generic/tkTextImage.c | 8 +- generic/tkTextMark.c | 18 +- generic/tkTextTag.c | 23 +- generic/tkTextWind.c | 8 +- generic/tkTrig.c | 34 +-- generic/tkUtil.c | 57 ++--- generic/tkVisual.c | 12 +- macosx/tkMacOSXWm.c | 57 +++-- tests/grid.test | 611 ++++++++++++++++++-------------------------------- unix/tkUnixSend.c | 5 +- win/tkWinWm.c | 48 ++-- 23 files changed, 916 insertions(+), 974 deletions(-) diff --git a/carbon/tkMacOSXWm.c b/carbon/tkMacOSXWm.c index 2f1caa1..09c796b 100644 --- a/carbon/tkMacOSXWm.c +++ b/carbon/tkMacOSXWm.c @@ -1166,10 +1166,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2; + TkWindow **cmapList, *winPtr2; int i, windowObjc, gotToplevel = 0; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1177,13 +1176,16 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) @@ -2480,6 +2482,7 @@ WmProtocolCmd( Atom protocol; char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -2490,11 +2493,13 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -2707,11 +2712,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { - "isabove", "isbelow", NULL }; + "isabove", "isbelow", NULL + }; enum options { - OPT_ISABOVE, OPT_ISBELOW }; + OPT_ISABOVE, OPT_ISBELOW + }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -2725,14 +2733,17 @@ WmStackorderCmd( Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } + Tcl_SetObjResult(interp, resultObj); ckfree(windows); return TCL_OK; } else { TkWindow *winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) != TCL_OK) { @@ -2772,12 +2783,12 @@ WmStackorderCmd( return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = windowPtr - windows; } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = windowPtr - windows; } } if (index1 == -1) { @@ -5939,7 +5950,7 @@ TkWmStackorderToplevel( TkWindow *parentPtr) /* Parent toplevel window. */ { WindowRef frontWindow; - TkWindow *childWinPtr, **windows, **window_ptr; + TkWindow *childWinPtr, **windows, **windowPtr; Tcl_HashTable table; Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -5974,17 +5985,17 @@ TkWmStackorderToplevel( ckfree(windows); windows = NULL; } else { - window_ptr = windows + table.numEntries; - *window_ptr-- = NULL; + windowPtr = windows + table.numEntries; + *windowPtr-- = NULL; while (frontWindow != NULL) { hPtr = Tcl_FindHashEntry(&table, (char *) frontWindow); if (hPtr != NULL) { childWinPtr = Tcl_GetHashValue(hPtr); - *window_ptr-- = childWinPtr; + *windowPtr-- = childWinPtr; } frontWindow = GetNextWindow(frontWindow); } - if (window_ptr != (windows-1)) { + if (windowPtr != windows-1) { Tcl_Panic("num matched toplevel windows does not equal num " "children"); } diff --git a/generic/tkBind.c b/generic/tkBind.c index 93a6a52..58e91c4 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); } /* @@ -4050,31 +4042,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 @@ -4094,8 +4085,9 @@ GetPatternString( && 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; } @@ -4104,9 +4096,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; } @@ -4116,7 +4106,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)) { @@ -4130,12 +4120,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); } } @@ -4143,16 +4133,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; } @@ -4164,16 +4153,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/tkCanvas.c b/generic/tkCanvas.c index c696d65..97518f9 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) \ @@ -1504,9 +1504,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: { @@ -4162,23 +4166,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. */ @@ -4191,10 +4195,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; } @@ -4281,6 +4282,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 @@ -4312,7 +4314,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; } @@ -4322,10 +4326,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: @@ -4335,10 +4341,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: { @@ -4428,7 +4434,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 || @@ -4466,10 +4474,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; } @@ -4514,6 +4528,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) @@ -4541,6 +4556,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 || @@ -4553,9 +4569,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/tkFont.c b/generic/tkFont.c index 2e400b8..2e1ad01 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -3241,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; jnumDisplayChars; 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_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); } /* diff --git a/generic/tkGrid.c b/generic/tkGrid.c index 8714969..6c5bbc1 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); @@ -722,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"); @@ -737,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; } @@ -1018,7 +1024,7 @@ GridRowColumnConfigureCommand( } 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); @@ -3516,13 +3522,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. @@ -3530,30 +3536,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; + char buffer[4]; - if (flags&STICK_NORTH) { - result[count++] = 'n'; + if (flags & STICK_NORTH) { + buffer[count++] = 'n'; } - if (flags&STICK_EAST) { - result[count++] = 'e'; + if (flags & STICK_EAST) { + buffer[count++] = 'e'; } - if (flags&STICK_SOUTH) { - result[count++] = 's'; + if (flags & STICK_SOUTH) { + buffer[count++] = 's'; } - if (flags&STICK_WEST) { - result[count++] = 'w'; - } - if (count) { - result[count] = '\0'; - } else { - sprintf(result, "{}"); + if (flags & STICK_WEST) { + buffer[count++] = 'w'; } + return Tcl_NewStringObj(buffer, count); } /* diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 56ad066..f2558db 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; @@ -315,7 +315,7 @@ ImgBmapConfigureMaster( masterPtr->height, masterPtr->width, masterPtr->height); return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -450,7 +450,7 @@ ImgBmapConfigureInstance( masterPtr->tkMaster))); Tcl_BackgroundError(masterPtr->interp); } - + /* *---------------------------------------------------------------------- * @@ -477,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, @@ -660,7 +660,7 @@ TkGetBitmapData( } return NULL; } - + /* *---------------------------------------------------------------------- * @@ -730,7 +730,7 @@ NextBitmapWord( parseInfoPtr->word[parseInfoPtr->wordLength] = 0; return TCL_OK; } - + /* *-------------------------------------------------------------- * @@ -793,7 +793,7 @@ ImgBmapCmd( return TCL_OK; } } - + /* *---------------------------------------------------------------------- * @@ -864,7 +864,7 @@ ImgBmapGet( return instancePtr; } - + /* *---------------------------------------------------------------------- * @@ -924,7 +924,7 @@ ImgBmapDisplay( XSetClipOrigin(display, instancePtr->gc, 0, 0); } } - + /* *---------------------------------------------------------------------- * @@ -987,7 +987,7 @@ ImgBmapFree( } ckfree(instancePtr); } - + /* *---------------------------------------------------------------------- * @@ -1028,7 +1028,7 @@ ImgBmapDelete( Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0); ckfree(masterPtr); } - + /* *---------------------------------------------------------------------- * @@ -1058,7 +1058,7 @@ ImgBmapCmdDeletedProc( Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster)); } } - + /* *---------------------------------------------------------------------- * @@ -1089,8 +1089,7 @@ GetByte( return buffer; } } - - + /* *---------------------------------------------------------------------- * @@ -1112,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 @@ -1162,32 +1155,22 @@ ImgBmapPsImagemask( 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255, }; - if (width*height > 60000) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to generate postscript for bitmaps larger than 60000" - " pixels", -1)); - Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OUTSIZE", NULL); - return TCL_ERROR; - } - - 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} imagemask \n", NULL); - return TCL_OK; + Tcl_AppendToObj(psObj, ">} imagemask \n", -1); } - + /* *---------------------------------------------------------------------- * @@ -1196,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. @@ -1217,7 +1199,8 @@ ImgBmapPostscript( int prepass) { BitmapMaster *masterPtr = clientData; - char buffer[200]; + Tcl_InterpState interpState; + Tcl_Obj *psObj; if (prepass) { return TCL_OK; @@ -1227,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", "IMAGE", "BITMAP", "OUTSIZE", 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 @@ -1240,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); } /* @@ -1262,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); } } @@ -1284,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_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); return TCL_OK; -} + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; +} + /* * Local Variables: * mode: c diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 3eff18d..3f25984 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); @@ -1467,10 +1467,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) { /* @@ -1478,7 +1484,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]; @@ -1497,9 +1503,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; } @@ -1512,24 +1518,7 @@ ParseSubcommandOptions( */ if ((allowedOptions & bit) == 0) { - Tcl_ResetResult(interp); - 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; - } - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_OPTION", NULL); - return TCL_ERROR; + goto unknownOrAmbiguousOption; } /* @@ -1542,18 +1531,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_SetObjResult(interp, Tcl_NewStringObj( - "the \"-background\" option requires a value", -1)); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_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) { @@ -1562,50 +1546,31 @@ ParseSubcommandOptions( * parsing this is outside the scope of this function. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->format = objv[index]; - } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "the \"-format\" option requires a value", -1)); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_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_SetObjResult(interp, Tcl_NewStringObj( - "the \"-compositingrule\" option requires a value", - -1)); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_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) { @@ -1625,12 +1590,7 @@ ParseSubcommandOptions( } if (numValues == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "the \"%s\" option requires one %s integer values", - option, (maxValues == 2) ? "or two": "to four")); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", - NULL); - return TCL_ERROR; + goto manyValuesRequired; } *optIndexPtr = (index += numValues); @@ -1654,11 +1614,8 @@ ParseSubcommandOptions( case OPT_FROM: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "value(s) for the -from option must be" - " non-negative", -1)); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->fromX = values[0]; @@ -1679,11 +1636,8 @@ ParseSubcommandOptions( case OPT_TO: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "value(s) for the -to option must be non-negative", - -1)); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_TO", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->toX = values[0]; @@ -1699,11 +1653,8 @@ ParseSubcommandOptions( break; case OPT_ZOOM: if ((values[0] <= 0) || (values[1] <= 0)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "value(s) for the -zoom option must be positive", - -1)); - Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_ZOOM", NULL); - return TCL_ERROR; + needed = "positive"; + goto numberOutOfRange; } optPtr->zoomX = values[0]; optPtr->zoomY = values[1]; @@ -1717,8 +1668,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", "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", "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", "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", "PHOTO", "BAD_OPTION", 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/tkPack.c b/generic/tkPack.c index 4fada47..c600f34 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,23 +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" */ 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); } /* @@ -328,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"); @@ -343,31 +346,39 @@ Tk_PackObjCmd( 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: { diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 8fe2bd1..caa7cc1 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); @@ -775,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; } diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index 2dadf29..c233c6c 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -1291,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]); @@ -1308,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); } @@ -1347,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); } } @@ -1373,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_AppendResult(interp, Tcl_GetString(psObj), NULL); + 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/tkText.c b/generic/tkText.c index 7978793..28fa6cd 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -1679,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); } } @@ -4838,6 +4842,7 @@ DumpLine( command, &index, what); } } + offset += currentSize; if (lineChanged) { TkTextSegment *newSegPtr; @@ -4855,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; @@ -4879,11 +4882,9 @@ DumpLine( } } segPtr = newSegPtr; - if (segPtr != NULL) { - segPtr = segPtr->nextPtr; - } } - } else { + } + if (segPtr != NULL) { segPtr = segPtr->nextPtr; } } @@ -4922,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); } } @@ -6715,9 +6710,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/tkTextImage.c b/generic/tkTextImage.c index 0bb8f41..1770cb6 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -277,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: diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 52df787..77cf2c5 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -179,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"); diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index b3160b8..19ea5f3 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -641,6 +641,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?"); @@ -709,11 +710,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: { @@ -721,6 +726,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?"); @@ -768,8 +774,7 @@ TkTextTagCmd( TkTextPrintIndex(textPtr, &index2, position1); TkTextPrintIndex(textPtr, &index1, position2); - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + goto gotPrevIndexPair; } return TCL_OK; } @@ -819,8 +824,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: { diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index d9dcecf..d2998da 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -335,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; } } diff --git a/generic/tkTrig.c b/generic/tkTrig.c index d999062..5f4d267 100644 --- a/generic/tkTrig.c +++ b/generic/tkTrig.c @@ -1376,6 +1376,7 @@ TkMakeBezierPostscript( 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 +1395,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 +1406,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 +1434,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_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); } /* @@ -1473,14 +1478,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 +1500,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 +1537,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_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); } /* diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 6095054..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,19 +85,19 @@ TkStateParseProc( return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s value \"%s\": must be normal", - ((flags & 4) ? "-default" : "state"), value)); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal", + ((flags & 4) ? "-default" : "state"), value); if (flags & 1) { - Tcl_AppendResult(interp, ", active", NULL); + Tcl_AppendToObj(msgObj, ", active", -1); } if (flags & 2) { - Tcl_AppendResult(interp, ", hidden", NULL); + Tcl_AppendToObj(msgObj, ", hidden", -1); } if (flags & 3) { - Tcl_AppendResult(interp, ",", NULL); + 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; @@ -269,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; @@ -380,15 +382,15 @@ TkOffsetParseProc( return TCL_OK; badTSOffset: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad offset \"%s\": expected \"x,y\"", value)); + 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, ", ", NULL); + Tcl_AppendToObj(msgObj, ", ", -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; } @@ -929,16 +931,17 @@ TkFindStateNum( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s value \"%s\": must be %s", - option, strKey, mPtr->strKey)); - Tcl_SetErrorCode(interp, "TK", "VALUE", option, 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; } @@ -987,17 +990,19 @@ TkFindStateNumObj( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + msgObj = Tcl_ObjPrintf( "bad %s value \"%s\": must be %s", - Tcl_GetString(optionPtr), key, mPtr->strKey)); - Tcl_SetErrorCode(interp, "TK", "VALUE", Tcl_GetString(optionPtr), - NULL); + 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; } diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 5f03f39..8b0c155 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -202,14 +202,16 @@ Tk_GetVisual( } } if (template.class == -1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + Tcl_Obj *msgObj = Tcl_ObjPrintf( "unknown or ambiguous visual name \"%s\": class must be ", - string)); - Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUAL", NULL); + 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))) { diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 2aad32e..98c6526 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -1392,10 +1392,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2; + TkWindow **cmapList, *winPtr2; int i, windowObjc, gotToplevel = 0; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1403,13 +1402,16 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) @@ -2696,6 +2698,7 @@ WmProtocolCmd( Atom protocol; char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -2707,11 +2710,13 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -2929,11 +2934,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { - "isabove", "isbelow", NULL }; + "isabove", "isbelow", NULL + }; enum options { - OPT_ISABOVE, OPT_ISBELOW }; + OPT_ISABOVE, OPT_ISBELOW + }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -2947,17 +2955,20 @@ WmStackorderCmd( Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } + Tcl_SetObjResult(interp, resultObj); ckfree(windows); return TCL_OK; } else { TkWindow *winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } @@ -2994,12 +3005,12 @@ WmStackorderCmd( return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = windowPtr - windows; } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = windowPtr - windows; } } if (index1 == -1) { @@ -5963,7 +5974,7 @@ TkWindow ** TkWmStackorderToplevel( TkWindow *parentPtr) /* Parent toplevel window. */ { - TkWindow *childWinPtr, **windows, **window_ptr; + TkWindow *childWinPtr, **windows, **windowPtr; Tcl_HashTable table; Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -6000,8 +6011,8 @@ TkWmStackorderToplevel( ckfree(windows); windows = NULL; } else { - window_ptr = windows + table.numEntries; - *window_ptr-- = NULL; + windowPtr = windows + table.numEntries; + *windowPtr-- = NULL; windowNumbers = ckalloc(windowCount * sizeof(NSInteger)); NSWindowList(windowCount, windowNumbers); for (NSInteger index = 0; index < windowCount; index++) { @@ -6011,11 +6022,11 @@ TkWmStackorderToplevel( hPtr = Tcl_FindHashEntry(&table, (char*) w); if (hPtr != NULL) { childWinPtr = Tcl_GetHashValue(hPtr); - *window_ptr-- = childWinPtr; + *windowPtr-- = childWinPtr; } } } - if (window_ptr != (windows-1)) { + if (windowPtr != windows-1) { Tcl_Panic("num matched toplevel windows does not equal num " "children"); } diff --git a/tests/grid.test b/tests/grid.test index 0f0feeb..6b2dfe3 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -1,5 +1,5 @@ -# This file is a Tcl script to test out the *NEW* "grid" command -# of Tk. It is (almost) organized in the standard fashion for Tcl tests. +# This file is a Tcl script to test out the *NEW* "grid" command of Tk. It is +# (almost) organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. @@ -10,15 +10,14 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test - -# helper routine to return "." to a sane state after a test -# The variable GRID_VERBOSE can be used to "look" at the result -# of one or all of the tests +# helper routine to return "." to a sane state after a test. +# The variable GRID_VERBOSE can be used to "look" at the result of one or all +# of the tests proc grid_reset {{test ?} {top .}} { global GRID_VERBOSE if {[info exists GRID_VERBOSE]} { - if {$GRID_VERBOSE=="" || $GRID_VERBOSE==$test} { + if {$GRID_VERBOSE eq "" || $GRID_VERBOSE eq $test} { puts -nonewline "grid test $test: " flush stdout gets stdin @@ -28,10 +27,10 @@ proc grid_reset {{test ?} {top .}} { update foreach {cols rows} [grid size .] {} for {set i 0} {$i <= $cols} {incr i} { - grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" + grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } for {set i 0} {$i <= $rows} {incr i} { - grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" + grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } grid propagate . 1 grid anchor . nw @@ -40,77 +39,74 @@ proc grid_reset {{test ?} {top .}} { grid_reset 0.0 wm geometry . {} - + test grid-1.1 {basic argument checking} -body { - grid + grid } -returnCodes error -result {wrong # args: should be "grid option arg ?arg ...?"} test grid-1.2 {basic argument checking} -body { - grid foo bar + grid foo bar } -returnCodes error -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, forget, info, location, propagate, remove, rowconfigure, size, or slaves} test grid-1.3 {basic argument checking} -body { - button .b - grid .b -row 0 -column + button .b + grid .b -row 0 -column } -cleanup { grid_reset 1.3 } -returnCodes error -result {extra option or option with no value} - test grid-1.4 {basic argument checking} -body { - button .b - grid configure .b - foo + button .b + grid configure .b - foo } -cleanup { grid_reset 1.4 } -returnCodes error -result {unexpected parameter "foo" in configure list: should be window name or option} test grid-1.5 {basic argument checking} -body { - grid . + grid . } -returnCodes error -result {can't manage ".": it's a top-level window} test grid-1.6 {basic argument checking} -body { - grid x + grid x } -returnCodes error -result {can't determine master window} test grid-1.7 {basic argument checking} -body { - grid configure x + grid configure x } -returnCodes error -result {can't determine master window} test grid-1.8 {basic argument checking} -body { - button .b - grid x .b + button .b + grid x .b } -cleanup { grid_reset 1.8 } -returnCodes ok -result {} - test grid-1.9 {basic argument checking} -body { - button .b - grid configure x .b + button .b + grid configure x .b } -cleanup { grid_reset 1.9 } -returnCodes ok -result {} - test grid-2.1 {bbox} -body { - grid bbox . + grid bbox . } -result {0 0 0 0} test grid-2.2 {bbox} -body { - button .b - grid .b - destroy .b - update - grid bbox . + button .b + grid .b + destroy .b + update + grid bbox . } -result {0 0 0 0} test grid-2.3 {bbox: argument checking} -body { - grid bbox . 0 0 5 + grid bbox . 0 0 5 } -returnCodes error -result {wrong # args: should be "grid bbox master ?column row ?column row??"} test grid-2.4 {bbox} -body { - grid bbox .bad 0 0 + grid bbox .bad 0 0 } -returnCodes error -result {bad window path name ".bad"} test grid-2.5 {bbox} -body { - grid bbox . x 0 + grid bbox . x 0 } -returnCodes error -result {expected integer but got "x"} test grid-2.6 {bbox} -body { - grid bbox . 0 x + grid bbox . 0 x } -returnCodes error -result {expected integer but got "x"} test grid-2.7 {bbox} -body { - grid bbox . 0 0 x 0 + grid bbox . 0 0 x 0 } -returnCodes error -result {expected integer but got "x"} test grid-2.8 {bbox} -body { - grid bbox . 0 0 0 x + grid bbox . 0 0 0 x } -returnCodes error -result {expected integer but got "x"} test grid-2.9 {bbox} -body { frame .1 -width 75 -height 75 -bg red @@ -123,11 +119,10 @@ test grid-2.9 {bbox} -body { lappend a [grid bbox . 0 0] lappend a [grid bbox . 0 0 1 1] lappend a [grid bbox . 1 1] - set a + return $a } -cleanup { grid_reset 2.9 } -result {{0 0 165 165} {0 0 75 75} {0 0 165 165} {75 75 90 90}} - test grid-2.10 {bbox} -body { frame .1 -width 75 -height 75 -bg red frame .2 -width 90 -height 90 -bg red @@ -138,12 +133,11 @@ test grid-2.10 {bbox} -body { lappend a [grid bbox . 10 10 0 0] lappend a [grid bbox . -2 -2 -1 -1] lappend a [grid bbox . 10 10 12 12] - set a + return $a } -cleanup { grid_reset 2.10 } -result {{0 0 165 165} {0 0 0 0} {165 165 0 0}} - test grid-3.1 {configure: basic argument checking} -body { grid configure foo } -returnCodes error -result {bad argument "foo": must be name of window} @@ -154,35 +148,30 @@ test grid-3.2 {configure: basic argument checking} -body { } -cleanup { grid_reset 3.2 } -result {.b} - test grid-3.3 {configure: basic argument checking} -body { button .b grid .b -row -1 } -cleanup { grid_reset 3.3 } -returnCodes error -result {bad row value "-1": must be a non-negative integer} - test grid-3.4 {configure: basic argument checking} -body { button .b grid .b -column -1 } -cleanup { grid_reset 3.4 } -returnCodes error -result {bad column value "-1": must be a non-negative integer} - test grid-3.5 {configure: basic argument checking} -body { button .b grid .b -rowspan 0 } -cleanup { grid_reset 3.5 } -returnCodes error -result {bad rowspan value "0": must be a positive integer} - test grid-3.6 {configure: basic argument checking} -body { button .b grid .b -columnspan 0 } -cleanup { grid_reset 3.6 } -returnCodes error -result {bad columnspan value "0": must be a positive integer} - test grid-3.7 {configure: basic argument checking} -body { frame .f button .f.b @@ -190,7 +179,6 @@ test grid-3.7 {configure: basic argument checking} -body { } -cleanup { grid_reset 3.7 } -returnCodes error -result {can't put .f.b inside .} - test grid-3.8 {configure: basic argument checking} -body { button .b grid configure x .b @@ -198,7 +186,6 @@ test grid-3.8 {configure: basic argument checking} -body { } -cleanup { grid_reset 3.8 } -result {.b} - test grid-3.9 {configure: basic argument checking} -body { button .b grid configure y .b @@ -206,7 +193,6 @@ test grid-3.9 {configure: basic argument checking} -body { grid_reset 3.9 } -returnCodes error -result {invalid window shortcut, "y" should be '-', 'x', or '^'} - test grid-4.1 {forget: basic argument checking} -body { grid forget foo } -returnCodes error -result {bad window path name "foo"} @@ -216,11 +202,10 @@ test grid-4.2 {forget} -body { set a [grid slaves .] grid forget .b .c lappend a [grid slaves .] - set a + return $a } -cleanup { grid_reset 4.2 } -result {.b {}} - test grid-4.3 {forget} -body { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns @@ -230,7 +215,6 @@ test grid-4.3 {forget} -body { } -cleanup { grid_reset 4.3 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} - test grid-4.4 {forget} -body { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx {3 5} -pady {4 7} -sticky ns @@ -240,7 +224,6 @@ test grid-4.4 {forget} -body { } -cleanup { grid_reset 4.3.1 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} - test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body { frame .f -bd 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 @@ -256,9 +239,8 @@ test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body { grid_reset 4.4 } -result {1 0} - test grid-5.1 {info: basic argument checking} -body { - grid info a b + grid info a b } -returnCodes error -result {wrong # args: should be "grid info window"} test grid-5.2 {info} -body { frame .1 -width 75 -height 75 -bg red @@ -268,7 +250,6 @@ test grid-5.2 {info} -body { } -cleanup { grid_reset 5.2 } -returnCodes error -result {bad window path name ".x"} - test grid-5.3 {info} -body { frame .1 -width 75 -height 75 -bg red grid .1 -row 0 -column 0 @@ -277,7 +258,6 @@ test grid-5.3 {info} -body { } -cleanup { grid_reset 5.3 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} - test grid-5.4 {info} -body { frame .1 -width 75 -height 75 -bg red update @@ -286,26 +266,24 @@ test grid-5.4 {info} -body { grid_reset 5.4 } -returnCodes ok -result {} - test grid-6.1 {location: basic argument checking} -body { - grid location . + grid location . } -returnCodes error -result {wrong # args: should be "grid location master x y"} test grid-6.2 {location: basic argument checking} -body { - grid location .bad 0 0 + grid location .bad 0 0 } -returnCodes error -result {bad window path name ".bad"} test grid-6.3 {location: basic argument checking} -body { - grid location . x y + grid location . x y } -returnCodes error -result {bad screen distance "x"} test grid-6.4 {location: basic argument checking} -body { - grid location . 1c y + grid location . 1c y } -returnCodes error -result {bad screen distance "y"} test grid-6.5 {location: basic argument checking} -body { - frame .f - grid location .f 10 10 + frame .f + grid location .f 10 10 } -cleanup { grid_reset 6.5 } -result {-1 -1} - test grid-6.6 {location (x)} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -319,11 +297,10 @@ test grid-6.6 {location (x)} -body { set got $a } } - set result + return $result } -cleanup { grid_reset 6.6 } -result {{-10->-1 0} {0->0 0} {201->1 0}} - test grid-6.7 {location (y)} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -337,11 +314,10 @@ test grid-6.7 {location (y)} -body { set got $a } } - set result + return $result } -cleanup { grid_reset 6.7 } -result {{-10->0 -1} {0->0 0} {101->0 1}} - test grid-6.8 {location (weights)} -body { frame .f -width 300 -height 100 -highlightthickness 0 -bg red frame .a @@ -361,56 +337,49 @@ test grid-6.8 {location (weights)} -body { set got $a } } - set result + return $result } -cleanup { grid_reset 6.8 } -result {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}} - test grid-6.9 {location: check updates pending} -constraints { - nonPortable + nonPortable } -body { - set a "" - foreach i {0 1 2} { - frame .$i -width 120 -height 75 -bg red - lappend a [grid location . 150 90] - grid .$i -row $i -column $i - } - set a + set a "" + foreach i {0 1 2} { + frame .$i -width 120 -height 75 -bg red + lappend a [grid location . 150 90] + grid .$i -row $i -column $i + } + return $a } -cleanup { grid_reset 6.9 } -result {{0 0} {1 1} {1 1}} - test grid-7.1 {propagate} -body { grid propagate . 1 xxx } -cleanup { grid_reset 7.1 } -returnCodes error -result {wrong # args: should be "grid propagate window ?boolean?"} - test grid-7.2 {propagate} -body { grid propagate . } -cleanup { grid_reset 7.2 } -result {1} - test grid-7.3 {propagate} -body { grid propagate . 0;grid propagate . } -cleanup { grid_reset 7.3 } -result {0} - test grid-7.4 {propagate} -body { grid propagate .x } -cleanup { grid_reset 7.4 } -returnCodes error -result {bad window path name ".x"} - test grid-7.5 {propagate} -body { grid propagate . x } -cleanup { grid_reset 7.5 } -returnCodes error -result {expected boolean value but got "x"} - test grid-7.6 {propagate} -body { frame .f -width 100 -height 100 -bg red grid .f -row 0 -column 0 @@ -424,7 +393,7 @@ test grid-7.6 {propagate} -body { grid propagate .f 1 update lappend a [winfo width .f]x[winfo height .f] - set a + return $a } -cleanup { grid_reset 7.6 } -result {100x100 100x100 75x85} @@ -435,31 +404,27 @@ test grid-7.7 {propagate} -body { lappend res [grid propagate .] grid propagate . 0 lappend res [grid propagate .] - set res + return $res } -cleanup { grid_reset 7.7 } -result [list 1 0 0] - test grid-8.1 {size} -body { grid size . foo } -cleanup { grid_reset 8.1 } -returnCodes error -result {wrong # args: should be "grid size window"} - test grid-8.2 {size} -body { grid size .x } -cleanup { grid_reset 8.2 } -returnCodes error -result {bad window path name ".x"} - test grid-8.3 {size} -body { frame .f grid size .f } -cleanup { grid_reset 8.3 } -result {0 0} - test grid-8.4 {size} -body { catch {unset a} scale .f @@ -475,11 +440,10 @@ test grid-8.4 {size} -body { grid .f -row 0 -column 0 update lappend a [grid size .] - set a + return $a } -cleanup { grid_reset 8.4 } -result {{1 1} {6 5} {664 948} {1 1}} - test grid-8.5 {size} -body { catch {unset a} scale .f @@ -496,11 +460,10 @@ test grid-8.5 {size} -body { grid rowconfigure . 17 -weight 0 update lappend a [grid size .] - set a + return $a } -cleanup { grid_reset 8.5 } -result {{1 1} {1 18} {64 18} {1 1}} - test grid-8.6 {size} -body { catch {unset a} scale .f @@ -523,49 +486,47 @@ test grid-8.6 {size} -body { grid columnconfigure . 15 -weight 0 update lappend a [grid size .] - set a + return $a } -cleanup { grid_reset 8.6 } -result {{51 11} {51 11} {31 11} {21 11} {16 1} {1 1}} - test grid-9.1 {slaves} -body { - grid slaves . + grid slaves . } -returnCodes ok -result {} test grid-9.2 {slaves} -body { - grid slaves .foo + grid slaves .foo } -returnCodes error -result {bad window path name ".foo"} test grid-9.3 {slaves} -body { - grid slaves a b + grid slaves a b } -returnCodes error -result {wrong # args: should be "grid slaves window ?-option value ...?"} test grid-9.4 {slaves} -body { - grid slaves . a b + grid slaves . a b } -returnCodes error -result {bad option "a": must be -column or -row} test grid-9.5 {slaves} -body { - grid slaves . -column x + grid slaves . -column x } -returnCodes error -result {expected integer but got "x"} test grid-9.6 {slaves} -body { - grid slaves . -row -3 + grid slaves . -row -3 } -returnCodes error -result {-3 is an invalid value: should NOT be < 0} test grid-9.7 {slaves} -body { - grid slaves . -foo 3 + grid slaves . -foo 3 } -returnCodes error -result {bad option "-foo": must be -column or -row} test grid-9.8 {slaves} -body { - grid slaves .x -row 3 + grid slaves .x -row 3 } -returnCodes error -result {bad window path name ".x"} test grid-9.9 {slaves} -body { - grid slaves . -row 3 + grid slaves . -row 3 } -returnCodes ok -result {} test grid-9.10 {slaves} -body { - foreach i {0 1 2} { - label .$i -text $i - grid .$i -row $i -column $i - } - grid slaves . + foreach i {0 1 2} { + label .$i -text $i + grid .$i -row $i -column $i + } + grid slaves . } -cleanup { grid_reset 9.10 } -result {.2 .1 .0} - test grid-9.11 {slaves} -body { catch {unset a} foreach i {0 1 2} { @@ -580,168 +541,145 @@ test grid-9.11 {slaves} -body { foreach col {0 1 2 3} { lappend a $col{[grid slaves . -column $col]} } - set a + return $a } -cleanup { grid_reset 9.11 } -result {{0{.0-x .0}} {1{.1-x .1}} {2{.2-x .2}} 3{} 0{.0} {1{.1 .0-x}} {2{.2 .1-x}} 3{.2-x}} - # column/row configure test grid-10.1 {column/row configure} -body { - grid columnconfigure . + grid columnconfigure . } -cleanup { grid_reset 10.1 } -returnCodes error -result {wrong # args: should be "grid columnconfigure master index ?-option value ...?"} - test grid-10.2 {column/row configure} -body { - grid columnconfigure . 0 -weight 0 -pad + grid columnconfigure . 0 -weight 0 -pad } -cleanup { grid_reset 10.2 } -returnCodes error -result {wrong # args: should be "grid columnconfigure master index ?-option value ...?"} - test grid-10.3 {column/row configure} -body { - grid columnconfigure .f 0 -weight + grid columnconfigure .f 0 -weight } -cleanup { grid_reset 10.3 } -returnCodes error -result {bad window path name ".f"} - test grid-10.4 {column/row configure} -body { - grid columnconfigure . nine -weight + grid columnconfigure . nine -weight } -cleanup { grid_reset 10.4 -} -returnCodes error -result {expected integer but got "nine" (when retreiving options only integer indices are allowed)} - +} -returnCodes error -result {expected integer but got "nine" (when retrieving options only integer indices are allowed)} test grid-10.5 {column/row configure} -body { - grid columnconfigure . 265 -weight + grid columnconfigure . 265 -weight } -cleanup { grid_reset 10.5 } -result {0} - test grid-10.6 {column/row configure} -body { - grid columnconfigure . 0 + grid columnconfigure . 0 } -cleanup { grid_reset 10.6 } -result {-minsize 0 -pad 0 -uniform {} -weight 0} - test grid-10.7 {column/row configure} -body { - grid columnconfigure . 0 -foo + grid columnconfigure . 0 -foo } -cleanup { grid_reset 10.7 } -returnCodes error -result {bad option "-foo": must be -minsize, -pad, -uniform, or -weight} - test grid-10.8 {column/row configure} -body { - grid columnconfigure . 0 -minsize foo + grid columnconfigure . 0 -minsize foo } -cleanup { grid_reset 10.8 } -returnCodes error -result {bad screen distance "foo"} - test grid-10.9 {column/row configure} -body { - grid columnconfigure . 0 -minsize foo + grid columnconfigure . 0 -minsize foo } -cleanup { grid_reset 10.9 } -returnCodes error -result {bad screen distance "foo"} - test grid-10.10 {column/row configure} -body { - grid columnconfigure . 0 -minsize 10 - grid columnconfigure . 0 -minsize + grid columnconfigure . 0 -minsize 10 + grid columnconfigure . 0 -minsize } -cleanup { grid_reset 10.10 } -result {10} - test grid-10.11 {column/row configure} -body { - grid columnconfigure . 0 -weight bad + grid columnconfigure . 0 -weight bad } -cleanup { grid_reset 10.11 } -returnCodes error -result {expected integer but got "bad"} - test grid-10.12 {column/row configure} -body { - grid columnconfigure . 0 -weight -3 + grid columnconfigure . 0 -weight -3 } -cleanup { grid_reset 10.12 } -returnCodes error -result {invalid arg "-weight": should be non-negative} - test grid-10.13 {column/row configure} -body { - grid columnconfigure . 0 -weight 3 - grid columnconfigure . 0 -weight + grid columnconfigure . 0 -weight 3 + grid columnconfigure . 0 -weight } -cleanup { grid_reset 10.13 } -result {3} - test grid-10.14 {column/row configure} -body { - grid columnconfigure . 0 -pad foo + grid columnconfigure . 0 -pad foo } -cleanup { grid_reset 10.14 } -returnCodes error -result {bad screen distance "foo"} - test grid-10.15 {column/row configure} -body { - grid columnconfigure . 0 -pad -3 + grid columnconfigure . 0 -pad -3 } -cleanup { grid_reset 10.15 } -returnCodes error -result {invalid arg "-pad": should be non-negative} - test grid-10.16 {column/row configure} -body { - grid columnconfigure . 0 -pad 3 - grid columnconfigure . 0 -pad + grid columnconfigure . 0 -pad 3 + grid columnconfigure . 0 -pad } -cleanup { grid_reset 10.16 } -result {3} - test grid-10.17 {column/row configure} -body { - frame .f - set a "" - grid columnconfigure .f 0 -weight 0 - lappend a [grid columnconfigure .f 0 -weight] - grid columnconfigure .f 0 -weight 1 - lappend a [grid columnconfigure .f 0 -weight] - grid rowconfigure .f 0 -weight 0 - lappend a [grid rowconfigure .f 0 -weight] - grid rowconfigure .f 0 -weight 1 - lappend a [grid columnconfigure .f 0 -weight] - grid columnconfigure .f 0 -weight 0 - set a + frame .f + set a "" + grid columnconfigure .f 0 -weight 0 + lappend a [grid columnconfigure .f 0 -weight] + grid columnconfigure .f 0 -weight 1 + lappend a [grid columnconfigure .f 0 -weight] + grid rowconfigure .f 0 -weight 0 + lappend a [grid rowconfigure .f 0 -weight] + grid rowconfigure .f 0 -weight 1 + lappend a [grid columnconfigure .f 0 -weight] + grid columnconfigure .f 0 -weight 0 + return $a } -cleanup { grid_reset 10.17 } -result {0 1 0 1} - test grid-10.18 {column/row configure} -body { - frame .f - grid columnconfigure .f {0 2} -minsize 10 -weight 1 - list [grid columnconfigure .f 0 -minsize] \ - [grid columnconfigure .f 1 -minsize] \ - [grid columnconfigure .f 2 -minsize] \ - [grid columnconfigure .f 0 -weight] \ - [grid columnconfigure .f 1 -weight] \ - [grid columnconfigure .f 2 -weight] + frame .f + grid columnconfigure .f {0 2} -minsize 10 -weight 1 + list [grid columnconfigure .f 0 -minsize] \ + [grid columnconfigure .f 1 -minsize] \ + [grid columnconfigure .f 2 -minsize] \ + [grid columnconfigure .f 0 -weight] \ + [grid columnconfigure .f 1 -weight] \ + [grid columnconfigure .f 2 -weight] } -cleanup { grid_reset 10.18 } -result {10 0 10 1 0 1} - test grid-10.19 {column/row configure} -body { - grid columnconfigure . {0 -1 2} -weight 1 + grid columnconfigure . {0 -1 2} -weight 1 } -cleanup { grid_reset 10.19 } -returnCodes error -result {grid columnconfigure: "-1" is out of range} - test grid-10.20 {column/row configure} -body { - grid columnconfigure . 0 -uniform foo - grid columnconfigure . 0 -uniform + grid columnconfigure . 0 -uniform foo + grid columnconfigure . 0 -uniform } -cleanup { grid_reset 10.20 } -result {foo} - test grid-10.21 {column/row configure} -body { grid columnconfigure . .b -weight 1 } -cleanup { grid_reset 10.21 } -returnCodes error -result {grid columnconfigure: illegal index ".b"} - test grid-10.22 {column/row configure} -body { button .b grid columnconfigure . .b -weight 1 } -cleanup { grid_reset 10.22 } -returnCodes error -result {grid columnconfigure: the window ".b" is not managed by "."} - test grid-10.23 {column/row configure} -body { button .b grid .b -column 1 -columnspan 2 @@ -750,11 +688,10 @@ test grid-10.23 {column/row configure} -body { foreach i {0 1 2 3} { lappend res [grid columnconfigure . $i -weight] } - set res + return $res } -cleanup { grid_reset 10.23 } -result {0 1 1 0} - test grid-10.24 {column/row configure} -body { button .b button .c @@ -768,11 +705,10 @@ test grid-10.24 {column/row configure} -body { foreach i {0 1 2 3 4 5 6} { lappend res [grid columnconfigure . $i -weight] } - set res + return $res } -cleanup { grid_reset 10.24 } -result {0 1 2 2 2 1 0} - test grid-10.25 {column/row configure} -body { button .b button .c @@ -786,18 +722,16 @@ test grid-10.25 {column/row configure} -body { foreach i {0 1 2 3 4 5 6 7} { lappend res [grid rowconfigure . $i -weight] } - set res + return $res } -cleanup { grid_reset 10.25 } -result {0 2 1 1 2 2 0 1} - test grid-10.26 {column/row configure} -body { button .b grid columnconfigure .b 0 } -cleanup { grid_reset 10.26 } -result {-minsize 0 -pad 0 -uniform {} -weight 0} - test grid-10.27 {column/row configure - no indices} -body { # Bug 1422430 set t [toplevel .test] @@ -834,23 +768,20 @@ test grid-10.32 {column/row configure} -body { append res [grid columnconfigure .f {.f.f 1} -weight 1] append res [grid columnconfigure .f {2 .f.f} -weight 1] destroy .f - set res + return $res } -cleanup { grid_reset 10.35 } -result {} - test grid-10.33 {column/row configure} -body { grid columnconfigure . all } -cleanup { grid_reset 10.36 -} -returnCodes error -result {expected integer but got "all" (when retreiving options only integer indices are allowed)} - +} -returnCodes error -result {expected integer but got "all" (when retrieving options only integer indices are allowed)} test grid-10.34 {column/row configure} -body { grid columnconfigure . 100000 } -cleanup { grid_reset 10.37 } -result {-minsize 0 -pad 0 -uniform {} -weight 0} - test grid-10.35 {column/row configure} -body { # This is a test for bug 1423666 where a column >= 10000 caused # a crash in layout. The update is needed to reach the layout stage. @@ -863,7 +794,7 @@ test grid-10.35 {column/row configure} -body { lappend res [catch {grid .f -rowspan 2 -row 9998} msg] $msg ; update lappend res [catch {grid .f -column 9998 -columnspan 2} msg] $msg ; update lappend res [catch {grid .f -row 9998 -rowspan 2} msg] $msg ; update - set res + return $res } -cleanup {destroy .f} -result [lrange { 1 {column out of bounds} 1 {row out of bounds} @@ -873,7 +804,6 @@ test grid-10.35 {column/row configure} -body { 1 {row out of bounds} } 0 end] grid_reset 10.38 - test grid-10.36 {column/row configure} -body { # Additional tests for row/column overflow frame .f @@ -887,7 +817,7 @@ test grid-10.36 {column/row configure} -body { grid forget .f .g lappend res [catch {eval grid [string repeat " x " 9999] .f} msg] $msg update - set res + return $res } -cleanup {destroy .f .g} -result [lrange { 1 {row out of bounds} 1 {row out of bounds} @@ -896,42 +826,36 @@ test grid-10.36 {column/row configure} -body { } 0 end] grid_reset 10.39 - # auto-placement tests test grid-11.1 {default widget placement} -body { - grid ^ + grid ^ } -cleanup { grid_reset 11.1 } -returnCodes error -result {can't use '^', cant find master} - test grid-11.2 {default widget placement} -body { - button .b - grid .b ^ + button .b + grid .b ^ } -cleanup { grid_reset 11.2 } -returnCodes error -result {can't find slave to extend with "^"} - test grid-11.3 {default widget placement} -body { - button .b - grid .b - - .c + button .b + grid .b - - .c } -cleanup { grid_reset 11.3 } -returnCodes error -result {bad window path name ".c"} - test grid-11.4 {default widget placement} -body { - button .b - grid .b - - = - + button .b + grid .b - - = - } -cleanup { grid_reset 11.4 } -returnCodes error -result {invalid window shortcut, "=" should be '-', 'x', or '^'} - test grid-11.5 {default widget placement} -body { - button .b - grid .b - x - + button .b + grid .b - x - } -cleanup { grid_reset 11.5 } -returnCodes error -result {must specify window before shortcut '-'} - test grid-11.6 {default widget placement} -body { foreach i {1 2 3 4 5 6} { frame .f$i -width 50 -height 50 -highlightthickness 0 -bg red @@ -944,11 +868,10 @@ test grid-11.6 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.6 } -result {{0,50 100,50} {150,50 50,50}} - test grid-11.7 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 @@ -956,7 +879,6 @@ test grid-11.7 {default widget placement} -body { } -cleanup { grid_reset 11.7 } -returnCodes error -result {must specify window before shortcut '-'} - test grid-11.8 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 @@ -964,7 +886,6 @@ test grid-11.8 {default widget placement} -body { } -cleanup { grid_reset 11.8 } -returnCodes error -result {must specify window before shortcut '-'} - test grid-11.9 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 @@ -972,10 +893,9 @@ test grid-11.9 {default widget placement} -body { } -cleanup { grid_reset 11.9 } -returnCodes error -result {can't find slave to extend with "^"} - test grid-11.10 {default widget placement} -body { foreach i {1 2 3} { - frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red + frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red } grid .f1 .f2 -sticky nsew grid .f3 ^ -sticky nsew @@ -985,57 +905,54 @@ test grid-11.10 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.10 } -result {{0,0 100,50} {100,0 100,100} {0,50 100,50}} - test grid-11.11 {default widget placement} -body { foreach i {1 2 3 4 5 6 7 8 9 10 11 12} { - frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black } - grid .f1 .f2 .f3 .f4 -sticky nsew + grid .f1 .f2 .f3 .f4 -sticky nsew grid .f5 .f6 - .f7 -sticky nsew grid .f8 ^ ^ .f9 -sticky nsew - grid .f10 ^ ^ .f11 -sticky nsew - grid .f12 - - - -sticky nsew + grid .f10 ^ ^ .f11 -sticky nsew + grid .f12 - - - -sticky nsew update set a "" foreach i {5 6 7 8 9 10 11 12 } { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.11 } -result {{0,50 50,50} {50,50 100,150} {150,50 50,50} {0,100 50,50} {150,100 50,50} {0,150 50,50} {150,150 50,50} {0,200 200,50}} - test grid-11.12 {default widget placement} -body { foreach i {1 2 3 4} { - frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black } grid .f1 .f2 .f3 -sticky nsew grid .f4 ^ -sticky nsew update set a "" foreach i {1 2 3 4} { - lappend a "[winfo x .f$i],[winfo y .f$i] \ - [winfo width .f$i],[winfo height .f$i]" + lappend a "[winfo x .f$i],[winfo y .f$i] \ + [winfo width .f$i],[winfo height .f$i]" } grid .f4 ^ -column 1 update foreach i {1 2 3 4} { - lappend a "[winfo x .f$i],[winfo y .f$i] \ - [winfo width .f$i],[winfo height .f$i]" - } - set a + lappend a "[winfo x .f$i],[winfo y .f$i] \ + [winfo width .f$i],[winfo height .f$i]" + } + return $a } -cleanup { grid_reset 11.12 } -result {{0,0 75,50} {75,0 75,100} {150,0 75,50} {0,50 75,50} {0,0 75,50} {75,0 75,100} {150,0 75,100} {75,50 75,50}} - test grid-11.13 {default widget placement} -body { foreach i {1 2 3 4 5 6 7} { - frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black } grid .f1 .f2 .f3 .f4 .f5 -sticky nsew grid .f6 - .f7 -sticky nsew -columnspan 2 @@ -1045,11 +962,10 @@ test grid-11.13 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.13 } -result {{0,50 120,50} {120,50 80,50}} - test grid-11.14 {default widget placement} -body { foreach i {1 2 3} { frame .f$i -width 60 -height 60 -highlightthickness 0 -bg red @@ -1062,11 +978,10 @@ test grid-11.14 {default widget placement} -body { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.14 } -result {{0,30 60,60} {60,0 60,60} {60,60 60,60}} - test grid-11.15 {^ ^ test with multiple windows} -body { foreach i {1 2 3 4} { frame .f$i -width 50 -height 50 -bd 1 -relief solid @@ -1079,11 +994,10 @@ test grid-11.15 {^ ^ test with multiple windows} -body { lappend a "[winfo x .f$i],[winfo y .f$i]\ [winfo width .f$i],[winfo height .f$i]" } - set a + return $a } -cleanup { grid_reset 11.15 } -result {{0,0 50,50} {50,0 50,100} {100,0 50,100} {0,50 50,50}} - test grid-11.16 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1098,7 +1012,6 @@ test grid-11.16 {default widget placement} -body { } -cleanup { grid_reset 11.16 } -result {50 100 50} - test grid-11.17 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1113,7 +1026,6 @@ test grid-11.17 {default widget placement} -body { } -cleanup { grid_reset 11.17 } -result {100 50 100} - test grid-11.18 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1130,7 +1042,6 @@ test grid-11.18 {default widget placement} -body { } -cleanup { grid_reset 11.18 } -result {100 100 100 50} - test grid-11.19 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 @@ -1139,7 +1050,6 @@ test grid-11.19 {default widget placement} -body { grid .c .d -sticky news grid ^ -in . -row 2 grid x ^ -in . -row 1 - grid rowconfigure . {0 1 2} -uniform a update set res "" @@ -1151,7 +1061,6 @@ test grid-11.19 {default widget placement} -body { grid_reset 11.19 } -result {50 100 100 50} - test grid-12.1 {-sticky} -body { catch {unset data} frame .f -width 200 -height 100 -highlightthickness 0 -bg red @@ -1167,7 +1076,7 @@ test grid-12.1 {-sticky} -body { array set data [grid info .f] append a "($data(-sticky)) [winfo x .f] [winfo y .f] [winfo width .f] [winfo height .f]\n" } - set a + return $a } -cleanup { grid_reset 12.1 } -result {() 25 25 200 100 @@ -1187,14 +1096,12 @@ test grid-12.1 {-sticky} -body { (new) 0 0 250 100 (nesw) 0 0 250 150 } - test grid-12.2 {-sticky} -body { frame .f -bg red grid .f -sticky glue } -cleanup { grid_reset 12.2 } -returnCodes error -result {bad stickyness value "glue": must be a string containing n, e, s, and/or w} - test grid-12.3 {-sticky} -body { frame .f -bg red grid .f -sticky {n,s,e,w} @@ -1204,14 +1111,12 @@ test grid-12.3 {-sticky} -body { grid_reset 12.3 } -result {nesw} - test grid-13.1 {-in} -body { frame .f -bg red grid .f -in .f } -cleanup { grid_reset 13.1 } -returnCodes error -result {window can't be managed in itself} - test grid-13.2 {-in} -body { frame .f -bg red list [winfo manager .f] \ @@ -1220,14 +1125,12 @@ test grid-13.2 {-in} -body { } -cleanup { grid_reset 13.1.1 } -result {{} 1 {window can't be managed in itself} {}} - test grid-13.3 {-in} -body { frame .f -bg red grid .f -in .bad } -cleanup { grid_reset 13.2 } -returnCodes error -result {bad window path name ".bad"} - test grid-13.4 {-in} -body { frame .f -bg red toplevel .top @@ -1236,21 +1139,18 @@ test grid-13.4 {-in} -body { grid_reset 13.3 } -returnCodes error -result {can't put .f inside .top} destroy .top - test grid-13.5 {-ipadx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipadx x } -cleanup { grid_reset 13.4 } -returnCodes error -result {bad ipadx value "x": must be positive screen distance} - test grid-13.6 {-ipadx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipadx {5 5} } -cleanup { grid_reset 13.4.1 } -returnCodes error -result {bad ipadx value "5 5": must be positive screen distance} - test grid-13.7 {-ipadx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1262,21 +1162,18 @@ test grid-13.7 {-ipadx} -body { } -cleanup { grid_reset 13.5 } -result {200 202} - test grid-13.8 {-ipady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipady x } -cleanup { grid_reset 13.6 } -returnCodes error -result {bad ipady value "x": must be positive screen distance} - test grid-13.9 {-ipady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -ipady {5 5} } -cleanup { grid_reset 13.6.1 } -returnCodes error -result {bad ipady value "5 5": must be positive screen distance} - test grid-13.10 {-ipady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1288,21 +1185,18 @@ test grid-13.10 {-ipady} -body { } -cleanup { grid_reset 13.7 } -result {100 102} - test grid-13.11 {-padx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -padx x } -cleanup { grid_reset 13.8 } -returnCodes error -result {bad pad value "x": must be positive screen distance} - test grid-13.12 {-padx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -padx {10 x} } -cleanup { grid_reset 13.8.1 } -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} - test grid-13.13 {-padx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1314,7 +1208,6 @@ test grid-13.13 {-padx} -body { } -cleanup { grid_reset 13.9 } -result {{200 200} {200 202 1}} - test grid-13.14 {-padx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1326,21 +1219,18 @@ test grid-13.14 {-padx} -body { } -cleanup { grid_reset 13.9.1 } -result {{200 200} {200 215 10}} - test grid-13.15 {-pady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -pady x } -cleanup { grid_reset 13.10 } -returnCodes error -result {bad pad value "x": must be positive screen distance} - test grid-13.16 {-pady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -pady {10 x} } -cleanup { grid_reset 13.10.1 } -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} - test grid-13.17 {-pady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1352,7 +1242,6 @@ test grid-13.17 {-pady} -body { } -cleanup { grid_reset 13.11 } -result {{100 100} {100 102 1}} - test grid-13.18 {-pady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f @@ -1364,27 +1253,25 @@ test grid-13.18 {-pady} -body { } -cleanup { grid_reset 13.11.1 } -result {{100 100} {100 120 4}} - test grid-13.19 {-ipad x and y} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid columnconfigure . 0 -minsize 150 grid rowconfigure . 0 -minsize 100 set a "" foreach x {0 5} { - foreach y {0 5} { + foreach y {0 5} { grid .f -ipadx $x -ipady $y update append a " $x,$y:" foreach prop {x y width height} { - append a ,[winfo $prop .f] + append a ,[winfo $prop .f] } } } - set a + return $a } -cleanup { grid_reset 13.12 } -result { 0,0:,65,40,20,20 0,5:,65,35,20,30 5,0:,60,40,30,20 5,5:,60,35,30,30} - test grid-13.20 {reparenting} -body { frame .1 frame .2 @@ -1398,12 +1285,11 @@ test grid-13.20 {reparenting} -body { catch {unset info}; array set info [grid info .b] lappend a [grid slaves .1],[grid slaves .2],$info(-in) unset info - set a + return $a } -cleanup { grid_reset 13.13 } -result {.b,,.1 ,.b,.2} - test grid-14.1 {structure notify} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red frame .g -width 200 -height 100 -highlightthickness 0 -bg red @@ -1417,11 +1303,10 @@ test grid-14.1 {structure notify} -body { update lappend a "[winfo x .g],[winfo y .g] \ [winfo width .g],[winfo height .g]" - set a + return $a } -cleanup { grid_reset 14.1 } -result {{0,0 200,100} {5,5 200,100}} - test grid-14.2 {structure notify} -body { frame .f -width 200 -height 100 frame .f.g -width 200 -height 100 @@ -1436,10 +1321,7 @@ test grid-14.2 {structure notify} -body { } -cleanup { grid_reset 14.2 } -result {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}} - -test grid-14.3 {map notify: bug 1648} -constraints { - nonPortable -} -body { +test grid-14.3 {map notify: bug 1648} -constraints {nonPortable} -body { # This test is nonPortable because the number of times # A(.) will be incremented is unspecified--the behavior # is different accross window managers. @@ -1462,7 +1344,6 @@ test grid-14.3 {map notify: bug 1648} -constraints { grid_reset 14.3 } -result {.2 2 .0 1 . 2 .1 1} - test grid-15.1 {lost slave} -body { button .b grid .b @@ -1474,7 +1355,6 @@ test grid-15.1 {lost slave} -body { } -cleanup { grid_reset 15.1 } -result {.b {} .b} - test grid-15.2 {lost slave} -body { frame .f grid .f @@ -1489,11 +1369,10 @@ test grid-15.2 {lost slave} -body { grid_reset 15.2 } -result {.b {} .b} - test grid-16.1 {layout centering} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid anchor . center @@ -1503,13 +1382,12 @@ test grid-16.1 {layout centering} -body { } -cleanup { grid_reset 16.1 } -result {37 50 225 150} - test grid-16.2 {layout weights (expanding)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] - grid columnconfigure . $i -weight [expr $i + 1] + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] + grid columnconfigure . $i -weight [expr $i + 1] } grid propagate . 0 . configure -width 500 -height 300 @@ -1518,17 +1396,16 @@ test grid-16.2 {layout weights (expanding)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.2 } -result {120-75 167-100 213-125} - test grid-16.3 {layout weights (shrinking)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] - grid columnconfigure . $i -weight [expr $i + 1] + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] + grid columnconfigure . $i -weight [expr $i + 1] } grid propagate . 0 . configure -width 200 -height 150 @@ -1537,17 +1414,16 @@ test grid-16.3 {layout weights (shrinking)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.3 } -result {84-63 66-50 50-37} - test grid-16.4 {layout weights (shrinking with minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 - grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 + grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 } grid propagate . 0 . configure -width 200 -height 150 @@ -1556,17 +1432,16 @@ test grid-16.4 {layout weights (shrinking with minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.4 } -result {70-60 65-45 65-45} - test grid-16.5 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight 0 -minsize 70 - grid columnconfigure . $i -weight 0 -minsize 90 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight 0 -minsize 70 + grid columnconfigure . $i -weight 0 -minsize 90 } grid propagate . 0 . configure -width 100 -height 75 @@ -1575,18 +1450,16 @@ test grid-16.5 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.5 } -result {100-75 100-75 100-75} - - test grid-16.6 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 - grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 + grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 } grid propagate . 0 . configure -width 200 -height 150 @@ -1595,11 +1468,10 @@ test grid-16.6 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a + return $a } -cleanup { grid_reset 16.6 } -result {69-52 69-52 69-52} - # test fails when run alone # reason (I think): -minsize 0 causes both: # [winfo ismapped .$i] => 0 and @@ -1608,8 +1480,8 @@ test grid-16.6 {layout weights (shrinking at minsize)} -body { # That doesn't happen if previous tests run test grid-16.7 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid columnconfigure . 1 -weight 1 -minsize 0 @@ -1620,15 +1492,14 @@ test grid-16.7 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i] } - set a + return $a } -cleanup { grid_reset 16.7 } -result {100-75-1 1-1-0 100-75-1} - test grid-16.8 {layout internal constraints} -body { foreach i {0 1 2 3 4} { - frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } frame .f -bg red -width 250 -height 200 frame .g -bg green -width 200 -height 180 @@ -1639,32 +1510,31 @@ test grid-16.8 {layout internal constraints} -body { update set a "" foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .g grid .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } - set a + return $a } -cleanup { grid_reset 16.8 } -result {0 30 130 230 280 , 0 30 130 230 260 , 0 30 113 196 280 , 0 30 60 90 120 } - test grid-16.9 {layout uniform} -body { frame .f1 -width 75 -height 50 frame .f2 -width 60 -height 25 @@ -1682,14 +1552,12 @@ test grid-16.9 {layout uniform} -body { } -cleanup { grid_reset 16.9 } -result {{0 0 135 75} {0 75 135 100} {0 175 135 75} {0 250 135 100} {0 350 135 40}} - test grid-16.10 {layout uniform} -body { grid [frame .f1 -width 75 -height 50] -row 0 -column 0 grid [frame .f2 -width 60 -height 30] -row 1 -column 2 grid [frame .f3 -width 95 -height 90] -row 2 -column 1 grid [frame .f4 -width 60 -height 100] -row 3 -column 4 grid [frame .f5 -width 60 -height 40] -row 4 -column 3 - grid rowconfigure . {0 1} -uniform a grid rowconfigure . {2 4} -uniform b grid rowconfigure . {0 2} -weight 2 @@ -1704,7 +1572,6 @@ test grid-16.10 {layout uniform} -body { } -cleanup { grid_reset 16.10 } -result {{0 0 75 60} {170 60 150 30} {75 90 95 90} {390 180 140 100} {320 280 70 45}} - test grid-16.11 {layout uniform (shrink)} -body { frame .f1 -width 75 -height 50 frame .f2 -width 100 -height 95 @@ -1721,7 +1588,6 @@ test grid-16.11 {layout uniform (shrink)} -body { } -cleanup { grid_reset 16.11 } -result {{0 0 100 95} {100 0 100 95} {0 0 50 95} {50 0 100 95}} - test grid-16.12 {layout uniform (grow)} -body { frame .f1 -width 40 -height 50 frame .f2 -width 50 -height 95 @@ -1737,7 +1603,6 @@ test grid-16.12 {layout uniform (grow)} -body { set res {} lappend res [grid bbox . 0 0] [grid bbox . 1 0] lappend res [grid bbox . 2 0] [grid bbox . 3 0] - grid propagate . 0 . configure -width 350 -height 95 update @@ -1747,15 +1612,12 @@ test grid-16.12 {layout uniform (grow)} -body { grid_reset 16.12 } -result [list {0 0 50 95} {50 0 50 95} {100 0 100 95} {200 0 70 95} \ {0 0 70 95} {70 0 50 95} {120 0 140 95} {260 0 90 95}] - test grid-16.13 {layout span} -body { frame .f1 -width 24 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid .f3 - - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 3 4 0} {1 2 1 2} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1768,22 +1630,19 @@ test grid-16.13 {layout span} -body { } lappend res $res2 } - set res + return $res # The last result below should ideally be 8 8 8 126 but the current # implementation is not exact enough. } -cleanup { grid_reset 16.13 } -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ [list 18 38 18 76 0] [list 7 8 9 126 0]] - test grid-16.14 {layout span} -body { frame .f1 -width 110 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid .f3 - - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 3 4 0} {1 2 1 3} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1796,20 +1655,17 @@ test grid-16.14 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.14 } -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ [list 27 55 28 40 0] [list 36 37 37 40 0]] - test grid-16.15 {layout span} -body { frame .f1 -width 24 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid x .f3 - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 0 1 0} {0 0 0 0} {1 0 0 6}} { for {set c 0} {$c < 4} {incr c} { @@ -1822,12 +1678,11 @@ test grid-16.15 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.15 } -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 0 0 112 38 0] \ [list 0 37 37 76 0] [list 0 12 12 126 0]] - test grid-16.16 {layout span} -body { frame .f1 -width 64 -height 20 frame .f2 -width 38 -height 20 @@ -1835,11 +1690,9 @@ test grid-16.16 {layout span} -body { frame .f4 -width 15 -height 20 frame .f5 -width 18 -height 20 frame .f6 -width 20 -height 20 - grid .f1 - x .f2 grid .f3 - - - grid .f4 .f5 .f6 - set res {} foreach w {{1 1 5 1} {0 0 1 0} {1 3 4 0} {1 2 1 2} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1852,16 +1705,15 @@ test grid-16.16 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.16 } -result [list [list 30 34 43 43 0] [list 30 34 48 38 0] [list 22 42 48 38 0] \ [list 25 39 29 57 0] [list 30 34 22 64 0]] - test grid-16.17 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2 3} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid columnconfigure . {0 1} -weight 1 -minsize 0 @@ -1877,21 +1729,18 @@ test grid-16.17 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2 3} { lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i] } - set a + return $a } -cleanup { grid_reset 16.17 } -result {25-25-1 25-25-1 100-75-1 100-75-1 25-25-0 25-25-0 100-75-1 100-75-1} - test grid-16.18 {layout span} -body { frame .f1 -width 30 -height 20 frame .f2 -width 166 -height 20 frame .f3 -width 39 -height 20 frame .f4 -width 10 -height 20 - grid .f1 .f3 - grid .f2 - .f4 grid columnconfigure . 0 -weight 1 - set res {} foreach w {{1 0 0} {0 1 0} {0 0 1}} { for {set c 0} {$c < 3} {incr c} { @@ -1904,11 +1753,10 @@ test grid-16.18 {layout span} -body { } lappend res $res2 } - set res + return $res } -cleanup { grid_reset 16.18 } -result [list [list 137 29 10] [list 30 136 10] [list 98 68 10]] - test grid-16.19 {layout span} -constraints { knownBug } -body { # This test shows the problem in Bug 2075285 # Several overlapping multi-span widgets is a weak spot @@ -1918,26 +1766,22 @@ test grid-16.19 {layout span} -constraints { knownBug } -body { frame .f2 -width 20 -height 20 frame .f3 -width 10 -height 20 frame .f4 -width 20 -height 20 - grid .f1 - - - - - -sticky we grid .f2 - .f3 - .f4 - -sticky we grid columnconfigure . {1 5} -weight 1 - set res {} update for {set c 0} {$c <= 5} {incr c} { lappend res [lindex [grid bbox . $c 0] 2] } - set res + return $res } -cleanup { grid_reset 16.19 } -result [list 0 45 5 5 0 45] - test grid-17.1 {forget and pending idle handlers} -body { # This test is intended to detect a crash caused by a failure to remove # pending idle handlers when grid forget is invoked. - toplevel .t wm geometry .t +0+0 frame .t.f @@ -1948,7 +1792,6 @@ test grid-17.1 {forget and pending idle handlers} -body { grid forget .t.f.l grid forget .t.f destroy .t - toplevel .t frame .t.f label .t.f.l -text foobar @@ -1974,7 +1817,7 @@ test grid-18.1 {test respect for internalborder} -body { update lappend res [winfo geometry .pack.lf.f] destroy .pack - set res + return $res } -result {196x188+2+10 177x186+5+7} test grid-18.2 {test support for minreqsize} -body { toplevel .pack @@ -1990,10 +1833,9 @@ test grid-18.2 {test support for minreqsize} -body { update lappend res [winfo geometry .pack.lf] destroy .pack - set res + return $res } -result {162x127+0+0 172x112+0+0} - test grid-19.1 {uniform realloc} -body { # Use a lot of uniform groups to test the reallocation mechanism for {set t 0} {$t < 100} {incr t 2} { @@ -2008,7 +1850,6 @@ test grid-19.1 {uniform realloc} -body { grid_reset 19.1 } -result {0 0 600 20} - test grid-20.1 {recalculate size after removal (destroy)} -body { label .l1 -text l1 grid .l1 -row 2 -column 2 @@ -2019,7 +1860,6 @@ test grid-20.1 {recalculate size after removal (destroy)} -body { } -cleanup { grid_reset 20.1 } -result {1 1} - test grid-20.2 {recalculate size after removal (forget)} -body { label .l1 -text l1 grid .l1 -row 2 -column 2 @@ -2031,58 +1871,50 @@ test grid-20.2 {recalculate size after removal (forget)} -body { grid_reset 20.2 } -result {1 1} - test grid-21.1 {anchor} -body { grid anchor . 1 xxx } -cleanup { grid_reset 21.1 } -returnCodes error -result {wrong # args: should be "grid anchor window ?anchor?"} - test grid-21.2 {anchor} -body { grid anchor . } -cleanup { grid_reset 21.2 } -result {nw} - test grid-21.3 {anchor} -body { grid anchor . se;grid anchor . } -cleanup { grid_reset 21.3 } -result {se} - test grid-21.4 {anchor} -body { grid anchor .x } -cleanup { grid_reset 21.4 } -returnCodes error -result {bad window path name ".x"} - test grid-21.5 {anchor} -body { grid anchor . x } -cleanup { grid_reset 21.5 } -returnCodes error -result {bad anchor "x": must be n, ne, e, se, s, sw, w, nw, or center} - test grid-21.6 {anchor} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 . configure -width 300 -height 250 - set res {} foreach a {n ne e se s sw w nw center} { grid anchor . $a update lappend res [grid bbox .] } - set res + return $res } -cleanup { grid_reset 21.6 } -result [list {37 0 225 150} {75 0 225 150} {75 50 225 150} {75 100 225 150} \ {37 100 225 150} {0 100 225 150} {0 50 225 150} {0 0 225 150} \ {37 50 225 150}] - test grid-21.7 {anchor} -body { # Test with a non-symmetric internal border. # This only tests vertically, there is currently no way to get @@ -2091,15 +1923,13 @@ test grid-21.7 {anchor} -body { frame .f.x -width 20 -height 20 .f configure -labelwidget .f.x pack .f -fill both -expand 1 - foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -in .f -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -in .f -row $i -column $i -sticky nswe } pack propagate . 0 grid propagate .f 0 . configure -width 300 -height 250 - set res {} foreach a {n ne e se s sw w nw center} { grid anchor .f $a @@ -2107,7 +1937,7 @@ test grid-21.7 {anchor} -body { lappend res [grid bbox .f] } pack propagate . 1 ; wm geometry . {} - set res + return $res } -cleanup { grid_reset 21.7 } -result [list {37 20 225 150} {75 20 225 150} {75 60 225 150} {75 100 225 150} \ @@ -2117,17 +1947,15 @@ test grid-21.7 {anchor} -body { test grid-22.1 {remove: basic argument checking} { list [catch {grid remove foo} msg] $msg } {1 {bad window path name "foo"}} - test grid-22.2 {remove} { button .c grid [button .b] set a [grid slaves .] grid remove .b .c lappend a [grid slaves .] - set a + return $a } {.b {}} grid_reset 22.2 - test grid-22.3 {remove} { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns @@ -2136,7 +1964,6 @@ test grid-22.3 {remove} { grid info .c } {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx 3 -pady 4 -sticky ns} grid_reset 22.3 - test grid-22.3.1 {remove} { frame .a button .c @@ -2146,7 +1973,6 @@ test grid-22.3.1 {remove} { grid info .c } {-in .a -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.3.1 - test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { frame .f -bd 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 @@ -2160,7 +1986,6 @@ test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { lappend x [winfo ismapped .f2] } {1 0} grid_reset 22.4 - test grid-22.5 {remove} { frame .a button .c @@ -2173,7 +1998,11 @@ test grid-22.5 {remove} { grid info .c } {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.5 - + # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index e2d1e39..a263a61 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -1232,6 +1232,7 @@ TkGetInterpNames( { TkWindow *winPtr = (TkWindow *) tkwin; NameRegistry *regPtr; + Tcl_Obj *resultObj = Tcl_NewObj(); char *p; /* @@ -1266,7 +1267,8 @@ TkGetInterpNames( * The application still exists; add its name to the result. */ - Tcl_AppendElement(interp, entryName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(entryName, -1)); } else { int count; @@ -1289,6 +1291,7 @@ TkGetInterpNames( } } RegClose(regPtr); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 0686348..989fa3f 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -74,7 +74,7 @@ typedef struct ProtocolHandler { typedef struct TkWmStackorderToplevelPair { Tcl_HashTable *table; - TkWindow **window_ptr; + TkWindow **windowPtr; } TkWmStackorderToplevelPair; /* @@ -3390,10 +3390,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2, **winPtr2Ptr = &winPtr2; + TkWindow **cmapList, *winPtr2, **winPtr2Ptr = &winPtr2; int i, windowObjc, gotToplevel; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -3401,13 +3400,16 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) @@ -4945,6 +4947,7 @@ WmProtocolCmd( Atom protocol; const char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -4955,11 +4958,13 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol), -1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -5164,13 +5169,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { "isabove", "isbelow", NULL }; enum options { OPT_ISABOVE, OPT_ISBELOW }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -5183,9 +5189,13 @@ WmStackorderCmd( if (windows == NULL) { Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } + Tcl_SetObjResult(interp, resultObj); ckfree(windows); return TCL_OK; } else { @@ -5232,12 +5242,12 @@ WmStackorderCmd( return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = (windowPtr - windows); } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = (windowPtr - windows); } } if (index1 == -1) { @@ -6676,7 +6686,7 @@ TkWmStackorderToplevelEnumProc( fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd, childWinPtr, childWinPtr->pathName); */ - *(pair->window_ptr)-- = childWinPtr; + *(pair->windowPtr)-- = childWinPtr; } return TRUE; } @@ -6786,14 +6796,14 @@ TkWmStackorderToplevel( */ pair.table = &table; - pair.window_ptr = windows + table.numEntries; - *pair.window_ptr-- = NULL; + pair.windowPtr = windows + table.numEntries; + *pair.windowPtr-- = NULL; if (EnumWindows((WNDENUMPROC) TkWmStackorderToplevelEnumProc, (LPARAM) &pair) == 0) { ckfree(windows); windows = NULL; - } else if (pair.window_ptr != (windows-1)) { + } else if (pair.windowPtr != (windows-1)) { Tcl_Panic("num matched toplevel windows does not equal num children"); } -- cgit v0.12