summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--carbon/tkMacOSXWm.c55
-rw-r--r--generic/tkBind.c100
-rw-r--r--generic/tkCanvas.c65
-rw-r--r--generic/tkFont.c155
-rw-r--r--generic/tkGrid.c70
-rw-r--r--generic/tkImgBmap.c155
-rw-r--r--generic/tkImgPhoto.c175
-rw-r--r--generic/tkInt.h2
-rw-r--r--generic/tkPack.c59
-rw-r--r--generic/tkPlace.c52
-rw-r--r--generic/tkRectOval.c70
-rw-r--r--generic/tkText.c51
-rw-r--r--generic/tkTextImage.c8
-rw-r--r--generic/tkTextMark.c18
-rw-r--r--generic/tkTextTag.c23
-rw-r--r--generic/tkTextWind.c8
-rw-r--r--generic/tkTrig.c34
-rw-r--r--generic/tkUtil.c57
-rw-r--r--generic/tkVisual.c12
-rw-r--r--macosx/tkMacOSXWm.c57
-rw-r--r--tests/grid.test611
-rw-r--r--unix/tkUnixSend.c5
-rw-r--r--win/tkWinWm.c48
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; j<chunkPtr->numDisplayChars; j++) {
+ /*
+ * INTL: We only handle symbols that have an encoding as a glyph
+ * from the standard set defined by Adobe. The rest get punted.
+ * Eventually this should be revised to handle more sophsticiated
+ * international postscript fonts.
+ */
+
+ p += Tcl_UtfToUniChar(p, &ch);
+ if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) {
/*
- * INTL: We only handle symbols that have an encoding as a
- * flyph from the standard set defined by Adobe. The rest get
- * punted. Eventually this should be revised to handle more
- * sophsticiated international postscript fonts.
+ * Tricky point: the "03" is necessary in the sprintf below,
+ * so that a full three digits of octal are always generated.
+ * Without the "03", a number following this sequence could be
+ * interpreted by Postscript as part of this sequence.
*/
- charsize = Tcl_UtfToUniChar(p, &ch);
- p += charsize;
-
- if ((ch == '(') || (ch == ')') || (ch == '\\')
- || (ch < 0x20)) {
- /*
- * Tricky point: the "03" is necessary in the sprintf
- * below, so that a full three digits of octal are always
- * generated. Without the "03", a number following this
- * sequence could be interpreted by Postscript as part of
- * this sequence.
- */
+ Tcl_AppendPrintfToObj(psObj, "\\%03o", ch);
+ continue;
+ } else if (ch <= 0x7f) {
+ /*
+ * Normal ASCII character.
+ */
- sprintf(buf + used, "\\%03o", ch);
- used += 4;
- } else if (ch <= 0x7f) {
- /*
- * Normal ASCII character.
- */
+ c = (char) ch;
+ Tcl_AppendToObj(psObj, &c, 1);
+ continue;
+ }
- buf[used++] = (char) ch;
- } else {
- char uindex[5];
+ /*
+ * This character doesn't belong to the ASCII character set, so we
+ * use the full glyph name.
+ */
+ sprintf(uindex, "%04X", ch); /* endianness? */
+ glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0);
+ if (glyphname) {
+ ps = Tcl_GetStringFromObj(psObj, &len);
+ if (ps[len-1] == '(') {
/*
- * This character doesn't belong to the ASCII character
- * set, so we use the full glyph name.
+ * In-place edit. Ewww!
*/
- sprintf(uindex, "%04X", ch); /* endianness? */
- glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex,
- 0);
- if (glyphname) {
- if (used > 0 && buf[used-1] == '(') {
- used--;
- } else {
- buf[used++] = ')';
- }
- buf[used++] = '/';
- while ((*glyphname) && (used < MAXUSE+27)) {
- buf[used++] = *glyphname++;
- }
- buf[used++] = '(';
- } else {
- /*
- * No known mapping for the character into the space
- * of PostScript glyphs. Ignore it. :-(
- */
+ ps[len-1] = '/';
+ } else {
+ Tcl_AppendToObj(psObj, ")/", -1);
+ }
+ Tcl_AppendToObj(psObj, glyphname, -1);
+ Tcl_AppendToObj(psObj, "(", -1);
+ } else {
+ /*
+ * No known mapping for the character into the space of
+ * PostScript glyphs. Ignore it. :-(
+ */
#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT
- fprintf(stderr, "Warning: no mapping to PostScript "
- "glyphs for \\u%04x\n", ch);
+ fprintf(stderr, "Warning: no mapping to PostScript "
+ "glyphs for \\u%04x\n", ch);
#endif
- }
- }
- if (used >= MAXUSE) {
- buf[used] = '\0';
- Tcl_AppendResult(interp, buf, NULL);
- used = 0;
- }
}
}
- if (used >= MAXUSE) {
- /*
- * If there are a whole bunch of returns or tabs in a row, then
- * buf[] could get filled up.
- */
-
- buf[used] = '\0';
- Tcl_AppendResult(interp, buf, NULL);
- used = 0;
- }
- chunkPtr++;
}
- buf[used++] = ')';
- buf[used++] = ']';
- buf[used++] = '\n';
- buf[used] = '\0';
- Tcl_AppendResult(interp, buf, NULL);
+ Tcl_AppendToObj(psObj, ")]\n", -1);
+ Tcl_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<height; i++){
- for(j=0; j<nBytePerRow; j++){
- sprintf(buffer, " %02x",
+ nBytePerRow = (width + 7) / 8;
+ for (i=0; i<height; i++) {
+ for (j=0; j<nBytePerRow; j++) {
+ Tcl_AppendPrintfToObj(psObj, " %02x",
bit_reverse[0xff & data[i*nBytePerRow + j]]);
- Tcl_AppendResult(interp, buffer, NULL);
}
- Tcl_AppendResult(interp, "\n", NULL);
+ Tcl_AppendToObj(psObj, "\n", -1);
}
- Tcl_AppendResult(interp, ">} imagemask \n", NULL);
- return TCL_OK;
+ Tcl_AppendToObj(psObj, ">} imagemask \n", -1);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -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, ", <index>", NULL);
+ Tcl_AppendToObj(msgObj, ", <index>", -1);
}
- Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL);
+ Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1);
+ Tcl_SetObjResult(interp, msgObj);
Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL);
return TCL_ERROR;
}
@@ -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");
}
generated by cgit v0.12 at 2024-11-08 15:51:53 (GMT)