Tk Source Code

    } else if (!NameToWindow(interp, mainWin, objv[0], &tkwin)) {
	return TCL_ERROR;
    }

    mainPtr = (TkWindow *) mainWin;
    if (!tkwin || mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"window id \"%s\" does not exist in this application",
		Tcl_GetString(objv[0])));
	Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", Tcl_GetString(objv[0]), (char *)NULL);
	return TCL_ERROR;
    }

    name = Tcl_GetString(objv[1]);
    p = name;

		badOpt = 1;
	    }
	    break;
	}

    	if (badOpt) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s event does not accept \"%s\" option", name, Tcl_GetString(optionPtr)));
	    Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", (char *)NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Don't generate events for windows that don't exist yet.

    if (*string == '@') {	/* INTL: ISO char */
	Tcl_DString buffer;
	int result;

	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot specify bitmap with '@' in a safe interpreter",
		    TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", (char *)NULL);
	    goto error;
	}

	/*
	 * Note that we need to cast away the const from the string because

    tkwin = Tk_MainWindow(interp);
    if (!tkwin || (TkGetWindowFromObj(interp, tkwin, windowObj, &tkwin) != TCL_OK)) {
	return NULL;
    }
    hPtr = Tcl_FindHashEntry(busyTablePtr, tkwin);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find busy window \"%s\"", Tcl_GetString(windowObj)));
	Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BUSY",
		Tcl_GetString(windowObj), (char *)NULL);
	return NULL;
    }
    return (Busy *)Tcl_GetHashValue(hPtr);
}


    if (fgColor != NULL) {
	Tcl_ResetResult(interp);
	Tk_CanvasPsColor(interp, canvas, fgColor);
	Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));

	if (width > 60000) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot generate Postscript for bitmaps more than 60000"
		    " pixels wide", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", (char *)NULL);
	    goto error;
	}

	rowsAtOnce = 60000/width;
	if (rowsAtOnce < 1) {

    if (psInfo.fileName != NULL) {
	/*
	 * Check that -file and -channel are not both specified.
	 */

	if (psInfo.channelName != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot specify both -file and -channel", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", (char *)NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}

	/*
	 * Check that we are not in a safe interpreter. If we are, disallow
	 * the -file specification.
	 */

	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot specify -file in a safe interpreter", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "PS_FILE", (char *)NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}

	p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
	if (p == NULL) {

    case 1: bytesPerLine = width;	     maxWidth = 60000;  break;
    default: bytesPerLine = 3 * width;	     maxWidth = 20000;  break;
    }

    if (bytesPerLine > 60000) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot generate Postscript for images more than %d pixels wide",
		maxWidth));
	Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", (char *)NULL);
	ckfree(cdata.colors);
	return TCL_ERROR;
    }

    maxRows = 60000 / bytesPerLine;

    case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
    case 1: bytesPerLine = width;	    maxWidth = 60000;  break;
    default: bytesPerLine = 3 * width;	    maxWidth = 20000;  break;
    }
    if (bytesPerLine > 60000) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot generate Postscript for images more than %d pixels wide",
		maxWidth));
	Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Set up the postscript code except for the image-data stream.

    }

    ComputeWindowBbox(canvas, winItemPtr);
    return TCL_OK;

  badWindow:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot use %s in a window item of this canvas",
	    Tk_PathName(winItemPtr->tkwin)));
    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", (char *)NULL);
    winItemPtr->tkwin = NULL;
    return TCL_ERROR;
}

/*

	    if (entryPtr != NULL) {
		itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
		object = itemPtr;
	    }

	    if (object == 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"item \"%s\" does not exist", Tcl_GetString(objv[2])));
		Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM",
			Tcl_GetString(objv[2]), (char *)NULL);
		result = TCL_ERROR;
		goto done;
	    }
	} else {
	    object = (char *)searchPtr->expr->uid;

	FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) {
	    if (itemPtr->typePtr->indexProc != NULL) {
		break;
	    }
	}
	if (itemPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot find an indexable item \"%s\"",
		    Tcl_GetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TK", "CANVAS", "INDEXABLE_ITEM", (char *)NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	result = ItemIndex(canvasPtr, itemPtr, objv[3], &index);
	if (result != TCL_OK) {

		if ((itemPtr->typePtr->indexProc != NULL)
			&& (itemPtr->typePtr->selectionProc != NULL)){
		    break;
		}
	    }
	    if (itemPtr == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot find an indexable and selectable item \"%s\"",
			Tcl_GetString(objv[3])));
		Tcl_SetErrorCode(interp, "TK", "CANVAS", "SELECTABLE_ITEM",
			(char *)NULL);
		result = TCL_ERROR;
		goto done;
	    }
	}

	if (objc > first+3) {
	    if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
		    objv[first+3], &halo) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (halo < 0.0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot have negative halo value \"%f\"", halo));
		return TCL_ERROR;
	    }
	} else {
	    halo = 0.0;
	}

	/*

	if (other == NULL) {
	    return TCL_ERROR;
	}
    }
    if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
	if (other) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot lower \"%s\" below \"%s\"",
		    Tcl_GetString(objv[1]), Tcl_GetString(objv[2])));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot lower \"%s\" to bottom", Tcl_GetString(objv[1])));
	}
	Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", (char *)NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


	if (other == NULL) {
	    return TCL_ERROR;
	}
    }
    if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
	if (other) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot raise \"%s\" above \"%s\"",
		    Tcl_GetString(objv[1]), Tcl_GetString(objv[2])));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot raise \"%s\" to top", Tcl_GetString(objv[1])));
	}
	Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", (char *)NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


	if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
	    return TCL_ERROR;
	}
	winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id);
	if ((winPtr == NULL) ||
		(winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "window id \"%s\" does not exist in this application",
		    string));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * If the window is a utility window with no associated path (such as

	}

	templ.screen = Tk_ScreenNumber(tkwin);
	visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
		&templ, &count);
	if (visInfoPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot find any visuals for screen", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", (char *)NULL);
	    return TCL_ERROR;
	}
	resultPtr = Tcl_NewObj();
	for (i = 0; i < count; i++) {
	    string = TkFindStateString(visualMap, visInfoPtr[i].c_class);
	    if (string == NULL) {

TkDeadAppObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int),		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot invoke \"%s\" command: application has been destroyed",
	    Tcl_GetString(objv[0])));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

    	namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
	nfPtr = NULL;
    	if (namedHashPtr != NULL) {
    	    nfPtr = (NamedFont *)Tcl_GetHashValue(namedHashPtr);
    	}
    	if ((namedHashPtr == NULL) || nfPtr->deletePending) {
    	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    		    "named font \"%s\" does not exist", string));
    	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL);
    	    return TCL_ERROR;
    	}
    	if (objc == 3) {
    	    objPtr = NULL;
    	} else if (objc == 4) {
    	    objPtr = objv[3];

    NamedFont *nfPtr;
    Tcl_HashEntry *namedHashPtr;

    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name);
    if (namedHashPtr == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "named font \"%s\" does not exist", name));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL);
	}
	return TCL_ERROR;
    }
    nfPtr = (NamedFont *)Tcl_GetHashValue(namedHashPtr);
    if (nfPtr->refCount != 0) {
	nfPtr->deletePending = 1;

     * list.
     */

    if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
	    || (objc < 1)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "font \"%s\" does not exist", string));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL);
	}
	return TCL_ERROR;
    }

    faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
    if (objc > 1) {

			    result = TCL_ERROR;
			    goto done;
			}
			continue;
		    }
#endif
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "cannot modify %s option after widget is created",
			    arg));
		    Tcl_SetErrorCode(interp, "TK", "FRAME", "CREATE_ONLY",
			    NULL);
		    result = TCL_ERROR;
		    goto done;
		}
	    }

    }

    FrameWorldChanged(framePtr);
    return TCL_OK;

  badLabelWindow:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot use %s as label in this frame",
	    Tk_PathName(labelframePtr->labelWin)));
    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
    labelframePtr->labelWin = NULL;
    return TCL_ERROR;
}

/*

	if (TkGetWindowFromObj(interp, tkwin, objv[j], &content) != TCL_OK) {
	    return TCL_ERROR;
	}

	if (Tk_TopWinHierarchy(content)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot manage \"%s\": it's a top-level window",
		    Tcl_GetString(objv[j])));
	    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
	    return TCL_ERROR;
	}
	contentPtr = GetGrid(content);

	/*

	    case CONF_IN:
		if (TkGetWindowFromObj(interp, tkwin, objv[i+1],
			&other) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (other == content) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "window cannot be managed in itself", TCL_INDEX_NONE));
		    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL);
		    return TCL_ERROR;
		}
		positionGiven = 1;
		containerPtr = GetGrid(other);
		InitContainerData(containerPtr);
		break;

	for (ancestor = containerPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
	    if (ancestor == parent) {
		break;
	    }
	    if (Tk_TopWinHierarchy(ancestor)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot put \"%s\" inside \"%s\"", Tcl_GetString(objv[j]),
			Tk_PathName(containerPtr->tkwin)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
		Unlink(contentPtr);
		return TCL_ERROR;
	    }
	}

	/*
	 * Check for management loops.
	 */

	for (container = (TkWindow *)containerPtr->tkwin; container != NULL;
	     container = (TkWindow *)TkGetContainer(container)) {
	    if (container == (TkWindow *)content) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot put \"%s\" inside \"%s\": would cause management loop",
	            Tcl_GetString(objv[j]), Tk_PathName(containerPtr->tkwin)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL);
		Unlink(contentPtr);
		return TCL_ERROR;
	    }
	}
	if (containerPtr->tkwin != Tk_Parent(content)) {

	}
	if (firstChar != REL_VERT) {
	    continue;
	}

	if (containerPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot use '^', cannot find container window", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Count the number of consecutive ^'s starting from this position.
	 */

		    numSkip = 0;
		    break;
		}
	    }
	}
	if (!match) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot find content to extend with \"^\"", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
	    return TCL_ERROR;
	}
    }

    if (containerPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot determine container window", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL);
	return TCL_ERROR;
    }
    SetGridSize(containerPtr);

    /*
     * If we have emptied this container from content it means we are no longer

			&& (strcmp(arg, typePtr->name) == 0)) {
		    break;
		}
	    }
	}
	if (typePtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "image type \"%s\" does not exist", arg));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", arg, (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * Figure out a name to use for the new image.
	 */

			Tcl_NewStringObj(modelPtr->typePtr->name, TCL_INDEX_NONE));
	    }
	    break;
	case IMAGE_WIDTH:
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(modelPtr->width));
	    break;
	default:
	    Tcl_Panic("cannot happen");
	}
	break;
    }
    return TCL_OK;

  alreadyDeleted:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" does not exist",arg));
    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", arg, (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

    imagePtr->prevPtr = NULL;
    modelPtr->instancePtr = imagePtr;
    return (Tk_Image) imagePtr;

  noSuchImage:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"image \"%s\" does not exist", name));
	Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", name, (char *)NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------

	ckfree(modelPtr->maskData);
	modelPtr->maskData = NULL;
    }
    if ((modelPtr->maskFileString != NULL)
	    || (modelPtr->maskDataString != NULL)) {
	if (modelPtr->data == NULL) {
	    Tcl_SetObjResult(modelPtr->interp, Tcl_NewStringObj(
		    "cannot have mask without bitmap", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(modelPtr->interp, "TK", "IMAGE", "BITMAP",
		    "NO_BITMAP", NULL);
	    return TCL_ERROR;
	}
	modelPtr->maskData = TkGetBitmapData(modelPtr->interp,
		modelPtr->maskDataString, modelPtr->maskFileString,
		&maskWidth, &maskHeight, &dummy1, &dummy2);

    char *data = NULL;
    Tcl_DString buffer;

    pi.string = string;
    if (string == NULL) {
	if ((interp != NULL) && Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot get bitmap data from a file in a safe interpreter",
		    -1));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL);
	    return NULL;
	}
	expandedFileName = Tcl_TranslateFileName(NULL, fileName, &buffer);
	if (expandedFileName == NULL) {
	    Tcl_SetErrno(ENOENT);

	 * Look for the source image and get a pointer to its image data.
	 * Check the values given for the -from option.
	 */

	srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name));
	if (srcHandle == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "image \"%s\" does not exist or is not a photo image",
		    Tcl_GetString(options.name)));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO",
		    Tcl_GetString(options.name), (char *)NULL);
	    return TCL_ERROR;
	}
	Tk_PhotoGetImage(srcHandle, &block);
	if ((options.fromX > block.width) || (options.fromY > block.height)

	/*
	 * Prevent file system access in safe interpreters.
	 */

	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot get image from a file in a safe interpreter", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * Open the image file and look for a handler for it.
	 */

	/*
	 * Prevent file system access in safe interpreters.
	 */

	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot write image to a file in a safe interpreter", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * photo write command - first parse and check any options given.
	 */

	/*
	 * Prevent file system access in a safe interpreter.
	 */

	if (Tcl_IsSafe(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot get image from a file in a safe interpreter",
		    -1));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", (char *)NULL);
	    goto errorExit;
	}

	chan = Tcl_OpenFileChannel(interp, modelPtr->fileString, "r", 0);
	if (chan == NULL) {

    /*
     * Prevent file system access in a safe interpreter.
     */

    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot read options from a file in a safe interpreter", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TK", "SAFE", "OPTION_FILE", (char *)NULL);
	return TCL_ERROR;
    }

    realName = Tcl_TranslateFileName(interp, fileName, &newName);
    if (realName == NULL) {
	return TCL_ERROR;

    positionGiven = 0;
    for (j = 0; j < numWindows; j++) {
	if (TkGetWindowFromObj(interp, tkwin, objv[j], &content) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tk_TopWinHierarchy(content)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot pack \"%s\": it's a top-level window",
		    Tcl_GetString(objv[j])));
	    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
	    return TCL_ERROR;
	}
	contentPtr = GetPacker(content);
	contentPtr->flags &= ~OLD_STYLE;

	parent = Tk_Parent(content);
	for (ancestor = containerPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
	    if (ancestor == parent) {
		break;
	    }
	    if (Tk_TopWinHierarchy(ancestor)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot pack \"%s\" inside \"%s\"", Tcl_GetString(objv[j]),
			Tk_PathName(containerPtr->tkwin)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
		return TCL_ERROR;
	    }
	}
	if (content == containerPtr->tkwin) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot pack \"%s\" inside itself", Tcl_GetString(objv[j])));
	    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Check for management loops.
	 */

	for (container = (TkWindow *)containerPtr->tkwin; container != NULL;
	     container = (TkWindow *)TkGetContainer(container)) {
	    if (container == (TkWindow *)content) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot put \"%s\" inside \"%s\": would cause management loop",
			Tcl_GetString(objv[j]), Tk_PathName(containerPtr->tkwin)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL);
		return TCL_ERROR;
	    }
	}
	if (containerPtr->tkwin != Tk_Parent(content)) {
	    ((TkWindow *)content)->maintainerPtr = (TkWindow *)containerPtr->tkwin;

		return TCL_ERROR;
	    } else if (tkwin == pwPtr->tkwin) {
		/*
		 * A panedwindow cannot manage itself.
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot add %s to itself", arg));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", (char *)NULL);
		return TCL_ERROR;
	    } else if (Tk_IsTopLevel(tkwin)) {
		/*
		 * A panedwindow cannot manage a toplevel.
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot add toplevel %s to %s", arg,
			Tk_PathName(pwPtr->tkwin)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", (char *)NULL);
		return TCL_ERROR;
	    } else {
		/*
		 * Make sure the panedwindow is the parent of the pane,
		 * or a descendant of the pane's parent.
		 */

		parent = Tk_Parent(tkwin);
		for (ancestor = pwPtr->tkwin;;ancestor = Tk_Parent(ancestor)) {
		    if (ancestor == parent) {
			break;
		    }
		    if (Tk_IsTopLevel(ancestor)) {
			Tcl_SetObjResult(interp, Tcl_ObjPrintf(
				"cannot add %s to %s", arg,
				Tk_PathName(pwPtr->tkwin)));
			Tcl_SetErrorCode(interp, "TK", "GEOMETRY",
				"HIERARCHY", (char *)NULL);
			return TCL_ERROR;
		    }
		}
	    }

    int mask;
    Content *contentPtr;
    Tk_Window containerWin = NULL;
    TkWindow *container;

    if (Tk_TopWinHierarchy(tkwin)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot use placer on top-level window \"%s\"; use "
		"wm command instead", Tk_PathName(tkwin)));
	Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", (char *)NULL);
	return TCL_ERROR;
    }

    contentPtr = CreateContent(tkwin, table);

	for (ancestor = win; ; ancestor = Tk_Parent(ancestor)) {
	    if (ancestor == Tk_Parent(contentPtr->tkwin)) {
		break;
	    }
	    if (Tk_TopWinHierarchy(ancestor)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot place \"%s\" relative to \"%s\"",
			Tk_PathName(contentPtr->tkwin), Tk_PathName(win)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", (char *)NULL);
		goto error;
	    }
	}
	if (contentPtr->tkwin == win) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot place \"%s\" relative to itself",
		    Tk_PathName(contentPtr->tkwin)));
	    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", (char *)NULL);
	    goto error;
	}

	/*
	 * Check for management loops.
	 */

	for (container = (TkWindow *)win; container != NULL;
	     container = (TkWindow *)TkGetContainer(container)) {
	    if (container == (TkWindow *)contentPtr->tkwin) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot put \"%s\" inside \"%s\": would cause management loop",
			Tk_PathName(contentPtr->tkwin), Tk_PathName(win)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", (char *)NULL);
		goto error;
	    }
	}
	if (win != Tk_Parent(contentPtr->tkwin)) {
	    ((TkWindow *)contentPtr->tkwin)->maintainerPtr = (TkWindow *)win;

	return NULL;
    }
    resultStr = NULL;
    valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,
	    TCL_GLOBAL_ONLY);
    result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);
    if (result != TCL_OK) {
	resultStr = "cannot assign non-numeric value to scale variable";
	ScaleSetVariable(scalePtr);
    } else {
	scalePtr->value = TkRoundValueToResolution(scalePtr, value);

	/*
	 * This code is a bit tricky because it sets the scale's value before
	 * calling TkScaleSetValue. This way, TkScaleSetValue won't bother to

     */

    return TkSelGetSelection(interp, tkwin, selection, target, proc,
	    clientData);

  cantget:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s selection does not exist or form \"%s\" not defined",
	    Tk_GetAtomName(tkwin, selection),
	    Tk_GetAtomName(tkwin, target)));
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------

	if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) {
	    if (tagPtr == textPtr->selTagPtr) {
		tagName = "sel";
	    } else if (hPtr != NULL) {
		tagName = (const char *)Tcl_GetHashKey(&sharedPtr->tagTable, hPtr);
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "text does not contain any characters tagged with \"%s\"",
		    tagName));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_INDEX", tagName,
		    (char *)NULL);
	    Tcl_DStringFree(&copy);
	    return TCL_ERROR;
	}
	*indexPtr = search.curIndex;

	    for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
		if (ancestor == parent) {
		    break;
		}
		if (Tk_TopWinHierarchy(ancestor)) {
		badContainer:
		    Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf(
			    "cannot embed %s in %s",
			    Tk_PathName(ewPtr->body.ew.tkwin),
			    Tk_PathName(textPtr->tkwin)));
		    Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY",
			    "HIERARCHY", (char *)NULL);
		    ewPtr->body.ew.tkwin = NULL;
		    if (client != NULL) {
			client->tkwin = NULL;

		goto badContainer;
	    }
	}
	if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin)
		|| (textPtr->tkwin == ewPtr->body.ew.tkwin)) {
	badContainer:
	    Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf(
		    "cannot embed %s relative to %s",
		    Tk_PathName(ewPtr->body.ew.tkwin),
		    Tk_PathName(textPtr->tkwin)));
	    Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", "HIERARCHY",
		    (char *)NULL);
	    Tcl_BackgroundException(textPtr->interp, TCL_ERROR);
	    ewPtr->body.ew.tkwin = NULL;
	    goto gotWindow;

    other = Tk_NameToWindow(interp, string, tkwin);
    if (other == NULL) {
	return None;
    }
    if (Tk_Screen(other) != Tk_Screen(tkwin)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot use colormap for %s: not on same screen", string));
	Tcl_SetErrorCode(interp, "TK", "COLORMAP", "SCREEN", (char *)NULL);
	return None;
    }
    if (Tk_Visual(other) != Tk_Visual(tkwin)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot use colormap for %s: incompatible visuals", string));
	Tcl_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", (char *)NULL);
	return None;
    }
    colormap = Tk_Colormap(other);

    /*
     * If the colormap was a special one allocated by code in this file,

				 * window. */
{
    TkWindow *parentPtr = (TkWindow *) parent;

    if (parentPtr) {
	if (parentPtr->flags & TK_ALREADY_DEAD) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot create window: parent has been destroyed", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", (char *)NULL);
	    return NULL;
	} else if (parentPtr->flags & TK_CONTAINER) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot create window: its parent has -container = yes",
		    TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", (char *)NULL);
	    return NULL;
	} else if (screenName == NULL) {
	    TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
		    parentPtr->screenNum, parentPtr);

				 * window. */
{
    TkWindow *parentPtr = (TkWindow *) parent;

    if (parentPtr) {
	if (parentPtr->flags & TK_ALREADY_DEAD) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot create window: parent has been destroyed", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", (char *)NULL);
	    return NULL;
	} else if (parentPtr->flags & TK_CONTAINER) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot create window: its parent has -container = yes",
		    TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", (char *)NULL);
	    return NULL;
	} else if (screenName == NULL) {
	    TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
		    parentPtr->screenNum, parentPtr);
	    /*

	ckfree(p);
    }
    if (parent == NULL) {
	return NULL;
    }
    if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot create window: parent has been destroyed", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", (char *)NULL);
	return NULL;
    } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot create window: its parent has -container = yes", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", (char *)NULL);
	return NULL;
    }

    /*
     * Create the window.
     */

	}
	ancestor = Tk_Parent(ancestor);
    }

    return 1;

badWindow:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("cannot add %s as content of %s",
	    Tk_PathName(window), Tk_PathName(container)));
    Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL);
    return 0;
}

    const char *name)		/* theme name */
{
    Tcl_HashEntry *entryPtr;

    entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name);
    if (!entryPtr) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"theme \"%s\" does not exist", name));
	Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "THEME", name, NULL);
	return NULL;
    }

    return (Ttk_Theme)Tcl_GetHashValue(entryPtr);
}

    }
}
if {"x11" eq [tk windowingsystem]} {
    bind Checkbutton <Return> {
	if {!$tk_strictMotif} {
	    tk::CheckInvoke %W
	}
    }
    bind Checkbutton <KP_Enter> {
	if {!$tk_strictMotif} {
	    tk::CheckInvoke %W
	}
    }
    bind Radiobutton <Return> {
	if {!$tk_strictMotif} {
	    tk::CheckRadioInvoke %W
	}
    }
    bind Radiobutton <KP_Enter> {
	if {!$tk_strictMotif} {
	    tk::CheckRadioInvoke %W
	}
    }
    bind Checkbutton <Button-1> {
	tk::CheckInvoke %W
    }
    bind Radiobutton <Button-1> {
	tk::CheckRadioInvoke %W
    }

	bind $data($color,sel) <Enter> \
		[list tk::dialog::color::EnterColorBar $w $color]
	bind $data($color,sel) <Leave> \
		[list tk::dialog::color::LeaveColorBar $w $color]

	bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w]
	bind $box.entry <KP_Enter> [list tk::dialog::color::HandleRGBEntry $w]
    }

    pack $stripsFrame -side left -fill both -padx 3p -pady 7.5p

    # The selFrame contains a frame that demonstrates the currently
    # selected color
    #

	    -state disabled
    button .buttons.quit   -default normal -command quit   -text "Quit"

    pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
	    -side left -expand yes -pady 3p

    bind . <Return> {.buttons.ok   flash; .buttons.ok   invoke}
    bind . <KP_Enter> {.buttons.ok   flash; .buttons.ok   invoke}
    bind . <Escape> {.buttons.quit flash; .buttons.quit invoke}
    bind . <Button-1> {
	if {![string match .buttons* %W]} {
	    .buttons.apply  configure -state normal
	    .buttons.cancel configure -state normal
	}
    }

    }

    grid rowconfigure $dlg 0 -weight 1
    grid columnconfigure $dlg 0 -weight 1

    bind $dlg <Control-F2> {console show}
    bind $dlg <Return> [list $dlg.tf.b1 invoke]
    bind $dlg <KP_Enter> [list $dlg.tf.b1 invoke]
    bind $dlg <Escape> [list $dlg.tf.b2 invoke]
    bind $dlg <Destroy> [namespace code [list Stop]]
    wm protocol $dlg WM_DELETE_WINDOW [namespace code [list Exit $dlg]]

    wm deiconify $dlg
    tkwait window $dlg
}

set w .label
catch {destroy $w}
toplevel $w
wm title $w "Label Demonstration"
wm iconname $w "label"
positionWindow $w

label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and an image label and a text label on the right.  Labels are pretty boring because you cannot do anything with them."
pack $w.msg -side top

## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x

frame $w.left

# Create a binding to forward commands to the target application,
# plus modify many of the built-in bindings so that only information
# in the current command can be deleted (can still set the cursor
# earlier in the text and select and insert;  just can't delete).

bindtags .t {.t Text . all}
bind .t <Return> {
    .t mark set insert {end - 1c}
    .t insert insert \n
    invoke
    break
}
bind .t <KP_Enter> {
    .t mark set insert {end - 1c}
    .t insert insert \n
    invoke
    break
}
bind .t <Delete> {
    catch {.t tag remove sel sel.first promptEnd}

}
grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c

labelframe .name -text "Name:" -padx 1m -pady 1m
entry .name.e -textvariable name -width 10
pack .name.e -side right -expand 1 -fill x
bind .name.e <Return> {tc_loadNamedColor $name}
bind .name.e <KP_Enter> {tc_loadNamedColor $name}
grid .name   -column 1 -row 1 -sticky nsew -padx .15c -pady .15c

# Create the color display swatch on the right side of the window.

labelframe .sample -text "Color:" -padx 1m -pady 1m
frame .sample.swatch -width 2c -height 5c -background $color
label .sample.value -textvariable color -width 13 -font {Courier 12}

    # 4. Create a binding for <Return> on the dialog if there is a
    # default button.
    # Convention also dictates that if the keyboard focus moves among the
    # the buttons that the <Return> binding affects the button with the focus.

    if {$default >= 0} {
	bind $w <Return> [list $w.button$default invoke]
	bind $w <KP_Enter> [list $w.button$default invoke]
    }
    bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}]
    bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}]

    # 5. Create a <Destroy> binding for the window that sets the
    # button variable to -1;  this is needed in case something happens
    # that destroys the window, such as its parent window being destroyed.

        set min [expr {$minsize(gap) * 4}]
        foreach {what width} [array get minsize] {
            incr min $width
        }
        wm minsize $S(W) $min [::tk::ScaleNum 260]

        bind $S(W) <Return> [namespace code [list Done 1]]
	bind $S(W) <KP_Enter> [namespace code [list Done 1]]
        bind $S(W) <Escape> [namespace code [list Done 0]]
        bind $S(W) <Map> [namespace code [list Visibility %W 1]]
        bind $S(W) <Unmap> [namespace code [list Visibility %W 0]]
        bind $S(W) <Destroy> [namespace code [list Visibility %W 0]]
        bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]]
        bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]]
        bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]]

	}

	if {![info exists ::tk::icons::base_icon($win)]} {
	    return -code error "::tk::icons::base_icon($win) must be set on X11"
	}

	if {[lsearch -exact [image names] $::tk::icons::base_icon($win)] <= 0} {
	    return -code error "cannot use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image"
	}

	if {!([string is integer $badgenumber] && $badgenumber > 0)
	        && [string match $badgenumber "!"] == 0
	        && $badgenumber ne ""} {
	    return -code error "cannot use \"$badgenumber\" as icon badge"
	}

	wm iconphoto $win $::tk::icons::base_icon($win)

	if {$badgenumber eq ""} {
	    return
	}

	bind $canvas <<PrevLine>>	[namespace code {my UpDown -1}]
	bind $canvas <<NextLine>>	[namespace code {my UpDown  1}]
	bind $canvas <<PrevChar>>	[namespace code {my LeftRight -1}]
	bind $canvas <<NextChar>>	[namespace code {my LeftRight  1}]
	bind $canvas <Return>		[namespace code {my ReturnKey}]
	bind $canvas <KP_Enter>		[namespace code {my ReturnKey}]
	bind $canvas <Key>		[namespace code {my KeyPress %A}]
	bind $canvas <Alt-Key>		{# nothing}
	bind $canvas <Meta-Key> 	{# nothing}
	bind $canvas <Control-Key> 	{# nothing}
	bind $canvas <Command-Key> 	{# nothing}
	bind $canvas <Fn-Key>		{# nothing}

}
bind Menu <<Invoke>> {
    tk::MenuInvoke %W 0
}
bind Menu <Return> {
    tk::MenuInvoke %W 0
}
bind Menu <KP_Enter> {
    tk::MenuInvoke %W 0
}
bind Menu <Escape> {
    tk::MenuEscape %W
}
bind Menu <<PrevChar>> {
    tk::MenuLeftArrow %W
}
bind Menu <<NextChar>> {

    if {$menu eq ""} {
	return
    }
    set tearoff [expr {[tk windowingsystem] eq "x11" \
	    || [$menu cget -type] eq "tearoff"}]
    if {[string first $w $menu] != 0} {
	return -code error -errorcode {TK MENUBUTTON POST_NONCHILD} \
	    "cannot post $menu: it isn't a descendant of $w"
    }
    set cur $Priv(postedMb)
    if {$cur ne ""} {
	MenuUnpost {}
    }
    if {$::tk_strictMotif} {
	set Priv(cursor) [$w cget -cursor]

    # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog

    bind $w <Return> {
	if {[winfo class %W] in "Button TButton"} {
	    %W invoke
	}
    }
    bind $w <KP_Enter> {
	if {[winfo class %W] in "Button TButton"} {
	    %W invoke
	}
    }

    # Invoke the designated cancelling operation
    bind $w <Escape> [list $w.$cancel invoke]

    # At <Destroy> the buttons have vanished, so must do this directly.
    bind $w.msg <Destroy> [list set tk::Priv.${disp}(button) $cancel]

    tk::TextInsert %W \t
}
bind Text <Return> {
    tk::TextInsert %W \n
    if {[%W cget -autoseparators]} {
	%W edit separator
    }
}
bind Text <KP_Enter> {
    tk::TextInsert %W \n
    if {[%W cget -autoseparators]} {
	%W edit separator
    }
}
bind Text <Delete> {
    if {[tk::TextCursorInSelection %W]} {
	%W delete sel.first sel.last
    } else {
	if {[%W compare end != insert+1c]} {
	    %W delete [tk::TextPrevPos %W insert+1c tk::startOfCluster] \

# <Key> class binding will also fire and insert the character,
# which is wrong.  Ditto for <Escape>.

bind Text <Alt-Key> {# nothing }
bind Text <Meta-Key> {# nothing}
bind Text <Control-Key> {# nothing}
bind Text <Escape> {# nothing}

bind Text <Command-Key> {# nothing}
bind Text <Fn-Key> {# nothing}

# Additional emacs-like bindings:

bind Text <Control-d> {
    if {!$tk_strictMotif && [%W compare end != insert+1c]} {

    bind $w <Escape> [list $data(cancelBtn) invoke]
    bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]

    # Set up event handlers specific to File or Directory Dialogs
    #
    if {$class eq "TkFDialog"} {
	bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
	bind $data(ent) <KP_Enter> [list ::tk::dialog::file::ActivateEnt $w]
	$data(okBtn)     configure -command [list ::tk::dialog::file::OkCmd $w]
	bind $w <Alt-t> [format {
	    if {[%s cget -state] eq "normal"} {
		focus %s
	    }
	} $data(typeMenuBtn) $data(typeMenuBtn)]
    } else {
	set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
	bind $data(ent) <Return> $okCmd
	bind $data(ent) <KP_Enter> $okCmd
		$data(okBtn) configure -command $okCmd
	bind $w <Alt-s> [list focus $data(ent)]
	bind $w <Alt-o> [list $data(okBtn) invoke]
    }
    bind $w <Alt-h> [list $data(hiddenBtn) invoke]
    bind $data(ent) <Tab> [list ::tk::dialog::file::CompleteEnt $w]

    # Build the focus group for all the entries

}
bind TCombobox <<TraverseIn>> 		{ ttk::combobox::TraverseIn %W }

### Combobox listbox bindings.
#
bind ComboboxListbox <ButtonRelease-1>	{ ttk::combobox::LBSelected %W }
bind ComboboxListbox <Return>		{ ttk::combobox::LBSelected %W }
bind ComboboxListbox <KP_Enter>		{ ttk::combobox::LBSelected %W }
bind ComboboxListbox <Escape>		{ ttk::combobox::LBCancel %W }
bind ComboboxListbox <Tab>		{ ttk::combobox::LBTab %W next }
bind ComboboxListbox <<PrevWindow>>	{ ttk::combobox::LBTab %W prev }
bind ComboboxListbox <Destroy>		{ ttk::combobox::LBCleanup %W }
bind ComboboxListbox <Motion>		{ ttk::combobox::LBHover %W %x %y }
bind ComboboxListbox <Map>		{ focus -force %W }

	-side left

    # Create the bindings:
    #
    bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]

    bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
    bind $data(fEnt) <KP_Enter> [list tk::MotifFDialog_ActivateFEnt $w]
    bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
    bind $data(sEnt) <KP_Enter> [list tk::MotifFDialog_ActivateSEnt $w]
        bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w]
    bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}}

    wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
}

proc ::tk::MotifFDialog_SetListMode {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

	    string = [pb stringForType:type];
	}
	if (string) {
	    result = proc(clientData, interp, string.UTF8String);
	}
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	     "%s selection does not exist or form \"%s\" not defined",
	     Tk_GetAtomName(tkwin, selection),
	     Tk_GetAtomName(tkwin, target)));
	Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL);
    }
    return result;
}


    TkWindow *winPtr = (TkWindow *) tkwin;
    TkWindow *usePtr;
    MacDrawable *parent, *macWin;
    Container *containerPtr;

    if (winPtr->window != None) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot modify container after widget is created", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL);
	return TCL_ERROR;
    }

    /*
     * Decode the container window ID, and look for it among the list of
     * available containers.

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't create child of window \"%s\"", string));
	    Tcl_SetErrorCode(interp, "TK", "EMBED", "NO_TARGET", NULL);
	}
	return TCL_ERROR;
    } else if (!(usePtr->flags & TK_CONTAINER)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"window \"%s\" does not have -container option set",
		usePtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL);
	return TCL_ERROR;
    }

    /*
     * Since we do not allow embedding into windows belonging to a different

		|| (Tcl_GetIntFromObj(interp, objv[5], &numer2) != TCL_OK)
		|| (Tcl_GetIntFromObj(interp, objv[6], &denom2) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		(denom2 <= 0)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "aspect number cannot be <= 0", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "WM", "ASPECT", NULL);
	    return TCL_ERROR;
	}
	wmPtr->minAspect.x = numer1;
	wmPtr->minAspect.y = denom1;
	wmPtr->maxAspect.x = numer2;
	wmPtr->maxAspect.y = denom2;

    NSWindow *win = nil;
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "window");
	return TCL_ERROR;
    }
    if (wmPtr->iconFor != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot deiconify %s: it is an icon for %s",
		Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
	Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL);
	return TCL_ERROR;
    } else if (winPtr->flags & TK_EMBEDDED) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot deiconify %s: it is an embedded window",
		winPtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL);
	return TCL_ERROR;
    }

    if (winPtr->window) {
	win = TkMacOSXGetNSWindowForDrawable(winPtr->window);

	if ((Tcl_GetIntFromObj(interp, objv[3], &reqWidth) != TCL_OK)
		|| (Tcl_GetIntFromObj(interp, objv[4], &reqHeight) != TCL_OK)
		|| (Tcl_GetIntFromObj(interp, objv[5], &widthInc) != TCL_OK)
		|| (Tcl_GetIntFromObj(interp, objv[6], &heightInc)!=TCL_OK)) {
	    return TCL_ERROR;
	}
	if (reqWidth < 0) {
	    errorMsg = "baseWidth cannot be < 0";
	    goto error;
	} else if (reqHeight < 0) {
	    errorMsg = "baseHeight cannot be < 0";
	    goto error;
	} else if (widthInc <= 0) {
	    errorMsg = "widthInc cannot be <= 0";
	    goto error;
	} else if (heightInc <= 0) {
	    errorMsg = "heightInc cannot be <= 0";
	    goto error;
	}
	Tk_SetGrid((Tk_Window)winPtr, reqWidth, reqHeight, widthInc,
		heightInc);
    }
    wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
    WmUpdateGeom(wmPtr, winPtr);

    /*
     * First, check that the label is not a decimal. If it is,
     * return an error.
     */

    if ([label containsString:@"."]) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot use \"%s\" as icon badge", Tcl_GetString(objv[3])));
	return TCL_ERROR;
    }

    /*
     * Next, check that label is an int, empty string, or exclamation
     * point. If so, set the icon badge on the Dock icon. Otherwise,
     * return an error.
     */

    NSArray *array = @[@"", @"!"];
    if ([array containsObject: label]) {
	[dockicon setBadgeLabel:label];
    } else if (number > 0) {
	NSString *str = [@(number) stringValue];
	[dockicon setBadgeLabel:str];
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot use \"%s\" as icon badge", Tcl_GetString(objv[3])));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "window");
	return TCL_ERROR;
    }

    if (Tk_Attributes((Tk_Window)winPtr)->override_redirect) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot iconify \"%s\": override-redirect flag is set",
		winPtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT",
		NULL);
	return TCL_ERROR;
    } else if (wmPtr->container != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot iconify \"%s\": it is a transient", winPtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL);
	return TCL_ERROR;
    } else if (wmPtr->iconFor != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot iconify \"%s\": it is an icon for \"%s\"",
		winPtr->pathName, Tk_PathName(wmPtr->iconFor)));
	Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL);
	return TCL_ERROR;
    } else if (winPtr->flags & TK_EMBEDDED) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot iconify \"%s\": it is an embedded window",
		winPtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL);
	return TCL_ERROR;
    }

    TkpWmSetState(winPtr, IconicState);
    if (wmPtr->icon) {

    /*
     * Get image and convert to NSImage that can be displayed as icon.
     */

    tk_icon = Tk_GetImage(interp, tkwin, icon, NULL, NULL);
    if (tk_icon == NULL) {
    	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	      "cannot use \"%s\" as iconphoto: not a photo image",
	      icon));
	Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL);
	return TCL_ERROR;
    }

    Tk_SizeOfImage(tk_icon, &width, &height);
    if (width != 0 && height != 0) {

	wmPtr->icon = NULL;
    } else {
	if (TkGetWindowFromObj(interp, tkwin, objv[3], &tkwin2) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tk_IsTopLevel(tkwin2)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot use %s as icon window: not at top level",
		    Tk_PathName(tkwin2)));
	    Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "TOPLEVEL",
		    NULL);
	    return TCL_ERROR;
	}
	wmPtr2 = ((TkWindow *)tkwin2)->wmInfoPtr;
	if (wmPtr2->iconFor != NULL) {

	Tcl_WrongNumArgs(interp, 2, objv, "window ?state?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	if (wmPtr->iconFor != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot change state of \"%s\": it is an icon for \"%s\"",
		    Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
	    Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL);
	    return TCL_ERROR;
	}
	if (winPtr->flags & TK_EMBEDDED) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot change state of \"%s\": it is an embedded window",
		    winPtr->pathName));
	    Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "EMBEDDED", NULL);
	    return TCL_ERROR;
	}

	if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings,
		sizeof(char *), "argument", 0, &index) != TCL_OK) {

	     * window to be raised and receive focus
	     */

	    break;
	case OPT_ICONIC:
	    if (Tk_Attributes((Tk_Window)winPtr)->override_redirect) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot iconify \"%s\": override-redirect flag is set",
			winPtr->pathName));
		Tcl_SetErrorCode(interp, "TK", "WM", "STATE",
			"OVERRIDE_REDIRECT", NULL);
		return TCL_ERROR;
	    }
	    if (wmPtr->container != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot iconify \"%s\": it is a transient",
			winPtr->pathName));
		Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT",
			NULL);
		return TCL_ERROR;
	    }
	    TkpWmSetState(winPtr, IconicState);
	    break;

	    containerPtr = containerPtr->parentPtr;
	}
	Tk_MakeWindowExist((Tk_Window)containerPtr);

	if (wmPtr->iconFor != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot make \"%s\" a transient: it is an icon for %s",
		    Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
	    Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
	    return TCL_ERROR;
	}

	wmPtr2 = containerPtr->wmInfoPtr;

	/*
	 * Under some circumstances, wmPtr2 is NULL here.
	 */

	if (wmPtr2 != NULL && wmPtr2->iconFor != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot make \"%s\" a container: it is an icon for %s",
		    Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor)));
	    Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
	    return TCL_ERROR;
	}

	for (w = containerPtr; w != NULL && w->wmInfoPtr != NULL;
	    w = (TkWindow *)w->wmInfoPtr->container) {
	    if (w == winPtr) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot set \"%s\" as container: would cause management loop",
		    Tk_PathName(containerPtr)));
		Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
		return TCL_ERROR;
	    }
	}

	/*

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "window");
	return TCL_ERROR;
    }

    if (wmPtr->iconFor != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot withdraw %s: it is an icon for %s",
		Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor)));
	Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL);
	return TCL_ERROR;
    }

    TkpWmSetState(winPtr, WithdrawnState);

    set x {}
} -body {
    bind .t.f <Key> "lappend x %b"
    event generate .t.f <Key> -above .
    return $x
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-above" option}

test bind-22.24 {HandleEventGenerate: options <Configure> -borderwidth xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -borderwidth 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-borderwidth" option}

test bind-22.27 {HandleEventGenerate: options <Button> -button xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -button 1
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-button" option}

test bind-22.31 {HandleEventGenerate: options <Expose> -count xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %b"
    event generate .t.f <Key> -count 20
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-count" option}

test bind-22.34 {HandleEventGenerate: options <Enter> -detail xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -detail NotifyVirtual
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-detail" option}

test bind-22.38 {HandleEventGenerate: options <Enter> -focus xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -focus 1
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-focus" option}

test bind-22.41 {HandleEventGenerate: options <Expose> -height xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -height 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-height" option}

test bind-22.45 {HandleEventGenerate: options <Key> -keycode xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Button> "lappend x %b"
    event generate .t.f <Button> -keycode 20
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Button> event does not accept "-keycode" option}

test bind-22.48 {HandleEventGenerate: options <Key> -keysym xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Button> "lappend x %b"
    event generate .t.f <Button> -keysym space
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Button> event does not accept "-keysym" option}

test bind-22.51 {HandleEventGenerate: options <Enter> -mode xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -mode NotifyNormal
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-mode" option}
test bind-22.55 {HandleEventGenerate: options <Map> -override xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}
} -body {

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -override 1
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-override" option}

test bind-22.60 {HandleEventGenerate: options <Circulate> -place xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -place PlaceOnTop
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-place" option}

test bind-22.63 {HandleEventGenerate: options <Key> -root .xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Configure> "lappend x %R"
    event generate .t.f <Configure> -root .t
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Configure> event does not accept "-root" option}

test bind-22.73 {HandleEventGenerate: options <Key> -rootx xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Configure> "lappend x %X"
    event generate .t.f <Configure> -rootx 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Configure> event does not accept "-rootx" option}

test bind-22.81 {HandleEventGenerate: options <Key> -rooty xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Configure> "lappend x %Y"
    event generate .t.f <Configure> -rooty 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Configure> event does not accept "-rooty" option}

test bind-22.89 {HandleEventGenerate: options <Key> -sendevent xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Configure> "lappend x %s"
    event generate .t.f <Configure> -state xyz
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Configure> event does not accept "-state" option}

test bind-22.105 {HandleEventGenerate: options <Key> -subwindow .xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Configure> "lappend x %S"
    event generate .t.f <Configure> -subwindow .t
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Configure> event does not accept "-subwindow" option}

test bind-22.115 {HandleEventGenerate: options <Key> -time xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Configure> "lappend x %t"
    event generate .t.f <Configure> -time 100
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Configure> event does not accept "-time" option}

test bind-22.124 {HandleEventGenerate: options <Expose> -width xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %k"
    event generate .t.f <Key> -width 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-width" option}

test bind-22.128 {HandleEventGenerate: options <Unmap> -window .xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Key> "lappend x %W"
    event generate .t.f <Key> -window .t.f
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Key> event does not accept "-window" option}

test bind-22.139 {HandleEventGenerate: options <Key> -x xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Map> "lappend x %x"
    event generate .t.f <Map> -x 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Map> event does not accept "-x" option}

test bind-22.151 {HandleEventGenerate: options <Key> -y xyz} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    update
    set x {}
} -body {
    bind .t.f <Map> "lappend x %y"
    event generate .t.f <Map> -y 2i
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<Map> event does not accept "-y" option}

test bind-22.163 {HandleEventGenerate: options <Key> -xyz 1} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}

    focus -force .t.f
    update
} -body {
# Check no confusion, since Focus events use %d for something else
    event generate .t.f <FocusIn> -data foo
} -cleanup {
    destroy .t.f
} -returnCodes error -result {<FocusIn> event does not accept "-data" option}
test bind-31.2 {virtual event user_data field - NULL, synch} -setup {
    frame .t.f -class Test -width 150 -height 100
    pack .t.f
    focus -force .t.f
    update
    set x {}
} -body {

} -result {bad window path name ".f"}
test busy-3.4 {tk busy cget non-busy window} -setup {
    pack [frame .f]
} -body {
    tk busy cget .f -cursor
} -cleanup {
    destroy .f
} -returnCodes error -result {cannot find busy window ".f"}
test busy-3.5 {tk busy cget invalid option} -setup {
    pack [frame .f]
    tk busy hold .f
    update
} -body {
    tk busy cget .f -invalidOption
} -cleanup {

test busy-4.3 {tk busy configure non-busy window} -setup {
    pack [frame .f]
} -body {
    tk busy configure .f
} -cleanup {
    destroy .f
} -returnCodes error -result {cannot find busy window ".f"}

test busy-4.4 {tk busy configure} -constraints {nonwin} -setup {
    pack [frame .f]
    tk busy hold .f
    update
} -body {
    tk busy configure .f

} -returnCodes error -result {bad window path name ".f"}
test busy-5.3 {tk busy forget non busy window} -setup {
    pack [frame .f]
} -body {
    tk busy forget .f
} -cleanup {
    destroy .f
} -returnCodes error -result {cannot find busy window ".f"}
test busy-5.4 {tk busy forget window} -setup {
    pack [frame .f]
    tk busy hold .f
    update
} -body {
    set r [tk busy status .f]
    tk busy forget .f

    label .l -borderwidth 2 -highlightthickness 2
    pack .l
    update
} -body {
    .l configure -font {}
} -cleanup {
    destroy .l
} -returnCodes {error} -result {font "" does not exist}
test button-1.105 {configuration option: "font" for button} -setup {
    button .b -borderwidth 2 -highlightthickness 2
    pack .b
    update
} -body {
    .b configure -font {Helvetica -12}
    .b cget -font
} -cleanup {
    destroy .b
} -result {Helvetica -12}
test button-1.106 {configuration option: "activebackground" for button} -setup {
    button .b -borderwidth 2 -highlightthickness 2
    pack .b
    update
} -body {
    .b configure -font {}
} -cleanup {
    destroy .b
} -returnCodes {error} -result {font "" does not exist}
test button-1.107 {configuration option: "font" for checkbutton} -setup {
    checkbutton .c -borderwidth 2 -highlightthickness 2
    pack .c
    update
} -body {
    .c configure -font {Helvetica -12}
    .c cget -font
} -cleanup {
    destroy .c
} -result {Helvetica -12}
test button-1.108 {configuration option: "activebackground" for checkbutton} -setup {
    checkbutton .c -borderwidth 2 -highlightthickness 2
    pack .c
    update
} -body {
    .c configure -font {}
} -cleanup {
    destroy .c
} -returnCodes {error} -result {font "" does not exist}
test button-1.109 {configuration option: "font" for radiobutton} -setup {
    radiobutton .r -borderwidth 2 -highlightthickness 2
    pack .r
    update
} -body {
    .r configure -font {Helvetica -12}
    .r cget -font
} -cleanup {
    destroy .r
} -result {Helvetica -12}
test button-1.110 {configuration option: "activebackground" for radiobutton} -setup {
    radiobutton .r -borderwidth 2 -highlightthickness 2
    pack .r
    update
} -body {
    .r configure -font {}
} -cleanup {
    destroy .r
} -returnCodes {error} -result {font "" does not exist}

test button-1.111 {configuration option: "foreground" for label} -setup {
    label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .l
    update
} -body {
    .l configure -foreground #110022

    label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .l
    update
} -body {
    .l configure -image bogus
} -cleanup {
    destroy .l
} -returnCodes {error} -result {image "bogus" does not exist}
test button-1.153 {configuration option: "image" for button} -constraints {
    testImageType
} -setup {
    image create test image1
    button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .b
    update

    button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .b
    update
} -body {
    .b configure -image bogus
} -cleanup {
    destroy .b
} -returnCodes {error} -result {image "bogus" does not exist}
test button-1.155 {configuration option: "image" for checkbutton} -constraints {
    testImageType
} -setup {
    image create test image1
    checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .c
    update

    checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .c
    update
} -body {
    .c configure -image bogus
} -cleanup {
    destroy .c
} -returnCodes {error} -result {image "bogus" does not exist}
test button-1.157 {configuration option: "image" for radiobutton} -constraints {
    testImageType
} -setup {
    image create test image1
    radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .r
    update

    radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .r
    update
} -body {
    .r configure -image bogus
} -cleanup {
    destroy .r
} -returnCodes {error} -result {image "bogus" does not exist}

test button-1.159 {configuration option: "indicatoron" for checkbutton} -setup {
    checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .c
    update
} -body {
    .c configure -indicatoron yes

    checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .c
    update
} -body {
    .c configure -selectimage bogus
} -cleanup {
    destroy .c
} -returnCodes {error} -result {image "bogus" does not exist}
test button-1.217 {configuration option: "selectimage" for radiobutton} -constraints {
    testImageType
} -setup {
    image create test image1
    radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .r
    update

    radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .r
    update
} -body {
    .r configure -selectimage bogus
} -cleanup {
    destroy .r
} -returnCodes {error} -result {image "bogus" does not exist}

test button-1.219 {configuration option: "state" for label} -setup {
    label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .l
    update
} -body {
    .l configure -state normal

    checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .c
    update
} -body {
    .c configure -tristateimage bogus
} -cleanup {
    destroy .c
} -returnCodes {error} -result {image "bogus" does not exist}
test button-1.241 {configuration option: "tristateimage" for radiobutton} -constraints {
    testImageType
} -setup {
    image create test image1
    radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .r
    update

    radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .r
    update
} -body {
    .r configure -tristateimage bogus
} -cleanup {
    destroy .r
} -returnCodes {error} -result {image "bogus" does not exist}

test button-1.243 {configuration option: "underline" for label} -setup {
    label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .l
    update
} -body {
    .l configure -underline 5

    checkbutton .c -variable checkvar -onvalue 1 -offvalue 0
    set checkvar 1
    trace add variable checkvar write bogusTrace
    .c deselect
} -cleanup {
    destroy .c
    trace remove variable checkvar write bogusTrace
} -match glob -returnCodes error -result {can*t set "checkvar": trace aborted}
test button-3.25 {ButtonWidgetCmd procedure, "deselect" option} -body {
    checkbutton .c -variable checkvar -onvalue 1 -offvalue 0
    set checkvar 1
    trace add variable checkvar write bogusTrace
    catch {.c deselect}
    list $errorInfo $checkvar
} -cleanup {

    radiobutton .r -variable radiovar -value red
    set radiovar red
    trace add variable radiovar write bogusTrace
    .r deselect
} -cleanup {
    destroy .r
    trace remove variable radiovar write bogusTrace
} -match glob -returnCodes error -result {can*t set "radiovar": trace aborted}
test button-3.27 {ButtonWidgetCmd procedure, "deselect" option} -body {
    radiobutton .r -variable radiovar -value red
    set radiovar red
    trace add variable radiovar write bogusTrace
    catch {.r deselect}
    list $errorInfo $radiovar
} -cleanup {

    radiobutton .r -variable radiovar -value red
    set radiovar yellow
    trace add variable radiovar write bogusTrace
    .r select
} -cleanup {
    destroy .r
    trace remove variable radiovar write bogusTrace
} -match glob -returnCodes error -result {can*t set "radiovar": trace aborted}
test button-3.45 {ButtonWidgetCmd procedure, "select" option} -body {
    radiobutton .r -variable radiovar -value red
    set radiovar yellow
    trace add variable radiovar write bogusTrace
    catch {.r select}
    list $errorInfo $radiovar
} -cleanup {

    checkbutton .c -variable checkvar -onvalue xyz -offvalue abc
    set checkvar xyz
    trace add variable checkvar write bogusTrace
    .c toggle
} -cleanup {
    destroy .c
    trace remove variable checkvar write bogusTrace
} -match glob -returnCodes error -result {can*t set "checkvar": trace aborted}
test button-3.52 {ButtonWidgetCmd procedure, "toggle" option} -body {
    checkbutton .c -variable checkvar -onvalue xyz -offvalue abc
    set checkvar xyz
    trace add variable checkvar write bogusTrace
    catch {.c toggle}
    list $errorInfo $checkvar
} -cleanup {

    checkbutton .c -variable checkvar -onvalue xyz -offvalue abc
    set checkvar abc
    trace add variable checkvar write bogusTrace
    .c toggle
} -cleanup {
    trace remove variable checkvar write bogusTrace
    destroy .c
} -match glob -returnCodes error -result {can*t set "checkvar": trace aborted}
test button-3.54 {ButtonWidgetCmd procedure, "toggle" option} -body {
    checkbutton .c -variable checkvar -onvalue xyz -offvalue abc
    set checkvar abc
    trace add variable checkvar write bogusTrace
    catch {.c toggle}
    list $errorInfo $checkvar
} -cleanup {
    trace remove variable checkvar write bogusTrace
    destroy .c
} -match glob -result {{*trace aborted
    while executing
*
".c toggle"} xyz}
test button-3.55 {ButtonWidgetCmd procedure, "toggle" option} -setup {
    unset -nocomplain checkvar
} -body {
    checkbutton .c -variable checkvar -onvalue xyz -offvalue abc
    unset checkvar
    set checkvar(1) 1
    .c toggle
} -cleanup {
    destroy .c
} -match glob -returnCodes {error} -result {can*t set "checkvar": variable is array}
test button-3.56 {ButtonWidgetCmd procedure, "toggle" option} -setup {
    unset -nocomplain checkvar
} -body {
    checkbutton .c -variable checkvar -onvalue xyz -offvalue abc
    unset checkvar
    set checkvar(1) 1
    catch {.c toggle}
    return $errorInfo
} -cleanup {
    destroy .c
} -match glob -result {can*t set "checkvar": variable is array
    while executing
".c toggle"}

test button-4.1 {DestroyButton procedure} -constraints {
    testImageType
} -setup {
    image create test image1

    unset -nocomplain x
} -body {
    trace add variable x write bogusTrace
    radiobutton .r -variable x
} -cleanup {
    destroy .r
    trace remove variable x write bogusTrace
} -match glob -returnCodes {error} -result {can*t set "x": trace aborted}

test button-5.11 {ConfigureButton - bad image name} -body {
    button .b -image bogus
} -cleanup {
    destroy .b
} -returnCodes {error} -result {image "bogus" does not exist}

test button-5.12 {ConfigureButton - setting variable from current text value} -setup {
    unset -nocomplain x
} -body {
    button .b -textvariable x -text "Button 1"
    return $x
} -cleanup {

    unset -nocomplain x
} -body {
    trace add variable x write bogusTrace
    radiobutton .r -text foo -textvariable x
} -cleanup {
    trace remove variable x write bogusTrace
    destroy .r
} -match glob -returnCodes {error} -result {can*t set "x": trace aborted}
test button-5.15 {ConfigureButton - variable handling} -setup {
    unset -nocomplain x
} -body {
    trace add variable x write bogusTrace
    catch {radiobutton .r -text foo -textvariable x}
	return $x
} -cleanup {

} -body {
    checkbutton .c -variable x
    trace add variable x write bogusTrace
    .c invoke
} -cleanup {
    destroy .c
    trace remove variable x write bogusTrace
} -match glob -returnCodes {error} -result {can*t set "x": trace aborted}
test button-8.3 {TkInvokeButton procedure} -setup {
    set x 0
} -body {
    checkbutton .c -variable x
    trace add variable x write bogusTrace
    catch {.c invoke}
    return $x
} -cleanup {
    destroy .c
    trace remove variable x write bogusTrace
} -result 1
test button-8.4 {TkInvokeButton procedure} -setup {
    set x 1
} -body {
    checkbutton .c -variable x
    trace add variable x write bogusTrace
    .c invoke
} -cleanup {
    destroy .c
    trace remove variable x write bogusTrace
} -match glob -returnCodes {error} -result {can*t set "x": trace aborted}
test button-8.5 {TkInvokeButton procedure} -setup {
    set x 1
} -body {
    checkbutton .c -variable x
    trace add variable x write bogusTrace
    catch {.c invoke}
    return $x

    radiobutton .r -variable x -value red
    set x green
    trace add variable x write bogusTrace
    .r invoke
} -cleanup {
    destroy .r
    trace remove variable x write bogusTrace
} -match glob -returnCodes {error} -result {can*t set "x": trace aborted}
test button-8.8 {TkInvokeButton procedure} -body {
    radiobutton .r -variable x -value red
    set x green
    trace add variable x write bogusTrace
    catch {.r invoke}
    list $errorInfo $x
} -cleanup {

    checkbutton .c -variable x
    set x 0
    .c toggle
    return $x
} -cleanup {
    destroy .c
} -result 1
test button-9.8 {ButtonVarProc procedure, cannot read variable} -setup {
# This test does nothing but produce a core dump if there's a prbblem.
    unset -nocomplain a
} -body {
    checkbutton .c -variable a
    unset a
    set a(32) 0
    unset a

    .c delete all
	image delete foo
} -result {-image {} {} {} foo}
test canvImg-1.4 {options for image items} -body {
    .c create image 50 50 -image unknown -tags i1
} -cleanup {
    .c delete all
} -returnCodes {error} -result {image "unknown" does not exist}
test canvImg-1.5 {options for image items} -constraints testImageType -setup {
    image create test foo
	.c delete all
} -body {
    .c create image 50 50 -image foo -tags {i1 foo}
    .c itemconfigure i1 -tags
} -cleanup {

    update
    set x {}
    set y {}
    .c itemconfigure i1 -image lousy
} -cleanup {
	.c delete all
	image delete foo foo2
} -returnCodes {error} -result {image "lousy" does not exist}


test canvImg-5.1 {DeleteImage procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
} -body {
    image create test foo -variable x

} -result {{} {}}
test canvText-1.6 {configuration options: good value for "font"} -body {
    .c itemconfigure test -font {Times 40}
    list [lindex [.c itemconfigure test -font] 4] [.c itemcget test -font]
} -result {{Times 40} {Times 40}}
test canvasText-1.7 {configuration options: bad value for "font"} -body {
    .c itemconfigure test -font {}
} -returnCodes error -result {font "" does not exist}
test canvText-1.8 {configuration options: good value for "justify"} -body {
    .c itemconfigure test -justify left
    list [lindex [.c itemconfigure test -justify] 4] [.c itemcget test -justify]
} -result {left left}
test canvasText-1.9 {configuration options: bad value for "justify"} -body {
    .c itemconfigure test -justify xyz
} -returnCodes error -result {bad justification "xyz": must be left, right, or center}

    clipboard clear
} -body {
    clipboard append "Test"
    selection clear -s CLIPBOARD
    clipboard get
} -cleanup {
    clipboard clear
}  -returnCodes error -result {CLIPBOARD selection does not exist or form "STRING" not defined}
test clipboard-4.2 {ClipboardLostSel procedure} -setup {
    clipboard clear
} -body {
    clipboard append "Test"
    clipboard append -t TEST "Test2"
    selection clear -s CLIPBOARD
    clipboard get
} -cleanup {
    clipboard clear
}  -returnCodes error -result {CLIPBOARD selection does not exist or form "STRING" not defined}
test clipboard-4.3 {ClipboardLostSel procedure} -setup {
    clipboard clear
} -body {
    clipboard append "Test"
    clipboard append -t TEST "Test2"
    selection clear -s CLIPBOARD
    clipboard get -t TEST
} -cleanup {
    clipboard clear
}  -returnCodes error -result {CLIPBOARD selection does not exist or form "TEST" not defined}
test clipboard-4.4 {ClipboardLostSel procedure} -setup {
    clipboard clear
} -body {
    clipboard append "Test"
    clipboard append -t TEST "Test2"
    clipboard append "Test3"
    selection clear -s CLIPBOARD
    clipboard get
} -cleanup {
    clipboard clear
}  -returnCodes error -result {CLIPBOARD selection does not exist or form "STRING" not defined}
test clipboard-4.5 {ClipboardLostSel procedure} -setup {
    clipboard clear
} -body {
    clipboard append "Test"
    clipboard append -t TEST "Test2"
    clipboard append "Test3"
    selection clear -s CLIPBOARD
    clipboard get -t TEST
} -cleanup {
    clipboard clear
}  -returnCodes error -result {CLIPBOARD selection does not exist or form "TEST" not defined}



##############################################################################

test clipboard-5.1 {Tk_ClipboardClear procedure} -setup {
    clipboard clear

} -setup {
    deleteWindows
} -body {
    toplevel .container
    toplevel .embd -use [winfo id .container]
} -cleanup {
    deleteWindows
} -returnCodes error -result {window ".container" does not have -container option set}
# testing window embedding for other than win platforms
test embed-1.5.nonwin {Tk_UseWindow procedure, -container must be set} -constraints {
	nonwin
} -setup {
    deleteWindows
} -body {
    frame .container
    toplevel .embd -use [winfo id .container]
} -cleanup {
    deleteWindows
} -returnCodes error -result {window ".container" does not have -container option set}


cleanupTests
return

    entry .e -borderwidth 2 -highlightthickness 2
    pack .e ; update idletasks
    update
} -body {
    .e configure -font {}
} -cleanup {
    destroy .e
} -returnCodes {error} -result {font "" does not exist}

test entry-1.21 {configuration option: "foreground" for entry} -setup {
    entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .e ; update idletasks
    update
} -body {
    .e configure -foreground #110022

    .e select from 1
    .e select to 4
    update
    .e select clear
    selection get
} -cleanup {
    destroy .e
} -returnCodes error -result {PRIMARY selection does not exist or form "STRING" not defined}
test entry-3.50.1 {EntryWidgetCmd procedure, "select clear" widget command} -setup {
    entry .e
    pack .e ; update idletasks
    update
} -body {
    .e insert end "0123456789"
    .e select from 1

    update
} -body {
    .e gorp
} -cleanup {
    destroy .e
} -returnCodes error -result {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}

# The test below does not actually check anything directly, but if run
# with Purify or some other memory-allocation-checking program it will
# ensure that resources get properly freed.

test entry-4.1 {DestroyEntry procedure} -body {
    entry .e -textvariable x -show *
    pack .e ; update idletasks
    .e insert end "Sample text"

    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    .e configure -exportselection 0
    selection get
} -cleanup {
    destroy .e
} -returnCodes error -result {PRIMARY selection does not exist or form "STRING" not defined}
test entry-5.6.1 {ConfigureEntry procedure} -setup {
    entry .e
    pack .e ; update idletasks
} -body {
    .e insert end "0123456789"
    .e select from 1
    .e select to 5

test entry-22.1 {lost namespaced textvar} -body {
    namespace eval test { variable foo {a b} }
    entry .e -textvariable ::test::foo
    namespace delete test
    set ::test::foo
} -cleanup {
    destroy .e
} -match glob -returnCodes error -result {can*t read "::test::foo": no such variable}
test entry-22.2 {lost namespaced textvar} -body {
    namespace eval test { variable foo {a b} }
    entry .e -textvariable ::test::foo
    namespace delete test
    catch {.e insert end "more stuff"} result1
    catch {.e delete 5 end } result2
    catch {set ::test::foo} result3
    list [.e get] [.e cget -textvar] $result1 $result2 $result3
} -cleanup {
    destroy .e
} -match glob -result [list "a bmo" ::test::foo \
	{can*t set "::test::foo": parent namespace does*t exist} \
	{can*t set "::test::foo": parent namespace does*t exist} \
	{can*t read "::test::foo": no such variable}]

test entry-23.1 {error in trace proc attached to the textvariable} -setup {
    destroy .e
} -body {
    trace add variable myvar write traceit
    proc traceit args {error "Intentional error here!"}
    entry .e -textvariable myvar
    catch {.e insert end mystring} result1
    catch {.e delete 0} result2
    list $result1 $result2
} -cleanup {
    destroy .e
} -match glob -result [list {can*t set "myvar": Intentional error here!} \
    {can*t set "myvar": Intentional error here!}]

test entry-24.1 {textvariable lives in a non-existing namespace} -setup {
    destroy .e
} -body {
    catch {entry .e -textvariable thisnsdoesntexist::myvar} result1
    set result1
} -cleanup {
  destroy .e
} -match glob -result {can*t trace "thisnsdoesntexist::myvar": parent namespace does*t exist}

test entry-25.1 {Bug [5d991b822e]} {
    # Want this not to segfault, or write to variable with empty name
    set var INIT
    entry .b -textvariable var
    trace add variable var unset {apply {args {
        .b configure -textvariable {}

	.b config -font wiggles
	font config wiggles -size 24
	destroy .
    }
    lappend x [foo eval {catch {font families} msg; set msg}]
} -cleanup {
    interp delete foo
} -result {{named font "wiggles" does not exist} {cannot invoke "font" command: application has been destroyed}}


test font-3.1 {font command: general} -body {
    font
} -returnCodes error -result {wrong # args: should be "font option ?arg?"}
test font-3.2 {font command: general} -body {
    font xyz

test font-4.6 {font command: actual: arguments} -body {
    # (objc - skip > 4) when skip == 2
    font actual xyz -displayof . abc def
} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?-option? ?--? ?char?"}
test font-4.7 {font command: actual: arguments} -constraints noExceed -body {
    # (tkfont == NULL)
    font actual "\{xyz"
} -returnCodes error -result "font \"{xyz\" does not exist"
test font-4.8 {font command: actual: all attributes} -body {
    # not (objc > 3) so objPtr = NULL
    lindex [font actual {-family times}] 0
} -result {-family}
test font-4.9 {font command: actual} -constraints {unix noExceed failsOnUbuntu} -body {
    # (objc > 3) so objPtr = objv[3 + skip]
    string tolower [font actual {-family times} -family]

test font-5.1 {font command: configure} -body {
    # (objc < 3)
    font configure
} -returnCodes error -result {wrong # args: should be "font configure fontname ?-option value ...?"}
test font-5.2 {font command: configure: non-existent font} -body {
    # (namedHashPtr == NULL)
    font configure xyz
} -returnCodes error -result {named font "xyz" does not exist}
test font-5.3 {font command: configure: "deleted" font} -setup {
    destroy .t.f
    catch {font delete xyz}
    pack [label .t.f]
    update
} -body {
    # (nfPtr->deletePending != 0)
    font create xyz
    .t.f configure -font xyz
    font delete xyz
    font configure xyz
} -cleanup {
    destroy .t.f
} -returnCodes error -result {named font "xyz" does not exist}
test font-5.4 {font command: configure: get all options} -setup {
    catch {font delete xyz}
} -body {
    # (objc == 3) so objPtr = NULL
    font create xyz -family xyz
    lindex [font configure xyz] 1
} -cleanup {

    clearnondefaultfonts
} -result {{a b c d e} {b c e}}
test font-7.4 {font command: delete: non-existent} -setup {
    catch {font delete xyz}
} -body {
    # (namedHashPtr == NULL)
    font delete xyz
} -returnCodes error -result {named font "xyz" does not exist}
test font-7.5 {font command: delete: mark for later deletion} -setup {
    destroy .t.f
    catch {font delete xyz}
    pack [label .t.f]
    update
} -body {
    # (nfPtr->refCount != 0)
    font create xyz
    .t.f configure -font xyz
    font delete xyz
    font actual xyz
    font configure xyz
} -cleanup {
    destroy .t.f
} -returnCodes error -result {named font "xyz" does not exist}
test font-7.6 {font command: delete: mark for later deletion} -setup {
    destroy .t.f
    catch {font delete xyz}
    pack [label .t.f]
    update
} -body {
    # (nfPtr->refCount != 0)

test font-9.3 {font command: measure: arguments} -body {
    # (objc - skip != 4)
    font measure xyz abc def
} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"}
test font-9.4 {font command: measure: arguments} -constraints noExceed -body {
    # (tkfont == NULL)
    font measure "\{xyz" abc
} -returnCodes error -result "font \"{xyz\" does not exist"
test font-9.5 {font command: measure} -body {
    # Tk_TextWidth()
    expr {[font measure $fixed "abcdefg"] == [font measure $fixed "a"]*7 }
} -result 1
test font-9.6 {font command: measure -d} -body {
     expr {[font measure $fixed -d] > 0}
} -returnCodes ok -result 1

test font-10.5 {font command: metrics: arguments} -body {
    # (objc - skip) > 4) when skip == 2
    font metrics xyz -displayof . abc
} -returnCodes error -result {bad metric "abc": must be -ascent, -descent, -fixed, or -linespace}
test font-10.6 {font command: metrics: bad font} -constraints noExceed -body {
    # (tkfont == NULL)
    font metrics "\{xyz"
} -returnCodes error -result "font \"{xyz\" does not exist"
test font-10.7 {font command: metrics: get all metrics} -setup {
    catch {unset a}
} -body {
    # (objc == 3)
    array set a [font metrics {-family xyz}]
    lsort [array names a]
} -cleanup {

    .t.f config -font {xxx yyy zzz}
} -cleanup {
	destroy .t.f
} -returnCodes error -result {expected integer but got "yyy"}
test font-15.10 {Tk_AllocFontFromObj procedure: no match} -constraints noExceed -body {
    # (ParseFontNameObj() != TCL_OK)
    font actual "\{xyz"
} -returnCodes error -result "font \"{xyz\" does not exist"
test font-15.11 {Tk_AllocFontFromObj procedure: get attribute font} -body {
    # not (ParseFontNameObj() != TCL_OK)
    lindex [font actual {plan 9}] 0
} -result {-family}
test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup {
    destroy .l
} -body {

    # The text has been rotated 90 degrees around it's upper left corner,
    # so it's enough to check with a small rectangle with small negative y coords.
    .t.c find overlapping 5 -7 7 -5
} -result 1
destroy .t.c


test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer does not overflow} -setup {
    destroy .t.c
    canvas .t.c -closeenough 0
    .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
    pack .t.c
    update
} -body {
    # If there were a whole bunch of returns or tabs in a row, then the

    font create xyz -overstrike no
    font config xyz -overstrike
} -cleanup {
    font delete xyz
} -result 0


# In tests below, one field is set to "xyz" so that font name does not
# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
# be called.

test font-38.1 {ParseFontNameObj procedure: begins with -} -body {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} -result [font actual {times 0} -family]
test font-38.2 {ParseFontNameObj procedure: begins with -*} -body {
    lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} -result [font actual {times 0} -family]
test font-38.3 {ParseFontNameObj procedure: begins with -, does not look like list} -body {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} -result [font actual {times 0} -family]
test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} -body {
    lindex [font actual {-family times}] 1
} -result [font actual {times 0} -family]
test font-38.5 {ParseFontNameObj procedure: begins with *} -body {
    lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} -result [font actual {times 0} -family]
test font-38.6 {ParseFontNameObj procedure: begins with *} -body {
    font actual *-times-xyz -family
} -result [font actual {times 0} -family]
test font-38.7 {ParseFontNameObj procedure: arguments} -constraints noExceed -body {
    font actual "\{xyz"
} -returnCodes error -result "font \"{xyz\" does not exist"
test font-38.8 {ParseFontNameObj procedure: arguments} -constraints noExceed -body {
    font actual ""
} -returnCodes error -result {font "" does not exist}
test font-38.9 {ParseFontNameObj procedure: arguments} -body {
    font actual {times 20 xyz xyz}
} -returnCodes error -result {unknown font style "xyz"}
test font-38.10 {ParseFontNameObj procedure: arguments} -body {
    font actual {times xyz xyz}
} -returnCodes error -result {expected integer but got "xyz"}
test font-38.11 {ParseFontNameObj procedure: stylelist loop} -constraints {

test frame-1.2 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f -class NewFrame
    .f configure -class Different
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -class option after widget is created}
test frame-1.3 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f -colormap new
    .f configure -colormap
} -cleanup {
    deleteWindows
} -result {-colormap colormap Colormap {} new}
test frame-1.4 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f -colormap new
    .f configure -colormap .
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -colormap option after widget is created}
test frame-1.5 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f -visual default
    .f configure -visual
} -cleanup {
    deleteWindows
} -result {-visual visual Visual {} default}
test frame-1.6 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f -visual default
    .f configure -visual best
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -visual option after widget is created}
test frame-1.7 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f -screen bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {unknown option "-screen"}

test frame-1.11 {frame configuration options} -setup {
    deleteWindows
} -body {
    frame .f
    .f configure -container 1
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -container option after widget is created}
test frame-1.12 {frame configuration options} -setup {
    deleteWindows
} -body {
    # Make sure all options can be set to the default value
    frame .f
    set opts {}
    foreach opt [.f configure] {

    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -class NewClass
    wm geometry .t +0+0
    .t configure -class Another
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -class option after widget is created}
test frame-2.3 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -colormap new
    wm geometry .t +0+0
    .t configure -colormap
} -cleanup {
    deleteWindows
} -result {-colormap colormap Colormap {} new}
test frame-2.4 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -colormap new
    wm geometry .t +0+0
    .t configure -colormap .
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -colormap option after widget is created}
test frame-2.5 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    .t configure -container 1
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -container option after widget is created}
test frame-2.6 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    catch {.t configure -container 1}
    .t configure -container

    deleteWindows
} -body {
    toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    .t configure -use 0x44022
} -cleanup {
    deleteWindows
} -returnCodes error -result {window "0x44022" does not exist}
test frame-2.9 {toplevel configuration options} -constraints win -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    catch {.t configure -use 0x44022}
    .t configure -use
} -cleanup {
    deleteWindows
} -result {-use use Use {} {}}
test frame-2.10 {toplevel configuration options} -constraints nonwin -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    .t configure -use 0x44022
} -cleanup {
    deleteWindows
} -returnCodes error -result {cannot modify -use option after widget is created}
test frame-2.11 {toplevel configuration options} -constraints nonwin -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100
    wm geometry .t +0+0
    catch {.t configure -use 0x44022}
    .t configure -use

    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -visual default
    wm geometry .t +0+0
    .t configure -visual best
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -visual option after widget is created}
test frame-2.14 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -visual who_knows?
} -returnCodes error -cleanup {
    deleteWindows
} -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}

    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
    wm geometry .t +0+0
    .t configure -screen another
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -screen option after widget is created}
test frame-2.17 {toplevel configuration options} -setup {
    deleteWindows
} -body {
    toplevel .t -width 200 -height 100 -screen bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {couldn't connect to display "bogus"}

test frame-13.2 {labelframe configuration options} -setup {
    deleteWindows
} -body {
    labelframe .f -class NewFrame
    .f configure -class Different
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -class option after widget is created}
test frame-13.3 {labelframe configuration options} -setup {
    deleteWindows
} -body {
    labelframe .f -colormap new
} -cleanup {
    deleteWindows
} -result {.f}

test frame-13.9 {labelframe configuration options} -setup {
    deleteWindows
} -body {
    labelframe .f
    .f configure -container 1
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot modify -container option after widget is created}
destroy .f
labelframe .f
test frame-13.10 {labelframe configuration options} -body {
    .f configure -background #ff0000
    lindex [.f configure -background] 4
} -cleanup {
    .f configure -background [lindex [.f configure -background] 3]

} -body {
    frame .f -width 100 -height 100
    pack .f
    update
    .f configure -backgroundimage gorp
} -returnCodes error -cleanup {
    deleteWindows
} -result {image "gorp" does not exist}
test frame-15.3 {TIP 262: frame background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    frame .f -width 100 -height 100 -backgroundimage gorp
    pack .f

test frame-15.8 {TIP 262: toplevel background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    toplevel .t -width 100 -height 100
    update
    # Used to verify that setting a background image does not change the widget size
    set w [winfo width .t]
    set h [winfo height .t]
    list [image inuse gorp] [.t configure -backgroundimage gorp;update] \
	[image inuse gorp] \
	[expr {$w-[winfo width .t]}] [expr {$h-[winfo height .t]}]
} -cleanup {
    image delete gorp
    deleteWindows
} -result {0 {} 1 0 0}
test frame-15.9 {TIP 262: toplevel background images} -setup {
    deleteWindows
    catch {rename gorp ""}
} -body {
    toplevel .t -width 100 -height 100
    update
    .t configure -backgroundimage gorp
} -returnCodes error -cleanup {
    deleteWindows
} -result {image "gorp" does not exist}
test frame-15.10 {TIP 262: toplevel background images} -setup {
    deleteWindows
    image create photo gorp -width 10 -height 10
    gorp put black -to 2 2 7 7
} -body {
    toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes
    update

    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 .
} -returnCodes error -result {cannot manage ".": it's a top-level window}
test grid-1.6 {basic argument checking} -body {
    grid x
} -returnCodes error -result {cannot determine container window}
test grid-1.7 {basic argument checking} -body {
    grid configure x
} -returnCodes error -result {cannot determine container window}
test grid-1.8 {basic argument checking} -body {
    button .b
    grid x .b
} -cleanup {
    grid_reset 1.8
} -returnCodes ok -result {}
test grid-1.9 {basic argument checking} -body {

} -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
    grid .f .f.b
} -cleanup {
    grid_reset 3.7
} -returnCodes error -result {cannot put ".f.b" inside "."}
test grid-3.8 {configure: basic argument checking} -body {
    button .b
    grid configure x .b
    grid content .
} -cleanup {
    grid_reset 3.8
} -result {.b}
test grid-3.9 {configure: basic argument checking} -body {
    button .b
    grid configure y .b
} -cleanup {
    grid_reset 3.9
} -returnCodes error -result {invalid window shortcut, "y" should be '-', 'x', or '^'}
test grid-3.10 {ConfigureContent procedure, bad -in option} -body {
    frame .f
    grid .f -in .f
} -cleanup {
    grid_reset 3.10
} -returnCodes error -result {window cannot be managed in itself}
test grid-3.11 {prevent management loops} -body {
    frame .f1
    frame .f2
    grid .f1 -in .f2
    grid .f2 -in .f1
} -cleanup {
    grid_reset 3.11
} -returnCodes error -result {cannot put ".f2" inside ".f1": would cause management loop}
test grid-3.12 {prevent management loops} -body {
    frame .f1
    frame .f2
    frame .f3
    grid .f1 -in .f2
    grid .f2 -in .f3
    grid .f3 -in .f1
} -cleanup {
    grid_reset 3.12
} -returnCodes error -result {cannot put ".f3" inside ".f1": would cause management loop}

test grid-4.1 {forget: basic argument checking} -body {
    grid forget foo
} -returnCodes error -result {bad window path name "foo"}
test grid-4.2 {forget} -body {
    button .c
    grid [button .b]

grid_reset 10.39

# auto-placement tests
test grid-11.1 {default widget placement} -body {
    grid ^
} -cleanup {
    grid_reset 11.1
} -returnCodes error -result {cannot use '^', cannot find container window}
test grid-11.2 {default widget placement} -body {
    button .b
    grid .b ^
} -cleanup {
    grid_reset 11.2
} -returnCodes error -result {cannot find content to extend with "^"}
test grid-11.3 {default widget placement} -body {
    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 {

} -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
    grid .f x ^
} -cleanup {
    grid_reset 11.9
} -returnCodes error -result {cannot find content 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
    }
    grid .f1 .f2  -sticky nsew
    grid .f3   ^  -sticky nsew
    update

} -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 cannot be managed in itself}
test grid-13.2 {-in} -body {
    frame .f -bg red
    list [winfo manager .f] \
         [catch {grid .f -in .f} err] $err \
         [winfo manager .f]
} -cleanup {
    grid_reset 13.1.1
} -result {{} 1 {window cannot 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
    grid .f -in .top
} -cleanup {
    grid_reset 13.3
} -returnCodes error -result {cannot 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}

    image gorp
} -returnCodes error -result {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}
test image-1.3 {Tk_ImageCmd procedure, "create" option} -body {
    image create
} -returnCodes error -result {wrong # args: should be "image create type ?name? ?-option value ...?"}
test image-1.4 {Tk_ImageCmd procedure, "create" option} -body {
    image c bad_type
} -returnCodes error -result {image type "bad_type" does not exist}
test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints {
    testImageType
} -body {
    list [image create test myimage] [imageNames]
} -cleanup {
    imageCleanup
} -result {myimage myimage}

    imageCleanup
} -body {
    image create test myimage
    image create test img2
    image delete myimage gorp img2
} -cleanup {
    imageCleanup
} -returnCodes error -result {image "gorp" does not exist}
test image-2.4 {Tk_ImageCmd procedure, "delete" option} -constraints {
    testImageType
} -setup {
    imageCleanup
} -body {
    image create test myimage
    image create test img2

    image height
} -returnCodes error -result {wrong # args: should be "image height name"}
test image-3.2 {Tk_ImageCmd procedure, "height" option} -body {
    image height a b
} -returnCodes error -result {wrong # args: should be "image height name"}
test image-3.3 {Tk_ImageCmd procedure, "height" option} -body {
    image height foo
} -returnCodes error -result {image "foo" does not exist}
test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints {
    testImageType
} -setup {
    imageCleanup
} -body {
    image create test myimage
    set x [image h myimage]

    image type
} -returnCodes error -result {wrong # args: should be "image type name"}
test image-5.2 {Tk_ImageCmd procedure, "type" option} -body {
    image type a b
} -returnCodes error -result {wrong # args: should be "image type name"}
test image-5.3 {Tk_ImageCmd procedure, "type" option} -body {
    image type foo
} -returnCodes error -result {image "foo" does not exist}

test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints {
    testImageType
} -setup {
    imageCleanup
} -body {
    image create test myimage

} -body {
    image create test myimage
    .c create image 50 50 -image myimage
    image delete myimage
    image type myimage
} -cleanup {
    imageCleanup
} -returnCodes error -result {image "myimage" does not exist}
test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints {
    testOldImageType
} -setup {
    imageCleanup
} -body {
    image create oldtest myimage
    image type myimage

    image create oldtest myimage
    .c create image 50 50 -image myimage
    image delete myimage
    image type myimage
} -cleanup {
    .c delete all
    imageCleanup
} -returnCodes error -result {image "myimage" does not exist}


test image-6.1 {Tk_ImageCmd procedure, "types" option} -constraints {
    testImageType
} -body {
    image types x
} -returnCodes error -result {wrong # args: should be "image types"}
test image-6.2 {Tk_ImageCmd procedure, "types" option} -body {
    lsort [image types]
} -match glob -result {bitmap*photo test}


test image-7.1 {Tk_ImageCmd procedure, "width" option} -body {
    image width
} -returnCodes error -result {wrong # args: should be "image width name"}
test image-7.2 {Tk_ImageCmd procedure, "width" option} -body {
    image width a b
} -returnCodes error -result {wrong # args: should be "image width name"}
test image-7.3 {Tk_ImageCmd procedure, "width" option} -body {
    image width foo
} -returnCodes error -result {image "foo" does not exist}
test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints {
    testImageType
} -setup {
    imageCleanup
} -body {
    image create test myimage
    set x [image w myimage]

test image-10.1 {Tk_GetImage procedure} -setup {
    imageCleanup
} -body {
    .c create image 100 10 -image bad_name
} -cleanup {
    imageCleanup
} -returnCodes error -result {image "bad_name" does not exist}
test image-10.2 {Tk_GetImage procedure} -constraints testImageType -setup {
    destroy .l
    imageCleanup
} -body {
    image create test mytest
    label .l -image mytest
    image delete  mytest
    label .l2 -image mytest
} -cleanup {
    destroy .l
    imageCleanup
} -returnCodes error -result {image "mytest" does not exist}


test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
} -body {
    image create test foo -variable x

    .c create image 50 50 -image foo -tags i1
    .c create image 90 100 -image foo -tags i2
    set x {}
    image delete foo
    lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] |
} -cleanup {
    imageCleanup
} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" does not exist} | {} |}

test image-13.3 {Tk_SizeOfImage procedure} -constraints testOldImageType -setup {
    imageCleanup
} -body {
    image create oldtest foo -variable x
    set result [list [image width foo] [image height foo]]
    foo changed 0 0 0 0 85 60

    .c create image 90 100 -image foo -tags i2
    set x {}
    image delete foo
    lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] |
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" does not exist} | {} |}

test image-14.1 {image command vs hidden commands} -body {
    catch {image delete hidden}
    set l [imageNames]
    set h [interp hidden]
    image create photo hidden
    interp hide {} hidden

    i1 configure -maskdata $data2
} -cleanup {
	image delete i1
} -result {}
test imageBmap-3.4 {ImgBmapConfigureModel procedure} -body {
    image create bitmap i1
    i1 configure -maskdata $data2
} -returnCodes error -result {cannot have mask without bitmap}
test imageBmap-3.5 {ImgBmapConfigureModel procedure} -body {
    image create bitmap i1 -data $data1 -maskdata {
	#define foo_width 8
	#define foo_height 16
	static char foo_bits[] = {
	   0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81,
	   0x81, 0x81, 0xff, 0xff, 0xff, 0xff, 0x81, 0x81};

} -result {wrong # args: should be "photo1 copy source-image ?-compositingrule rule? ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?"}
test imgPhoto-4.12 {ImgPhotoCmd procedure: copy option} -setup {
    image create photo photo1
} -body {
    photo1 copy blah
} -returnCodes error -cleanup {
    image delete photo1
} -result {image "blah" does not exist or is not a photo image}
test imgPhoto-4.13 {ImgPhotoCmd procedure: copy option} -setup {
    image create photo photo1
    image create photo photo2
} -body {
    photo1 copy photo2 -blah
} -returnCodes error -cleanup {
    image delete photo1 photo2

test imgPhoto-8.3 {ImgPhotoDelete procedure, name cleanup} -body {
    image create photo photo1
    image create photo photo2 -width 10 -height 10
    image delete photo2
    photo1 copy photo2
} -returnCodes error -cleanup {
    imageCleanup
} -result {image "photo2" does not exist or is not a photo image}

test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -body {
    image create photo photo2 -file $teapotPhotoFile
    rename photo2 {}
    list [expr {"photo2" in [imageNames]}] [catch {photo2 foo} msg] $msg
} -result {0 1 {invalid command name "photo2"}}

    imageCleanup
} -body {
    image create bitmap i1
    image create photo photo1
    photo1 copy i1
} -cleanup {
    imageCleanup
} -returnCodes error -result {image "i1" does not exist or is not a photo image}

test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -body {
    image create photo p3 -file $teapotPhotoFile
    set result [list [p3 get 50 50] [p3 get 100 100]]
    p3 copy p3 -zoom 2
    lappend result [image width p3] [image height p3] [p3 get 100 100]
} -cleanup {

    nonPortable
} -body {
    # This is not portable to very large machines with more than around 3GB of
    # free memory available...
    image create photo -width 32000 -height 32000
} -returnCodes error -result {not enough free memory for image buffer}

test imgPhoto-16.1 {copying to self does not access freed memory} -setup {
    set i [image create photo]
} -body {
    # Bug 877950 makes this crash when trying to copy out of a deallocated
    # area.
    $i put red -to 0 0 1000 1000
    $i copy $i -from 0 0 1000 1000 -to 500 0
} -cleanup {

    lappend x [catch {selection get} msg] $msg [.l curselection]
    .l selection set 1 3
    lappend x [catch {selection get} msg] $msg [.l curselection]
    .l config -exportselection 1
    lappend x [catch {selection get} msg] $msg [.l curselection]
} -cleanup {
    deleteWindows
} -result {0 el1 1 1 {PRIMARY selection does not exist or form "STRING" not defined} 1 1 {PRIMARY selection does not exist or form "STRING" not defined} {} 1 {PRIMARY selection does not exist or form "STRING" not defined} {1 2 3} 0 {el1
el2
el3} {1 2 3}}
test listbox-4.6 {ConfigureListbox procedure} -constraints {
	fonts
} -setup {
    deleteWindows
} -body {

    unset -nocomplain ::foo
    listbox .l2 -listvar foo
    .l2 insert end a b c d
    catch {.l2 configure -listvar ::zoo::bar::foo} result
    list [.l2 get 0 end] [.l2 cget -listvar] $foo $result
} -cleanup {
    destroy .l2
} -match glob -result [list [list a b c d] foo [list a b c d] \
	{can*t set "::zoo::bar::foo": parent namespace does*t exist}]


# No tests for DisplayListbox:  I don't know how to test this procedure.

test listbox-5.1 {ListboxComputeGeometry procedure} -constraints {
	fonts
} -setup {

    .l2 insert end c d
    .l2 delete end
    .l2 insert end e f
    catch {set ::test::foo} result
    list [.l2 get 0 end] [.l2 cget -listvar] $result
} -cleanup {
    destroy .l2
} -match glob -result [list [list a b c e f] ::test::foo \
	{can*t read "::test::foo": no such variable}]


test listbox-7.1 {DeleteEls procedure} -body {
    .l delete 0 end
    .l insert 0 a b c d e f g h i j
    .l selection set 1 6
    .l delete 4 3

    catch {unset x}
    listbox .l -listvar x
    set x [list a b c d]
    catch {set x "this is a \" bad list"} result
    set result
} -cleanup {
    destroy .l
} -match glob -result {can*t set "x": invalid listvar value}
test listbox-21.12 {ListboxListVarProc, cleanup item attributes} -setup {
    destroy .l
} -body {
    set x [list a b c d e f g]
    listbox .l -listvar x
    .l itemconfigure end -fg red
    set x [list a b c d]

test menu-2.127 {entry configuration options 0 -image bogus tearoff} -body {
    .m1 entryconfigure 0 -image bogus
} -returnCodes error -result {unknown option "-image"}

test menu-2.128 {entry configuration options 1 -image bogus command} -body {
    .m1 entryconfigure 1 -image bogus
} -returnCodes error -result {image "bogus" does not exist}

test menu-2.129 {entry configuration options 2 -image bogus cascade} -body {
    .m1 entryconfigure 2 -image bogus
} -returnCodes error -result {image "bogus" does not exist}

test menu-2.130 {entry configuration options 3 -image bogus separator} -body {
    .m1 entryconfigure 3 -image bogus
} -returnCodes error -result {unknown option "-image"}

test menu-2.131 {entry configuration options 4 -image bogus checkbutton} -body {
    .m1 entryconfigure 4 -image bogus
} -returnCodes error -result {image "bogus" does not exist}

test menu-2.132 {entry configuration options 5 -image bogus radiobutton} -body {
    .m1 entryconfigure 5 -image bogus
} -returnCodes error -result {image "bogus" does not exist}

test menu-2.133 {entry configuration options 0 -image {} tearoff} -body {
    .m1 entryconfigure 0 -image
} -returnCodes error -result {unknown option "-image"}

test menu-2.134 {entry configuration options 1 -image {} command} -setup {
    .m1 entryconfigure 1 -image {}

test menu-2.190 {entry configuration options 3 -selectimage bogus separator} -body {
    .m1 entryconfigure 3 -selectimage bogus
} -returnCodes error -result {unknown option "-selectimage"}

test menu-2.191 {entry configuration options 4 -selectimage bogus checkbutton} -body {
    .m1 entryconfigure 4 -selectimage bogus
} -returnCodes error -result {image "bogus" does not exist}

test menu-2.192 {entry configuration options 5 -selectimage bogus radiobutton} -body {
    .m1 entryconfigure 5 -selectimage bogus
} -returnCodes error -result {image "bogus" does not exist}

test menu-2.193 {entry configuration options 0 -selectimage {} tearoff} -body {
    .m1 entryconfigure 0 -selectimage
} -returnCodes error -result {unknown option "-selectimage"}

test menu-2.194 {entry configuration options 1 -selectimage {} command} -body {
    .m1 entryconfigure 1 -selectimage

        .menubar delete Test
    }

    info commands .#menubar*test*
} -cleanup {
    deleteWindows
} -result {}
test menu-32.9 {Ensure deleting of clones does not corrupt menu refs} -setup {
    set res {}
    deleteWindows
} -body {
    menu .menubar
    . configure -menu .menubar
    menu .menubar.test
    .menubar add cascade -menu .menubar.test -label "Test"

} -result {image1}
test menubutton-1.37 {configuration options} -setup {
    catch {image delete bogus}
} -body {
    .mb configure -image bogus
} -cleanup {
    .mb configure -image [lindex [.mb configure -image] 3]
} -returnCodes error -result {image "bogus" does not exist}
test menubutton-1.38 {configuration options} -body {
    .mb configure -indicatoron yes
    .mb cget -indicatoron
} -cleanup {
    .mb configure -indicatoron [lindex [.mb configure -indicatoron] 3]
} -result 1
test menubutton-1.39 {configuration options} -body {

    message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .m
    update
} -body {
    .m configure -font {}
} -cleanup {
    destroy .m
} -returnCodes {error} -result {font "" does not exist}

test message-1.19 {configuration option: "-foreground"} -setup {
    message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .m
    update
} -body {
    .m configure -foreground  green

    lappend result [winfo manager .pack.a]
} -result {{} {}}
test pack-10.4 {bad -in window does not change container window} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    winfo manager .pack.a
    pack .pack.a -in .pack.a
} -returnCodes error -result {cannot pack ".pack.a" inside itself}
test pack-10.5 {prevent management loops} -body {
    frame .f1
    frame .f2
    pack .f1 -in .f2
    pack .f2 -in .f1
} -cleanup {
    destroy .f1
    destroy .f2
} -returnCodes error -result {cannot put ".f2" inside ".f1": would cause management loop}
test pack-10.6 {prevent management loops} -body {
    frame .f1
    frame .f2
    frame .f3
    pack .f1 -in .f2
    pack .f2 -in .f3
    pack .f3 -in .f1
} -cleanup {
    destroy .f1
    destroy .f2
    destroy .f3
} -returnCodes error -result {cannot put ".f3" inside ".f1": would cause management loop}

test pack-11.1 {info option} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    pack .pack.a -in .pack
    set i [pack info .pack.a]
    lindex $i [expr [lsearch -exact $i -in]+1]

} -body {
    pack .foo
} -returnCodes error -result {bad window path name ".foo"}
test pack-12.6 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    pack .pack
} -returnCodes error -result {cannot pack ".pack": it's a top-level window}
test pack-12.7 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    pack .pack.a -after .foo
} -returnCodes error -result {bad window path name ".foo"}
test pack-12.8 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d

} -body {
    pack .pack.a ? 22
} -returnCodes error -result {bad option "?": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side}
test pack-12.33 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    pack .pack.a -in .
} -returnCodes error -result {cannot pack ".pack.a" inside "."}
test pack-12.34 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    frame .pack.a.a
    pack .pack.a.a -in .pack.b
} -returnCodes error -result {cannot pack ".pack.a.a" inside ".pack.b"}
test pack-12.35 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    pack .pack.a -in .pack.a
} -returnCodes error -result {cannot pack ".pack.a" inside itself}
test pack-12.36 {command options and errors} -setup {
    pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
    pack .pack.a .pack.b .pack.c .pack.d
    pack forget .pack.a .pack.d
    pack content .pack
} -result {.pack.b .pack.c}

    lappend result [winfo reqwidth .p]

    # Check that the sash moved
    lappend result [.p sash coord 0]
} -cleanup {
    deleteWindows
} -result [list 42 42 {10 0}]
test panedwindow-17.12 {MoveSash, move left, cannot move outside of window} -setup {
    deleteWindows
} -body {
    panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2
    foreach w {.f1 .f2} c {red blue} {
        .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
    }

    lappend result [winfo reqheight .p]

    # Check that the sash moved
    lappend result [.p sash coord 0]
} -cleanup {
    deleteWindows
} -result [list 42 42 {0 10}]
test panedwindow-18.12 {MoveSash, move up, cannot move outside of window} -setup {
    deleteWindows
} -body {
    panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \
            -orient vertical
    foreach w {.f1 .f2} c {red blue} {
        .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew
    }

    destroy .p .f1 .f2
    expr {[lindex $result 1] - [lindex $result 0]}
} -cleanup {
    deleteWindows
} -result 10


test panedwindow-23.1 {ConfigurePanes, cannot add panedwindow to itself} -setup {
    deleteWindows
} -body {
    panedwindow .p
    .p add .p
} -cleanup {
    deleteWindows
} -returnCodes error -result {cannot add .p to itself}
test panedwindow-23.2 {ConfigurePanes, bad window throws error} -setup {
    deleteWindows
} -body {
    panedwindow .p
    .p add .b
} -cleanup {
    deleteWindows

    deleteWindows
} -body {
    panedwindow .p
    toplevel .t
    .p add .t
} -cleanup {
    deleteWindows
} -returnCodes error -result {cannot add toplevel .t to .p}
test panedwindow-23.25 {ConfigurePanes, restrict possible panes} -setup {
    deleteWindows
} -body {
    panedwindow .p
    frame .f
    button .f.b
   .p add .f.b
} -cleanup {
    deleteWindows
} -returnCodes error -result {cannot add .f.b to .p}
test panedwindow-23.26 {ConfigurePanes, restrict possible panes} -setup {
    deleteWindows
} -body {
    frame .f
    panedwindow .f.p
    button .b
    .f.p add .b

} -result 60


test place-4.1 {ConfigureContent procedure, bad -in options} -setup {
    place forget .t.f2
} -body {
    place .t.f2 -in .t.f2
} -returnCodes error -result {cannot place ".t.f2" relative to itself}
test place-4.2 {ConfigureContent procedure, bad -in option} -setup {
    place forget .t.f2
} -body {
    set result [list [winfo manager .t.f2]]
    catch {place .t.f2 -in .t.f2}
    lappend result [winfo manager .t.f2]
} -result {{} {}}
test place-4.3 {ConfigureContent procedure, bad -in option} -setup {
    place forget .t.f2
} -body {
    winfo manager .t.f2
    place .t.f2 -in .t.f2
} -returnCodes error -result {cannot place ".t.f2" relative to itself}
test place-4.4 {ConfigureContent procedure, bad -in option} -setup {
    place forget .t.f2
} -body {
    place .t.f2 -in .
} -returnCodes error -result {cannot place ".t.f2" relative to "."}
test place-4.5 {ConfigureContent procedure, bad -in option} -setup {
} -body {
    frame .t.f1
    place .t.f1 -in .t.f1
} -returnCodes error -result {cannot place ".t.f1" relative to itself}
test place-4.6 {prevent management loops} -setup {
    place forget .t.f1
} -body {
    place .t.f1 -in .t.f2
    place .t.f2 -in .t.f1
} -returnCodes error -result {cannot put ".t.f2" inside ".t.f1": would cause management loop}
test place-4.7 {prevent management loops} -setup {
    place forget .t.f1
    place forget .t.f2
} -body {
    frame .t.f3
    place .t.f1 -in .t.f2
    place .t.f2 -in .t.f3
    place .t.f3 -in .t.f1
} -returnCodes error -result {cannot put ".t.f3" inside ".t.f1": would cause management loop}

test place-5.1 {ConfigureContent procedure, -relwidth option} -body {
    place .t.f2 -relwidth abcd
} -returnCodes error -result {expected floating-point number or "" but got "abcd"}
test place-5.2 {ConfigureContent procedure, -relwidth option} -setup {
    place forget .t.f2
} -body {

} -body {
    raise_setup
    update
    frame .raise2
    raise .raise.a .raise2
} -cleanup {
    destroy .raise2
} -returnCodes error -result {cannot raise ".raise.a" above ".raise2"}


test raise-5.1 {lower internal windows} -body {
    raise_setup
    update
    lower .raise.d
    raise_getOrder

} -body {
    raise_setup
    update
    frame .raise2
    lower .raise.a .raise2
} -cleanup {
    destroy .raise2
} -returnCodes error -result {cannot lower ".raise.a" below ".raise2"}


test raise-6.1 {raise/lower toplevel windows} -constraints {
	nonPortable
} -body {
    raise_makeToplevels
    update

} -body {
    set y -130
    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
    pack .s
    set y 40q
} -cleanup {
    deleteWindows
} -match glob -returnCodes error -result {can*t set "y": can*t assign non-numeric value to scale variable}
test scale-15.4 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y -130
    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
    pack .s
    catch {set y 40q}
    .s get
} -cleanup {
    deleteWindows
} -result -130
test scale-15.5 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y 1
    scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
    pack .s
    set y x
} -cleanup {
    deleteWindows
} -returnCodes error -match glob -result {can*t set "y": can*t assign non-numeric value to scale variable}
test scale-15.6 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y 1
    scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
    pack .s
    catch {set y x}

##############################################################################

test select-5.1 {Tk_GetSelection procedure} -returnCodes error -setup {
    setup
} -body {
    selection get TEST
} -result {PRIMARY selection does not exist or form "TEST" not defined}
test select-5.2 {Tk_GetSelection procedure} -setup {
    setup
} -body {
    selection get TK_WINDOW
} -result {.f1}
test select-5.3 {Tk_GetSelection procedure} -setup {
    setup
} -body {
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    set selValue "Test value"
    set selInfo ""
    list [selection get TEST] $selInfo
} -result {{Test value} {TEST 0 4000}}
test select-5.4 {Tk_GetSelection procedure} -setup {
    setup
} -returnCodes error -body {
    selection handle .f1 ERROR errHandler
    selection get ERROR
} -result {PRIMARY selection does not exist or form "ERROR" not defined}
test select-5.5 {Tk_GetSelection procedure} -setup {
    setup
} -body {
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {handler STRING}
    list [selection get] $selInfo
} -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}"
test select-5.6 {Tk_GetSelection procedure} -setup {
    setup
} -returnCodes error -body {
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {apply {{type offset count} {
	selection handle .f1 {}
	handler $type $offset $count
    }} STRING}
    selection get
} -result {PRIMARY selection does not exist or form "STRING" not defined}
test select-5.7 {Tk_GetSelection procedure} -setup {
    setup
} -returnCodes error -body {
    set selValue "Test Value"
    set selInfo ""
    selection handle .f1 {apply {{type offset count} {
	destroy .f1
	handler $type $offset $count
    }} STRING}
    selection get
} -result {PRIMARY selection does not exist or form "STRING" not defined}
test select-5.8 {Tk_GetSelection procedure} -setup {
    setup
} -body {
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {apply {{type offset count} {
	selection clear
	handler $type $offset $count
    }} STRING}
    list [selection get] $selInfo [catch {selection get} msg] $msg
} -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection does not exist or form \"STRING\" not defined}"
test select-5.9 {Tk_GetSelection procedure} -constraints x11 -setup {
    setup
    setupbg
} -body {
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    update
    set selValue "Test value"

    set selValue "Test value"
    set selInfo ""
    set result [list [catch {selection get TEST} msg] $msg $selInfo]
    set selValue "Test value2"
    set selInfo ""
    lappend result [catch {selection get -displayof .f2 TEST} msg] $msg \
	    $selInfo
} -result {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection does not exist or form "TEST" not defined} {}}
test select-5.13 {Tk_GetSelection procedure} -constraints {
    x11 altDisplay
} -setup {
    setup .f1
    setup .f2 $env(TK_ALT_DISPLAY)
    setupbg
} -body {

    update
    set result ""
    lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"]
    set selValue "Test value2"
    lappend result [dobg "selection get TEST"]
    cleanupbg
    lappend result $selInfo
} -result {{PRIMARY selection does not exist or form "TEST" not defined} {Test value2} {TEST 0 4000}}
test select-5.15 {Tk_GetSelection procedure} -setup {
    setup
    if {[llength [info command ::bgerror]]} {
	rename ::bgerror ::TMPbgerror
    }
    set ::bgerrors {}
} -body {
    proc ::bgerror msg {lappend ::bgerrors $msg}
    selection handle -type ERROR .f1 errHandler
    list [catch {selection get ERROR} msg] $msg [update] {*}$::bgerrors
} -cleanup {
    rename ::bgerror {}
    if {[llength [info command ::TMPbgerror]]} {
	rename ::TMPbgerror ::bgerror
    }
} -result {1 {PRIMARY selection does not exist or form "ERROR" not defined} {} {selection handler aborted}}

##############################################################################

test select-6.1 {Tk_SelectionCmd procedure} -returnCodes error -body {
    selection
} -result {wrong # args: should be "selection option ?arg ...?"}
# selection clear

test select-6.39 {Tk_SelectionCmd procedure} -returnCodes error -body {
    selection foo
} -result {bad option "foo": must be clear, get, handle, or own}

##############################################################################

# This test is non-portable because some old X11/News servers ignore a
# selection request when the window does not exist, which causes a different
# error message.
test select-7.1 {TkSelDeadWindow procedure} -constraints nonPortable -setup {
    setup
} -body {
    selection handle .f1 { handler TEST }
    set result [selection own]
    destroy .f1
    lappend result [selection own] [catch {selection get} msg] $msg
} -result {.f1 {} 1 {PRIMARY selection does not exist or form "STRING" not defined}}

##############################################################################

# Check reentrancy on losing selection
test select-8.1 {TkSelEventProc procedure} -constraints x11 -setup {
    setup
    setupbg

    vwait [namespace which -variable x]
    puts $fd {exit}
    flush $fd
    # Don't understand why, but the [loadTkCommand] above causes
    # a "broken pipe" error when Tk was actually [load]ed in the child.
    catch {close $fd}
    lappend x $selInfo
} -result {{1:PRIMARY selection does not exist or form "STRING" not defined} {}}
test select-10.2 {ConvertSelection procedure} -constraints x11 -setup {
    setup
    setupbg
} -body {
    set selValue [string range $longValue 0 3999]
    set selInfo ""
    selection handle .f1 {handler STRING}
    set result ""
    lappend result [dobg {selection get}]
    cleanupbg
    lappend result $selInfo
} -result [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}]
test select-10.3 {ConvertSelection procedure} -constraints x11 -setup {
    setup
    setupbg
} -body {
    selection handle .f1 ERROR errHandler
    dobg {selection get ERROR}
} -cleanup {
    cleanupbg
} -result {PRIMARY selection does not exist or form "ERROR" not defined}
# testing timers
# This one hangs in Exceed
test select-10.4 {ConvertSelection procedure} -constraints {
    x11 noExceed failsOnUbuntu
} -setup {
    setup
    setupbg

    set selInfo ""
    selection handle -type TEST .f1 { handler TEST }
    selection handle -type STRING .f1 { badHandler .f1 STRING }
    set result ""
    lappend result [dobg {selection get}]
    cleanupbg
    lappend result $selInfo
} -result {{PRIMARY selection does not exist or form "STRING" not defined} {.f1 STRING 0 4000}}
test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints {
    x11 failsOnUbuntu
} -setup {
    setup
    setupbg
} -body {
    proc weirdHandler {type offset count} {
	destroy .f1
	handler $type $offset $count
    }
    set selValue $longValue
    set selInfo ""
    selection handle .f1 {weirdHandler STRING}
    set result ""
    lappend result [dobg {selection get}]
    cleanupbg
    lappend result $selInfo
} -cleanup {
    rename weirdHandler {}
} -result {{PRIMARY selection does not exist or form "STRING" not defined} {STRING 0 4000}}

##############################################################################

# testing reentrancy
test select-11.1 {TkSelPropProc procedure} -constraints {x11 failsOnUbuntu} -setup {
    setup
    setupbg

    set selInfo ""
    selection handle .f1 {badHandler .f1 STRING}
    set result ""
    set abortCount 2
    lappend result [dobg {selection get}]
    cleanupbg
    lappend result $selInfo
} -result {{PRIMARY selection does not exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}

test select-14.1 {Bug [73ba07efcd]: Use correct property type when handling MULTIPLE conversion requests} -constraints {
    cliboardManagerPresent
} -setup {
    proc get_clip {offset maxChars} {return abcd}
} -body {
    selection handle -selection CLIPBOARD . get_clip

        -relief sunken
    pack .e
    update
} -body {
    .e configure -font {}
} -cleanup {
    destroy .e
} -returnCodes {error} -result {font "" does not exist}

test spinbox-1.28 {configuration option: "foreground"} -setup {
        spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \
        -relief sunken
    pack .e
    update
} -body {

    .e select from 1
    .e select to 4
    update
    .e select clear
    selection get
} -cleanup {
    destroy .e
} -returnCodes error -result {PRIMARY selection does not exist or form "STRING" not defined}
test spinbox-3.50.1 {SpinboxWidgetCmd procedure, "select clear" widget command} -setup {
    spinbox .e
    pack .e
    update
} -body {
    .e insert end "0123456789"
    .e select from 1

    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    .e configure -exportselection 0
    selection get
} -cleanup {
    destroy .e
} -returnCodes error -result {PRIMARY selection does not exist or form "STRING" not defined}
test spinbox-5.6.1 {ConfigureSpinbox procedure} -setup {
    spinbox .e
    pack .e
} -body {
    .e insert end "0123456789"
    .e select from 1
    .e select to 5

    catch {.s set mystring} result1
    catch {.s insert 0 mystring} result2
    catch {.s delete 0} result3
    catch {.s invoke buttonup} result4
    list $result1 $result2 $result3 $result4
} -cleanup {
    destroy .s
} -match glob -result [list {can*t set "myvar": Intentional error here!} \
    {can*t set "myvar": Intentional error here!} \
    {can*t set "myvar": Intentional error here!} \
    {can*t set "myvar": Intentional error here!}]

test spinbox-25.1 {textvariable lives in a non-existing namespace} -setup {
    destroy .s
} -body {
    catch {spinbox .s -textvariable thisnsdoesntexist::myvar} result1
    set result1
} -cleanup {
    destroy .s
} -match glob -result {can*t trace "thisnsdoesntexist::myvar": parent namespace does*t exist}
test spinbox-25.3 {Bugs [2a32225cd1] and [9fa3e08243]} -setup {
    destroy .s
    pack [spinbox .s]
    update
    set res {}
} -body {
    .s insert end "A sample text"

        # image from higer interp should not be visible by 'tk systray'
        tk systray create -image _book -text "second interp"
    }
} -cleanup {
    tk systray destroy
    image delete _book
    interp delete second
} -returnCodes {error} -result {image "_book" does not exist}

test systray-15 {systray icon creation, create one per interp} -setup {
    image create photo _book -data R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAACwAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IMQCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc0yv+DVSEUuFxIAOw==
} -body {
    tk systray create -image _book -text "first interp"
    interp create second
    # load Tk into the 'second' interp

    .t2 insert insert 1234657890
    .t2 tag add sel 1.0 1.4
    selection get
    .t2 configure -exportselection 0
    selection get
} -cleanup {
    destroy .t .t2
} -returnCodes error -result {PRIMARY selection does not exist or form "STRING" not defined}
test text-14.17 {ConfigureText procedure} -body {
    text .t
    entry .t.e
    .t.e insert end abcdefg
    .t.e select from 0
    text .t2 -exportselection 1
    .t2 insert insert 1234657890

    .t insert 1.0 "abcdef\nghijk\n1234"
    .t tag add sel 1.0 1.3
    selection get
    selection clear
    selection get
} -cleanup {
    destroy .t
} -returnCodes error -result {PRIMARY selection does not exist or form "STRING" not defined}
test text-21.4 {TkTextLostSelection procedure} -body {
    text .t
    .t insert 1.0 "abcdef\nghijk\n1234"
    .t tag add sel 1.0 1.3
    set x [selection get]
    selection clear
    catch {selection get}

test text-22.56 {TextSearchCmd procedure, error setting variable} -body {
    text .t
    .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
    set a 44
    .t search -count a(2) xyz 1.0
} -cleanup {
    destroy .t
} -returnCodes {error} -match glob -result {can*t set "a(2)": variable isn't array}
test text-22.57 {TextSearchCmd procedure, wrap-around} -body {
    text .t
    .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
    .t search -backwards xyz 1.1
} -cleanup {
    destroy .t
} -result {3.5}

    for {set i 1} {$i < 20} {incr i} {
	   .t insert end "Line $i\n"
    }
    .t tag delete sel
    .t index sel.first
} -cleanup {
    destroy .t
} -returnCodes {error} -result {text does not contain any characters tagged with "sel"}


test text-32.1 {line heights on creation} -setup {
    text .t
    proc makeText {} {
        set w .g
        set font "Times 11"

    list [catch {.t index x.gorp} msg] $msg
} {1 {bad text index "x.gorp"}}
test textIndex-4.5 {TkTextGetIndex, tags} {
    list [catch {.t index foo.last} msg] $msg
} {1 {bad text index "foo.last"}}
test textIndex-4.6 {TkTextGetIndex, tags} {
    list [catch {.t index y.first} msg] $msg
} {1 {text does not contain any characters tagged with "y"}}
test textIndex-4.7 {TkTextGetIndex, tags} {
    list [catch {.t index x.last,} msg] $msg
} {1 {bad text index "x.last,"}}
test textIndex-4.8 {TkTextGetIndex, tags} {
    .t tag add z 1.0
    set result [list [.t index z.first] [.t index z.last]]
    .t tag delete z

    lappend res [.t2 index .f] $msg
    .t2 tag add mytag 1.3
    catch {.p2 index mytag.first} msg
    lappend res [.t2 index mytag.first] $msg
    destroy .t2 .p2
    set res
} {1.0 {bad text index "mymark"} 1.0 {bad text index "redsquare"} 1.2\
   {bad text index ".f"} 1.3 {text does not contain any characters tagged with "mytag"}}

# cleanup
rename textimage {}
catch {destroy .t}
cleanupTests
return

    .t insert 1.0 "Some sample text"
    frame .f
    frame .f.f -width 15 -height 20 -bg $color
    pack .f.f
    .t window create 1.3 -window .f.f
} -cleanup {
    destroy .f
} -returnCodes error -result {cannot embed .f.f in .t}

test textWind-3.8 {EmbWinConfigure procedure} -setup {
    destroy .t2
} -body {
    .t insert 1.0 "Some sample text"
    toplevel .t2 -width 20 -height 10 -bg $color
    .t window create 1.3
    .t window configure 1.3 -window .t2
} -cleanup {
    destroy .t2
} -returnCodes error -result {cannot embed .t2 in .t}

test textWind-3.9 {EmbWinConfigure procedure} -setup {
    destroy .t2
} -body {
    .t insert 1.0 "Some sample text"
    toplevel .t2 -width 20 -height 10 -bg $color
    .t window create 1.3
    catch {.t window configure 1.3 -window .t2}
    .t window configure 1.3 -window
} -cleanup {
    destroy .t2
} -result {-window {} {} {} {}}

test textWind-3.10 {EmbWinConfigure procedure} -setup {
    .t delete 1.0 end
} -body {
    .t insert 1.0 "Some sample text"
    .t window create 1.3
    .t window configure 1.3 -window .t
} -returnCodes error -result {cannot embed .t in .t}

test textWind-3.11 {EmbWinConfigure procedure} -setup {
    .t delete 1.0 end
} -body {
    # This test checks for various errors when the text claims
    # a window away from itself.
    .t insert 1.0 "Some sample text"

        after 10
    }
    lappend msg [.t bbox 1.5] [winfo exists .t.f.f]
} -cleanup {
    destroy .t.f
    rename bgerror {}
} -result [list \
    {{cannot embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} \
    [list [xchar 5] [expr {[yline 1]+$fixedHeight/2}] 0 0] \
    1]

test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -setup {
    .t delete 1.0 end
    destroy .t.f
    proc bgerror args {

        frame .t.f.f -width 10 -height 20 -bg $color
    }
    update
    lappend msg [winfo exists .t.f.f]
} -cleanup {
    destroy .t.f
    rename bgerror {}
} -result {{{cannot embed .t.f.f relative to .t}} 1}

test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -setup {
    .t delete 1.0 end
    proc bgerror args {
        global msg
        if {[lsearch -exact $msg $args] < 0} {
            lappend msg $args

    }
    set msg {}
    update
    lappend msg [.t bbox 1.5]
} -cleanup {
    rename bgerror {}
} -result [list \
    {{cannot embed .t relative to .t}} \
    [list [xchar 5] [expr {[yline 1]+$fixedHeight/2}] 0 0]]

test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -setup {
    .t delete 1.0 end
    destroy .t2
    proc bgerror args {
        global msg

    }
    set msg {}
    update idletasks ; after 100 ; update
    lappend msg [.t bbox 1.5]
} -cleanup {
    rename bgerror {}
} -result [list \
    {{cannot embed .t2 relative to .t}} {{window name "t2" already exists in parent}} \
    [list [xchar 5] [expr {[yline 1]+$fixedHeight/2}] 0 0]]

test textWind-10.8 {EmbWinLayoutProc procedure, error in creating window} -setup {
    .t delete 1.0 end
    destroy .t2
    proc bgerror args {
        global msg

    update
    set i 0
    while {[llength $msg] == 1 && [incr i] < 200} { update }
    return $msg
} -cleanup {
    destroy .t2
    rename bgerror {}
} -result {{{cannot embed .t2 relative to .t}} {{window name "t2" already exists in parent}}}

test textWind-10.9 {EmbWinLayoutProc procedure, steal window from self} -setup {
    .t delete 1.0 end
    destroy .t.b
} -body {
    .t insert 1.0 ABCDEFGHIJKLMNOP
    button .t.b -text "Hello!"

    tk useinputmethods -displayof . xyz
} -returnCodes error -result {expected boolean value but got "xyz"}
test tk-4.6 {tk command: useinputmethods: set new} -body {
    # This isn't really a test, but more of a check... The answer is what was
    # given, because we may be on a Unix system that doesn't have the XIM
    # stuff
    if {[tk useinputmethods 1] == 0} {
	puts "this wish does not have XIM (X Input Methods) support"
    }
    return $useim
} -result $useim
test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body {
    # Mac and Windows don't have X Input Methods, so this should always return
    # 0
    tk useinputmethods 1

test entry-4.1 "Selection test" -body {
    selection get
} -result asdfasdf

test entry-4.2 "Disable -exportselection" -body {
    .e configure -exportselection false
    selection get
} -returnCodes error -result "PRIMARY selection does not exist*" -match glob

test entry-4.3 "Reenable -exportselection" -body {
    .e configure -exportselection true
    selection get
} -result asdfasdf

test entry-4.4 "Force selection loss" -body {

test entry-8.2 "Unset linked variable by deleting namespace" -body {
    namespace eval ::test  { variable foo "bar" }
    pack [ttk::entry .e -textvariable ::test::foo]
    namespace delete ::test
    .e insert end "baz"		;# <== error here
    list [.e cget -textvariable] [.e get] [set foo]
} -returnCodes error -result "*parent namespace does*t exist*" -match glob
# '-result [list ::test::foo "baz" "baz"]' would also be sensible,
# but Tcl namespaces don't work that way.

test entry-8.2a "Followup to test 8.2" -body {
    .e cget -textvariable
} -result ::test::foo -cleanup { destroy .e }
# For 8.2a, -result {} would also be sensible.

package require tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands

test image-1.1 "Bad image element" -body {
    ttk::style element create BadImage image badimage
} -returnCodes error -result {image "badimage" does not exist}

test image-1.2 "Duplicate element" -setup {
    image create photo test.element -width 10 -height 10
    ttk::style element create testElement image test.element
} -body {
    ttk::style element create testElement image test.element
} -returnCodes error -result "Duplicate element testElement"

package require tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands

test labelframe-1.0 "Setup" -body {
    pack [ttk::labelframe .lf] -expand true -fill both
}

test labelframe-2.1 "Can't use indirect descendant as labelwidget" -body {
    ttk::frame .lf.t
    ttk::checkbutton .lf.t.cb
    .lf configure -labelwidget .lf.t.cb
} -returnCodes error -result "cannot *" -match glob \
  -cleanup { destroy .lf.t } ;

test labelframe-2.2 "Can't use toplevel as labelwidget" -body {
    toplevel .lf.t
    .lf configure -labelwidget .lf.t
} -returnCodes error -result "cannot *" -match glob \
  -cleanup { destroy .lf.t } ;

test labelframe-2.3 "Can't use non-windows as -labelwidget" -body {
    .lf configure -labelwidget BogusWindowName
} -returnCodes error -result {bad window path name "BogusWindowName"}

test labelframe-2.4 "Can't use nonexistent-windows as -labelwidget" -body {

    .nb add [frame .sibling]
} -returnCodes error -result "*" -match glob

test notebook-1.3 "Cannot add toplevel" -body {
    .nb add [toplevel .nb.t]
} -cleanup {
    destroy .t.nb
} -returnCodes error -match glob -result "cannot add .nb.t*"

test notebook-1.4 "Try to select bad tab" -body {
    .nb select @6000,6000
} -returnCodes error -match glob -result "* not found"

#
# Now add stuff:

test ttk-3.2 "Propagate errors from variable traces" -body {
    set A 0
    trace add variable A write {error "failure" ;# }
    ttk::checkbutton .cb -variable A
    .cb invoke
} -cleanup {
    unset ::A ; destroy .cb
} -returnCodes error -match glob -result {can*t set "A": failure}

test ttk-3.3 "Constructor failure with cursor" -body {
    ttk::button .b -cursor bottom_right_corner -style BadStyle
} -returnCodes error -result "Layout BadStyle not found"

test ttk-3.4 "SF#2009213" -body {
    ttk::style configure TScale -sliderrelief {}

    icon blank
} -cleanup { destroy .b }

#------------------------------------------------------------------------

test ttk-9.1 "Traces on nonexistant namespaces" -body {
    ttk::checkbutton .tcb -variable foo::bar
} -returnCodes error -result "*parent namespace does*t exist*" -match glob

test ttk-9.2 "Traces on nonexistant namespaces II" -body {
    ttk::checkbutton .tcb -variable X
    .tcb configure -variable foo::bar
} -returnCodes error -result "*parent namespace does*t exist*" -match glob

test ttk-9.3 "Restore saved options on configure error" -body {
    .tcb cget -variable
} -result X

test ttk-9.4 "Textvariable tests" -body {
    set tcbLabel "Testing..."

#
# See #793909
#

test ttk-14.1 "-variable in nonexistant namespace" -body {
    ttk::checkbutton .tw -variable ::nsn::foo
} -returnCodes error -result {can*t trace *: parent namespace does*t exist} \
  -match glob -cleanup { destroy .tw }

test ttk-14.2 "-textvariable in nonexistant namespace" -body {
    ttk::label .tw -textvariable ::nsn::foo
} -returnCodes error -result {can*t trace *: parent namespace does*t exist} \
  -match glob -cleanup { destroy .tw }

test ttk-14.3 "-textvariable in nonexistant namespace" -body {
    ttk::entry .tw -textvariable ::nsn::foo
} -returnCodes error -result {can*t trace *: parent namespace does*t exist} \
  -match glob -cleanup { destroy .tw }

test ttk-15.1 {Bug 3062331} -setup {
    destroy .b
} -body {
    set Y {}
    ttk::button .b -textvariable Y

test ttk-ensemble-5 "style element create: valid" -body {
     ttk::style element create plain.background from default
} -returnCodes 0 -result ""

test ttk-16.1 {ttk::style theme styles - no such theme} -body {
    ttk::style theme styles noSuchTheme
} -returnCodes 1 -result {theme "noSuchTheme" does not exist}
test ttk-16.2 {ttk::style theme styles - theme exists} -body {
    # simply check this produces a list with some style names,
    # without checking exact content (not needed, and may vary
    # depending on platform, versions, improvements...)
    expr {[llength [ttk::style theme styles alt]] > 0}
} -result 1


destroy {*}[winfo children .]

tcltest::cleanupTests

#*EOF*

proc getsize {} {
    update
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}

test unixfont-1.1 {TkpGetNativeFont procedure: not native} {x11 noExceed} {
    list [catch {font measure {} xyz} msg] $msg
} {1 {font "" does not exist}}
test unixfont-1.2 {TkpGetNativeFont procedure: native} {x11 failsOnUbuntu} {
    font measure fixed 0
} 6

test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} x11 {
    font actual {-size 10}
    set x {}

    destroy .t
    destroy .icon
    toplevel .t -width 100 -height 30
    wm geometry .t +0+0
    toplevel .icon -width 50 -height 50 -bg red
    wm iconwindow .t .icon
    list [catch {wm withdraw .icon} msg] $msg
} {1 {cannot withdraw .icon: it is an icon for .t}}
test unixWm-8.2 {icon windows} unix {
    destroy .t
    toplevel .t -width 100 -height 30
    list [catch {wm iconwindow} msg] $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-8.3 {icon windows} unix {
    destroy .t

    list [catch {wm iconwindow .t .gorp} msg] $msg
} {1 {bad window path name ".gorp"}}
test unixWm-8.6 {icon windows} unix {
    destroy .t
    toplevel .t -width 100 -height 30
    frame .t.icon -width 50 -height 50 -bg red
    list [catch {wm iconwindow .t .t.icon} msg] $msg
} {1 {cannot use .t.icon as icon window: not at top level}}
test unixWm-8.7 {icon windows} unix {
    destroy .t
    destroy .icon
    toplevel .t -width 100 -height 30
    wm geom .t +0+0
    toplevel .icon -width 50 -height 50 -bg red
    toplevel .icon2 -width 50 -height 50 -bg green

    list [catch {wm aspect .t 13 14 bar 16} msg] $msg
} {1 {expected integer but got "bar"}}
test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} unix {
    list [catch {wm aspect .t 13 14 15 baz} msg] $msg
} {1 {expected integer but got "baz"}}
test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} unix {
    list [catch {wm aspect .t 0 14 15 16} msg] $msg
} {1 {aspect number cannot be <= 0}}
test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} unix {
    list [catch {wm aspect .t 13 0 15 16} msg] $msg
} {1 {aspect number cannot be <= 0}}
test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} unix {
    list [catch {wm aspect .t 13 14 0 16} msg] $msg
} {1 {aspect number cannot be <= 0}}
test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} unix {
    list [catch {wm aspect .t 13 14 15 0} msg] $msg
} {1 {aspect number cannot be <= 0}}

test unixWm-13.1 {Tk_WmCmd procedure, "client" option} unix {
    list [catch {wm client .t x y} msg] $msg
} {1 {wrong # args: should be "wm client window ?name?"}}
test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} {
    set result {}
    lappend result [wm client .t]

test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix {
    destroy .icon
    toplevel .icon -width 50 -height 50 -bg red
    wm iconwindow .t .icon
    set result [list [catch {wm deiconify .icon} msg] $msg]
    destroy .icon
    set result
} {1 {cannot deiconify .icon: it is an icon for .t}}
test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {unix failsOnUbuntu failsOnXQuarz} {
    wm iconify .t
    set result {}
    lappend result [winfo ismapped .t] [wm state .t]
    wm deiconify .t
    lappend result [winfo ismapped .t] [wm state .t]
} {0 iconic 1 normal}

    lappend result [wm grid .t]
} {{} {5 6 20 10} {}}
test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t bad 10 11 12} msg] $msg
} {1 {expected integer but got "bad"}}
test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t -1 11 12 13} msg] $msg
} {1 {baseWidth cannot be < 0}}
test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t 10 foo 12 13} msg] $msg
} {1 {expected integer but got "foo"}}
test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t 10 -11 12 13} msg] $msg
} {1 {baseHeight cannot be < 0}}
test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t 10 11 bar 13} msg] $msg
} {1 {expected integer but got "bar"}}
test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t 10 11 -2 13} msg] $msg
} {1 {widthInc cannot be <= 0}}
test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t 10 11 12 bogus} msg] $msg
} {1 {expected integer but got "bogus"}}
test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} unix {
    list [catch {wm grid .t 10 11 12 -1} msg] $msg
} {1 {heightInc cannot be <= 0}}

destroy .t
destroy .icon
toplevel .t -width 100 -height 50
wm geom .t +0+0
update

test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} unix {
    destroy .t2
    toplevel .t2
    wm overrideredirect .t2 1
    set result [list [catch {wm iconify .t2} msg] $msg]
    destroy .t2
    set result
} {1 {cannot iconify ".t2": override-redirect flag is set}}
test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} unix {
    destroy .t2
    toplevel .t2
    wm geom .t2 +0+0
    wm transient .t2 .t
    set result [list [catch {wm iconify .t2} msg] $msg]
    destroy .t2
    set result
} {1 {cannot iconify ".t2": it is a transient}}
test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} unix {
    destroy .t2
    toplevel .t2
    wm geom .t2 +0+0
    wm iconwindow .t .t2
    set result [list [catch {wm iconify .t2} msg] $msg]
    destroy .t2
    set result
} {1 {cannot iconify ".t2": it is an icon for ".t"}}
test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu failsOnXQuarz} {
    destroy .t2
    toplevel .t2
    wm geom .t2 +0+0
    update idletasks
    wm iconify .t2
    update idletasks

} {1 {bad window path name "bogus"}}
test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} unix {
    destroy .b
    button .b -text Help
    set result [list [catch {wm iconwindow .t .b} msg] $msg]
    destroy .b
    set result
} {1 {cannot use .b as icon window: not at top level}}
test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} unix {
    destroy .icon
    toplevel .icon -width 50 -height 50 -bg green
    destroy .t2
    toplevel .t2
    wm geom .t2 -0+0
    wm iconwindow .t2 .icon

    destroy .t2
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    wm iconwindow .t .t2
    set result [list [catch {wm withdraw .t2} msg]  $msg]
    destroy .t2
    set result
} {1 {cannot withdraw .t2: it is an icon for .t}}
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix {
    set result {}
    wm withdraw .t
    lappend result [wm state .t] [winfo ismapped .t]
    wm deiconify .t
    lappend result [wm state .t] [winfo ismapped .t]
} {withdrawn 0 normal 1}

    deleteWindows
} -body {
    toplevel .t1 -width 300 -height 150 -visual $other
    wm geometry .t1 +0+0
    toplevel .t2 -width 400 -height 50 -colormap .t1
} -cleanup {
    deleteWindows
} -returnCodes error -result {cannot use colormap for .t1: incompatible visuals}


test visual-8.1 {Tk_FreeColormap procedure} -setup {
    deleteWindows
} -body {
    toplevel .t1 -width 300 -height 180 -colormap new
    wm geometry .t1 +0+0

test winClipboard-1.1 {TkSelGetSelection} -constraints win -setup {
    clipboard clear
} -body {
    selection get -selection CLIPBOARD
} -cleanup {
    clipboard clear
} -returnCodes error -result {CLIPBOARD selection does not exist or form "STRING" not defined}

test winClipboard-1.2 {TkSelGetSelection} -constraints {
    win testclipboard
} -setup {
    clipboard clear
} -body {
    clipboard append {}

                      -initialfile "5 7 8.aaa" -title Foo]}
    then {
        Click ok
    }
    return $x
} -result [file join [initialdir] "5 7 8.aaa"]

test winDialog-5.8 {GetFileName: extension does not begin with .} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    set msg {}
    then {
	if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
	    Click cancel

    return $x
} -result [file join [initialdir] "12x 455"]

test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints {
    nt tcl8
} -body {
    tk_getOpenFile -initialdir ~12x/455
} -returnCodes error -result {user "12x" does not exist}

test winDialog-5.12.1 {tk_getSaveFile: initial directory: ~} -constraints {
    nt testwinevent tcl8
} -body {
    unset -nocomplain x
    start {set x [tk_getSaveFile \
                      -initialdir ~ \

    file tail $x
} -result "12x 456"
test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints {
    nt tcl8
} -body {
#        if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
    tk_getOpenFile -initialfile ~12x/455
} -returnCodes error -result {user "12x" does not exist}
if {![vista?]} {
    # XXX - disabled for Vista because the new dialogs allow long file
    # names to be specified but force the user to change it.
    test winDialog-5.15 {GetFileName: initial file: long name} -constraints {
        nt testwinevent
    } -body {
        start {

test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints {
    nt tcl8
} -body {
#        if (Tcl_TranslateFileName(interp, string,
#            &utfDirString) == NULL)

    tk_chooseDirectory -initialdir ~12x/455
} -returnCodes error -result {user "12x" does not exist}


test winDialog-10.1 {Tk_FontchooserObjCmd: no arguments} -constraints {
    nt testwinevent
} -body {
    start {tk fontchooser show}
    list [then {

test winfont-1.1 {TkpGetNativeFont procedure: not native} -constraints {
    win
} -body {
    catch {font delete xyz}
    font measure {} xyz
} -returnCodes error -result {font "" does not exist}
test winfont-1.2 {TkpGetNativeFont procedure: native} -constraints win -body {
    font measure ansifixed 0
    font measure ansi 0
    font measure device 0
    font measure oemfixed 0
    font measure systemfixed 0
    font measure system 0

    wm iconify .
    update
    wm deiconify .
    update
    wm iconify .t
} -cleanup {
    destroy .t
} -returnCodes error -result {cannot iconify ".t": it is a transient}
test winWm-1.3 {TkWmMapWindow} -constraints win -setup {
    destroy .t
} -body {
    toplevel .t
    update
    toplevel .t2
    update

    bind .t <Destroy> {button .t.b -text hello; pack .t.b}
    update
    destroy .t
    update
    set x
} -cleanup {
    rename bgerror {}
} -result {{cannot create window: parent has been destroyed} {cannot create window: parent has been destroyed
    while executing
"button .t.b -text hello"
    (command bound to event)}}


# Most of the tests below don't produce meaningful results;  they
# will simply dump core if there are bugs.

        set error 1
    } else {
        set error 0
    }
    removeFile script
    list $error $msg
} -result {0 {waiting
ringing the bell -> cannot invoke "bell" command: application has been destroyed
done waiting
bell -> cannot invoke "bell" command: application has been destroyed
update -> }}


test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints {
    unix testmenubar
} -setup {
    destroy .t

    winfo pathname -displayof geek 25
} -returnCodes error -result {bad window path name "geek"}
test winfo-7.5 {"winfo pathname" command} -body {
    winfo pathname xyz
} -returnCodes error -result {expected integer but got "xyz"}
test winfo-7.6 {"winfo pathname" command} -body {
    winfo pathname 224
} -returnCodes error -result {window id "224" does not exist in this application}
test winfo-7.7 {"winfo pathname" command} -setup {
    destroy .b
    button .b -text "Help"
    update
} -body {
    winfo pathname -displayof .b [winfo id .]
} -cleanup {

    wm aspect . 13 14 bar 16
} -result {expected integer but got "bar"}
test wm-aspect-1.8 {usage} -returnCodes error -body {
    wm aspect . 13 14 15 baz
} -result {expected integer but got "baz"}
test wm-aspect-1.9 {usage} -returnCodes error -body {
    wm aspect . 0 14 15 16
} -result {aspect number cannot be <= 0}
test wm-aspect-1.10 {usage} -returnCodes error -body {
    wm aspect . 13 0 15 16
} -result {aspect number cannot be <= 0}
test wm-aspect-1.11 {usage} -returnCodes error -body {
    wm aspect . 13 14 0 16
} -result {aspect number cannot be <= 0}
test wm-aspect-1.12 {usage} -returnCodes error -body {
    wm aspect . 13 14 15 0
} -result {aspect number cannot be <= 0}

test wm-aspect-2.1 {setting and reading values} -setup {
    set result {}
} -body {
    lappend result [wm aspect .t]
    wm aspect .t 3 4 10 2
    lappend result [wm aspect .t]

test wm-attributes-1.3.8 {override-redirect not compatible with fullscreen attribute} -constraints win -body {
    toplevel .t
    update
    wm overrideredirect .t 1
    wm attributes .t -fullscreen 1
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot set fullscreen attribute for ".t": override-redirect flag is set}
test wm-attributes-1.3.9 {max height too small} -constraints win -body {
    toplevel .t
    update
    wm maxsize .t 5000 450
    wm attributes .t -fullscreen 1
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot set fullscreen attribute for ".t": max width/height is too small}
test wm-attributes-1.3.10 {max height too small} -constraints win -body {
    toplevel .t
    update
    wm maxsize .t 450 5000
    wm attributes .t -fullscreen 1
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot set fullscreen attribute for ".t": max width/height is too small}
test wm-attributes-1.3.11 {another attribute, then -fullscreen} -constraints win -body {
    toplevel .t
    update
    wm attributes .t -alpha 1.0 -fullscreen 1
    wm attributes .t -fullscreen
} -cleanup {
    deleteWindows

    destroy .icon
} -body {
    toplevel .icon -width 50 -height 50 -bg red
    wm iconwindow .t .icon
    wm deiconify .icon
} -returnCodes error -cleanup {
    destroy .icon
} -result {cannot deiconify .icon: it is an icon for .t}
# test embedded window for Windows
test wm-deiconify-1.5 {usage} -constraints win -setup {
    destroy .embed
} -body {
    frame .t.f -container 1
    toplevel .embed -use [winfo id .t.f]
    wm deiconify .embed
} -returnCodes error -cleanup {
    destroy .t.f .embed
} -result {cannot deiconify .embed: the container does not support the request}
# test embedded window for other platforms
test wm-deiconify-1.6 {usage} -constraints !win -setup {
    destroy .embed
} -body {
    frame .t.f -container 1
    toplevel .embed -use [winfo id .t.f]
    wm deiconify .embed
} -returnCodes error -cleanup {
    destroy .t.f .embed
} -result {cannot deiconify .embed: it is an embedded window}

deleteWindows
test wm-deiconify-2.1 {a window that has never been mapped\
        should not be mapped by a call to deiconify} -body {
    toplevel .t
    wm deiconify .t
    winfo ismapped .t

    wm grid . 13 14 bar 16
} -result {expected integer but got "bar"}
test wm-grid-1.8 {usage} -returnCodes error -body {
    wm grid . 13 14 15 baz
} -result {expected integer but got "baz"}
test wm-grid-1.9 {usage} -returnCodes error -body {
    wm grid . -1 14 15 16
} -result {baseWidth cannot be < 0}
test wm-grid-1.10 {usage} -returnCodes error -body {
    wm grid . 13 -1 15 16
} -result {baseHeight cannot be < 0}
test wm-grid-1.11 {usage} -returnCodes error -body {
    wm grid . 13 14 -1 16
} -result {widthInc cannot be <= 0}
test wm-grid-1.12 {usage} -returnCodes error -body {
    wm grid . 13 14 15 -1
} -result {heightInc cannot be <= 0}

test wm-grid-2.1 {setting and reading values} -setup {
    set result {}
} -body {
    lappend result [wm grid .t]
    wm grid .t 3 4 10 2
    lappend result [wm grid .t]

test wm-iconbadge-1.4 {::tk::icons::base_icon($win) must be a Tk photo on X11} -constraints {
    x11
} -setup {
    catch {image delete book}
} -body {
    set ::tk::icons::base_icon(.) book
    wm iconbadge . 27
} -returnCodes error -result {cannot use "book" as iconphoto: not a photo image}
test wm-iconbadge-1.5 {illegal badge number} -body {
    image create photo book -data {
        R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC
        wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM
        QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc
        0yv+DVSEUuFxIAOw==
    }
    set ::tk::icons::base_icon(.) book
    wm iconbadge . illegal
} -cleanup {
    image delete book
} -returnCodes error -result {cannot use "illegal" as icon badge}
test wm-iconbadge-1.6 {non-integer badge number} -body {
    image create photo book -data {
        R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC
        wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM
        QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc
        0yv+DVSEUuFxIAOw==
    }
    set ::tk::icons::base_icon(.) book
    wm iconbadge . 3.2
} -cleanup {
    image delete book
} -returnCodes error -result {cannot use "3.2" as icon badge}
test wm-iconbadge-1.7 {negative or zero badge number} -body {
    image create photo book -data {
        R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC
        wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM
        QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc
        0yv+DVSEUuFxIAOw==
    }
    set ::tk::icons::base_icon(.) book
    wm iconbadge . 0
} -cleanup {
    image delete book
} -returnCodes error -result {cannot use "0" as icon badge}
test wm-iconbadge-1.8 {usage, no need to call iconphoto on aqua or win32} -constraints {
    aquaOrWin32
} -body {
    wm iconbadge . 3
    wm iconbadge . 5000
    wm iconbadge . !
    wm iconbadge . ""

destroy .t2
test wm-iconify-2.1 {Misc errors} -body {
    toplevel .t2
    wm overrideredirect .t2 1
    wm iconify .t2
} -returnCodes error -cleanup {
    destroy .t2
} -result {cannot iconify ".t2": override-redirect flag is set}
test wm-iconify-2.2 {Misc errors} -body {
    toplevel .t2
    wm geom .t2 +0+0
    wm transient .t2 .t
    wm iconify .t2
} -returnCodes error -cleanup {
    destroy .t2
} -result {cannot iconify ".t2": it is a transient}
test wm-iconify-2.3 {Misc errors} -body {
    toplevel .t2
    wm geom .t2 +0+0
    wm iconwindow .t .t2
    wm iconify .t2
} -returnCodes error -cleanup {
    destroy .t2
} -result {cannot iconify ".t2": it is an icon for ".t"}
# test embedded window for Windows
test wm-iconify-2.4.1 {Misc errors} -constraints win -setup {
    destroy .t2
} -body {
    frame .t.f -container 1
    toplevel .t2 -use [winfo id .t.f]
    wm iconify .t2
} -returnCodes error -cleanup {
    destroy .t2 .r.f
} -result {cannot iconify ".t2": the container does not support the request}
# test embedded window for other platforms
test wm-iconify-2.4.2 {Misc errors} -constraints !win -setup {
    destroy .t2
} -body {
    frame .t.f -container 1
    toplevel .t2 -use [winfo id .t.f]
    wm iconify .t2
} -returnCodes error -cleanup {
    destroy .t2 .r.f
} -result {cannot iconify ".t2": it is an embedded window}

test wm-iconify-3.1 {iconify behavior} -constraints {failsOnUbuntu failsOnXQuarz} -body {
    toplevel .t2
    wm geom .t2 -0+0
    update idletasks
    set result [winfo ismapped .t2]
    wm iconify .t2

    wm iconphoto
} -result {wrong # args: should be "wm option window ?arg ...?"}
test wm-iconphoto-1.2 {usage} -returnCodes error -body {
    wm iconphoto .
} -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}
test wm-iconphoto-1.3 {usage} -returnCodes error -body {
    wm iconphoto . notanimage
} -result {cannot use "notanimage" as iconphoto: not a photo image}
test wm-iconphoto-1.4 {usage} -returnCodes error -body {
    # we currently have no return info
    wm iconphoto . -default
} -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}
test wm-iconphoto-1.5.1 {usage} -constraints aquaOrWin32 -returnCodes error -body {
    wm iconphoto . -default [image create photo -file {}]
} -match {glob} -result {failed to create an iconphoto with image *}

test wm-iconwindow-1.4 {usage} -setup {
    destroy .b
} -body {
    button .b -text Help
    wm iconwindow .t .b
} -returnCodes error -cleanup {
    destroy .b
} -result {cannot use .b as icon window: not at top level}
test wm-iconwindow-1.5 {usage} -setup {
    destroy .icon .t2
} -body {
    toplevel .icon -width 50 -height 50 -bg green
    toplevel .t2
    wm geom .t2 -0+0
    wm iconwindow .t2 .icon

    update
    raise .
    raiseDelay
    wm stackorder .
} -cleanup {
    destroy .t
} -result {.t .}
test wm-stackorder-5.2 {A normal toplevel cannot be raised above an \
    overrideredirect toplevel on unix} -constraints {x11 failsOnUbuntu failsOnXQuarz} -body {
    toplevel .t
    wm overrideredirect .t 1
    tkwait visibility .t
    raise .
    update
    raiseDelay

test wm-transient-1.4 {usage} -returnCodes error -body {
    toplevel .top
    toplevel .subject
    wm transient .subject .top
    wm iconify .subject
} -cleanup {
    deleteWindows
} -result {cannot iconify ".subject": it is a transient}
test wm-transient-1.5 {usage} -returnCodes error -body {
    toplevel .icon -bg blue
    toplevel .top
    wm iconwindow .top .icon
    toplevel .dummy
    wm transient .icon .dummy
} -cleanup {
    deleteWindows
} -result {cannot make ".icon" a transient: it is an icon for .top}
test wm-transient-1.6 {usage} -returnCodes error -body {
    toplevel .icon -bg blue
    toplevel .top
    wm iconwindow .top .icon
    toplevel .dummy
    wm transient .dummy .icon
} -cleanup {
    deleteWindows
} -result {cannot make ".icon" a container: it is an icon for .top}
test wm-transient-1.7 {usage} -returnCodes error -body {
    toplevel .top
    wm transient .top .top
} -cleanup {
    deleteWindows
} -result {cannot set ".top" as container: would cause management loop}
test wm-transient-1.8 {usage} -returnCodes error -body {
    toplevel .t1
    toplevel .t2
    toplevel .t3
    wm transient .t2 .t1
    wm transient .t3 .t2
    wm transient .t1 .t3
} -cleanup {
    deleteWindows
} -result {cannot set ".t3" as container: would cause management loop}
test wm-transient-1.9 {usage} -returnCodes error -body {
    toplevel .top
    frame .top.f
    wm transient .top .top.f
} -cleanup {
    deleteWindows
} -result {cannot set ".top" as container: would cause management loop}

test wm-transient-2.1 {basic get/set of toplevel} -setup {
    set results [list]
} -body {
    toplevel .top
    toplevel .subject
    lappend results [wm transient .subject]

test wm-withdraw-2.1 {Misc errors} -body {
    toplevel .t
    toplevel .t2
    wm iconwindow .t .t2
    wm withdraw .t2
} -returnCodes error -cleanup {
    deleteWindows
} -result {cannot withdraw .t2: it is an icon for .t}

test wm-withdraw-3.1 {} -setup {
    set result {}
} -body {
    toplevel .t
    update
    wm withdraw .t

    } else {
	/*
	 * Prevent file system access in safe interpreters.
	 */

	if (!inTkTable && Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot get cursor from a file in a safe interpreter",
		    TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "CURSOR_FILE", NULL);
	    cursorPtr = NULL;
	    goto cleanup;
	}

	/*

    Container *containerPtr;
    XWindowAttributes parentAtts;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->window != None) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot modify container after widget is created", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL);
	return TCL_ERROR;
    }
    if (TkpScanWindowId(interp, string, &parent) != TCL_OK) {
	return TCL_ERROR;
    }

    usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent);
    if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"window \"%s\" does not have -container option set",
		usePtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL);
	return TCL_ERROR;
    }

    /*
     * Tk sets the window colormap to the screen default colormap in

		    && (retrPtr->target == eventPtr->xselection.target)
		    && (retrPtr->result == -1)) {
		if (retrPtr->property == eventPtr->xselection.property) {
		    break;
		}
		if (eventPtr->xselection.property == None) {
		    Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
			    "%s selection does not exist or form \"%s\" not defined",
			    Tk_GetAtomName(tkwin, retrPtr->selection),
			    Tk_GetAtomName(tkwin, retrPtr->target)));
		    Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION",
			    "NONE", NULL);
		    retrPtr->result = TCL_ERROR;
		    return;
		}