Tk Source Code

    - "core-**"
permissions:
  contents: read
env:
  ERROR_ON_FAILURES: 1
jobs:
  xcode:
    runs-on: macos-14
    defaults:
      run:
        shell: bash
        working-directory: tk/macosx
    steps:
      - name: Checkout Tk
        uses: actions/checkout@v4

          if [ $nmatches -lt 4 ]
          then
            echo "::error::Failure during Test"
            exit 1
          fi
        timeout-minutes: 30
  clang:
    runs-on: macos-14
    strategy:
      matrix:
        symbols:
          - 'no'
          - 'mem'
        options:
          - '--enable-aqua'

# README:  Tk

This is the **Tk 9.0.2** source distribution.

You can get any source release of Tk from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).

9.0 (production release, daily build)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/linux-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tk/actions/workflows/linux-build.yml?query=branch%3Amain)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/win-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tk/actions/workflows/win-build.yml?query=branch%3Amain)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/mac-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tk/actions/workflows/mac-build.yml?query=branch%3Amain)
<br>
8.7 (in development, daily build)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/linux-build.yml/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tk/actions/workflows/linux-build.yml?query=branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/win-build.yml/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tk/actions/workflows/win-build.yml?query=branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/mac-build.yml/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tk/actions/workflows/mac-build.yml?query=branch%3Acore-8-branch)

## <a id="intro">1.</a> Introduction

This directory contains the sources and documentation for Tk, a
cross-platform GUI toolkit implemented with the Tcl scripting language.

For details on features, incompatibilities, and potential problems with

static Tcl_Obj *	GetConfigList(void *recordPtr,
			    Option *optionPtr, Tk_Window tkwin);
static Tcl_Obj *	GetObjectForOption(void *recordPtr,
			    Option *optionPtr, Tk_Window tkwin);
static Option *		GetOption(const char *name, OptionTable *tablePtr);
static Option *		GetOptionFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, OptionTable *tablePtr);
static int		ObjectIsEmpty(Tcl_Obj *objPtr);
static void		FreeOptionInternalRep(Tcl_Obj *objPtr);
static void		DupOptionInternalRep(Tcl_Obj *, Tcl_Obj *);

/*
 * The structure below defines an object type that is used to cache the result
 * of looking up an option name. If an object has this type, then its
 * internalPtr1 field points to the OptionTable in which it was looked up, and

	oldInternalPtr = (char *)&internal.internalForm;
    }
    nullOK = (optionPtr->specPtr->flags & (TK_OPTION_NULL_OK|TCL_NULL_OK|1));
    switch (optionPtr->specPtr->type) {
    case TK_OPTION_BOOLEAN: {
	int newBool;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newBool = -1;
	} else if (Tcl_GetBooleanFromObj(nullOK ? NULL : interp, valuePtr, &newBool) != TCL_OK) {
	    if (nullOK && interp) {
		Tcl_AppendResult(interp, "expected boolean value or \"\" but got \"",
			Tcl_GetString(valuePtr), "\"", NULL);
	    }

	}
	break;
    }
    case TK_OPTION_INT: {
	int newInt;

	if ((optionPtr->specPtr->flags & TYPE_MASK) == 0) {
	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		newInt = INT_MIN;
	    } else if (Tcl_GetIntFromObj(nullOK ? NULL : interp, valuePtr, &newInt) != TCL_OK) {
	    invalidIntValue:
		if (nullOK && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected integer or \"\" but got \"%.50s\"", Tcl_GetString(valuePtr)));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", (char *)NULL);
		}
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((int *)oldInternalPtr) = *((int *)internalPtr);
		*((int *)internalPtr) = newInt;
	    }
	} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_MASK) {
	    Tcl_WideInt newWideInt;
	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		newWideInt = (sizeof(long) > sizeof(int)) ? LONG_MIN : LLONG_MIN;
	    } else if (Tcl_GetWideIntFromObj(nullOK ? NULL : interp, valuePtr, &newWideInt) != TCL_OK) {
		goto invalidIntValue;
	    }
		if (internalPtr != NULL) {
			if (sizeof(long) > sizeof(int)) {

	    *((int *)internalPtr) = (int)newIndex;
	}
	break;
    }
    case TK_OPTION_DOUBLE: {
	double newDbl;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
#if defined(NAN)
	    newDbl = NAN;
#else
	    newDbl = 0.0;
#endif
	} else {

	break;
    }
    case TK_OPTION_STRING: {
	char *newStr;
	const char *value;
	Tcl_Size length;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	}
	if (internalPtr != NULL) {
	    if (valuePtr != NULL) {
		value = Tcl_GetStringFromObj(valuePtr, &length);
		newStr = (char *)ckalloc(length + 1);
		strcpy(newStr, value);
	    } else {
		newStr = NULL;
	    }
	    *((char **)oldInternalPtr) = *((char **)internalPtr);
	    *((char **)internalPtr) = newStr;
	}
	break;
    }
    case TK_OPTION_STRING_TABLE: {
	int newValue;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newValue = -1;
	} else {
	    if (Tcl_GetIndexFromObjStruct(interp, valuePtr,
		    optionPtr->specPtr->clientData, sizeof(char *),
		    optionPtr->specPtr->optionName+1, (nullOK ? TCL_NULL_OK : 0), &newValue) != TCL_OK) {
		return TCL_ERROR;

	    }
	}
	break;
    }
    case TK_OPTION_COLOR: {
	XColor *newPtr;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newPtr = NULL;
	} else {
	    newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    *((XColor **)oldInternalPtr) = *((XColor **)internalPtr);
	    *((XColor **)internalPtr) = newPtr;
	}
	break;
    }
    case TK_OPTION_FONT: {
	Tk_Font newFont;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newFont = NULL;
	} else {
	    newFont = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
	    if (newFont == NULL) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    *((Tk_Font *)oldInternalPtr) = *((Tk_Font *)internalPtr);
	    *((Tk_Font *)internalPtr) = newFont;
	}
	break;
    }
    case TK_OPTION_STYLE: {
	Tk_Style newStyle;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newStyle = NULL;
	} else {
	    newStyle = Tk_AllocStyleFromObj(interp, valuePtr);
	    if (newStyle == NULL) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    *((Tk_Style *)oldInternalPtr) = *((Tk_Style *)internalPtr);
	    *((Tk_Style *)internalPtr) = newStyle;
	}
	break;
    }
    case TK_OPTION_BITMAP: {
	Pixmap newBitmap;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newBitmap = None;
	} else {
	    newBitmap = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
	    if (newBitmap == None) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    *((Pixmap *)oldInternalPtr) = *((Pixmap *)internalPtr);
	    *((Pixmap *)internalPtr) = newBitmap;
	}
	break;
    }
    case TK_OPTION_BORDER: {
	Tk_3DBorder newBorder;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newBorder = NULL;
	} else {
	    newBorder = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
	    if (newBorder == NULL) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    *((Tk_3DBorder *)oldInternalPtr) = *((Tk_3DBorder *)internalPtr);
	    *((Tk_3DBorder *)internalPtr) = newBorder;
	}
	break;
    }
    case TK_OPTION_RELIEF: {
	int newRelief;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newRelief = TK_RELIEF_NULL;
	} else if (Tcl_GetIndexFromObj(interp, valuePtr, tkReliefStrings,
		"relief", (nullOK ? TCL_NULL_OK : 0), &newRelief) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {

	    Tcl_InvalidateStringRep(valuePtr);
	}
	break;
    }
    case TK_OPTION_CURSOR: {
	Tk_Cursor newCursor;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    newCursor = NULL;
	    valuePtr = NULL;
	} else {
	    newCursor = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
	    if (newCursor == NULL) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
	    *((Tk_Cursor *) internalPtr) = newCursor;
	}
	Tk_DefineCursor(tkwin, newCursor);
	break;
    }
    case TK_OPTION_JUSTIFY: {
	int newJustify;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newJustify = -1;
	} else if (Tcl_GetIndexFromObj(interp, valuePtr, tkJustifyStrings,
		"justification", (nullOK ? TCL_NULL_OK : 0), &newJustify) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {

	    Tcl_InvalidateStringRep(valuePtr);
	}
	break;
    }
    case TK_OPTION_ANCHOR: {
	int newAnchor;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newAnchor = -1;
	} else if (Tcl_GetIndexFromObj(interp, valuePtr, tkAnchorStrings,
		"anchor", (nullOK ? TCL_NULL_OK : 0), &newAnchor) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {

	    Tcl_InvalidateStringRep(valuePtr);
	}
	break;
    }
    case TK_OPTION_PIXELS: {
	int newPixels;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newPixels = INT_MIN;
	} else if (Tk_GetPixelsFromObj(nullOK ? NULL : interp, tkwin, valuePtr,
		&newPixels) != TCL_OK) {
	    if (nullOK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "expected screen distance or \"\" but got \"%.50s\"", Tcl_GetString(valuePtr)));
		Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {
	    *((int *)oldInternalPtr) = *((int *)internalPtr);
	    *((int *)internalPtr) = newPixels;
	}
	break;
    }
    case TK_OPTION_WINDOW: {
	Tk_Window newWin;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newWin = NULL;
	} else if (TkGetWindowFromObj(interp, tkwin, valuePtr,
		&newWin) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {

	*slotPtrPtr = valuePtr;
	if (valuePtr != NULL) {
	    Tcl_IncrRefCount(valuePtr);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ObjectIsEmpty --
 *
 *	This function tests whether the string value of an object is empty.
 *
 * Results:
 *	The return value is 1 if the string value of objPtr has length zero,
 *	and 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ObjectIsEmpty(
    Tcl_Obj *objPtr)		/* Object to test. May be NULL. */
{
    if (objPtr == NULL) {
	return 1;
    }
    if (objPtr->bytes == NULL) {
	Tcl_GetString(objPtr);
    }
    return (objPtr->length == 0);
}

/*
 *----------------------------------------------------------------------
 *
 * GetOption --
 *
 *	This function searches through a chained option table to find the

			    Tcl_Size objc, Tcl_Obj *const *objv, int flags);
MODULE_SCOPE void	TkDrawDottedRect(Display *disp, Drawable d, GC gc,
			    int x, int y, int width, int height);
MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp,
			    const char *nsname, const char *name,
			    void *clientData, const TkEnsemble *map);
MODULE_SCOPE double	TkScalingLevel(Tk_Window tkwin);

MODULE_SCOPE int	TkInitTkCmd(Tcl_Interp *interp,
			    void *clientData);
MODULE_SCOPE int	TkInitFontchooser(Tcl_Interp *interp,
			    void *clientData);
MODULE_SCOPE void	TkInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TkDoWarpWrtWin(TkDisplay *dispPtr);

			    char *recordPtr, Tcl_Size internalOffset);
static void		RestoreSticky(void *clientData, Tk_Window tkwin,
			    char *internalPtr, char *oldInternalPtr);
static void		AdjustForSticky(int sticky, int cavityWidth,
			    int cavityHeight, int *xPtr, int *yPtr,
			    int *paneWidthPtr, int *paneHeightPtr);
static void		MoveSash(PanedWindow *pwPtr, int sash, int diff);
static int		ObjectIsEmpty(Tcl_Obj *objPtr);
static void *	ComputeSlotAddress(void *recordPtr, Tcl_Size offset);
static int		PanedWindowIdentifyCoords(PanedWindow *pwPtr,
			    Tcl_Interp *interp, int x, int y);

/*
 * Sashes are between panes only, so there is one less sash than panes
 */

    int sticky = 0;
    char c;
    void *internalPtr;
    const char *string;

    internalPtr = ComputeSlotAddress(recordPtr, internalOffset);

    if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) {
	*value = NULL;
    } else {
	/*
	 * Convert the sticky specifier into an integer value.
	 */

	string = Tcl_GetString(*value);

	Tk_MaintainGeometry(pwPtr->proxywin, pwPtr->tkwin, x, y,
		sashWidth, sashHeight);
	break;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ObjectIsEmpty --
 *
 *	This function tests whether the string value of an object is empty.
 *
 * Results:
 *	The return value is 1 if the string value of objPtr has length zero,
 *	and 0 otherwise.
 *
 * Side effects:
 *	May cause object shimmering, since this function can force a
 *	conversion to a string object.
 *
 *----------------------------------------------------------------------
 */

static int
ObjectIsEmpty(
    Tcl_Obj *objPtr)		/* Object to test. May be NULL. */
{
    if (objPtr == NULL) {
	return 1;
    }
    if (objPtr->bytes == NULL) {
	Tcl_GetString(objPtr);
    }
    return (objPtr->length == 0);
}

/*
 *----------------------------------------------------------------------
 *
 * ComputeInternalPointer --
 *
 *	Given a pointer to the start of a record and the offset of a slot

 */

#include "tkInt.h"
#include "tkText.h"
#include "tkTextUndo.h"
#include "tkTextTagSet.h"
#include "tkBitField.h"
#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 7)
#include "tkFont.h"
#endif
#include <stdlib.h>
#include <assert.h>
#include "default.h"

/* needed for strncasecmp */
#if defined(_WIN32) && !defined(__GNUC__)
# define strncasecmp _strnicmp

		&& TkBTreeEpoch(textPtr->sharedTextPtr->tree) == oldStateEpoch;
    }
}

/*
 *----------------------------------------------------------------------
 *









































 * TkTextInspectOptions --
 *
 *	Build information from option table for "inspect".
 *
 * Results:
 *	None.
 *

	    if (argc >= 5) { /* only if this option has a non-default value */
		Tcl_Obj *valObj = argv[4];
		Tcl_Obj *myValObj;
		Tcl_Obj *nameObj;
		int myFlags = flags;

		if (GetByteLength(valObj) == 0) {
		    continue;
		}

		if (!(myFlags & INSPECT_INCLUDE_DATABASE_CONFIG)
			|| myFlags & (INSPECT_INCLUDE_SYSTEM_CONFIG|INSPECT_INCLUDE_DEFAULT_CONFIG)) {
		    const char *name = Tcl_GetString(argv[1]);
		    const char *cls = Tcl_GetString(argv[2]);

 *	May store the TkTextSegment* value into the internal representation
 *	pointer. May change the pointer to the Tcl_Obj to NULL to indicate
 *	that the specified string was empty and that is acceptable.
 *
 *----------------------------------------------------------------------
 */

static int
ObjectIsEmpty(
    Tcl_Obj *objPtr)		/* Object to test. May be NULL. */
{
    return objPtr ? GetByteLength(objPtr) == 0 : 1;
}

static int
SetTextStartEnd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),		/* Current interp; may be used for errors. */
    TCL_UNUSED(Tk_Window),		/* Window for which option is being set. */
    Tcl_Obj **value,		/* Pointer to the pointer to the value object.
				 * We use a pointer to the pointer because we

    Tcl_Obj **objPtr = (Tcl_Obj **) (recordPtr + internalOffset);
    Tcl_Obj **oldObjPtr = (Tcl_Obj **) oldInternalPtr;
    const TkText *textPtr = (const TkText *) recordPtr;

    assert(!*objPtr);
    *oldObjPtr = NULL;

    if ((flags & TK_OPTION_NULL_OK) && ObjectIsEmpty(*value)) {
	*value = NULL;
	*objPtr = Tcl_NewStringObj((objPtr == &textPtr->newStartIndex) ? "begin" : "end", TCL_INDEX_NONE);
    } else {
	*objPtr = *value;
    }
    Tcl_IncrRefCount(*objPtr);
    return TCL_OK;

    if (internalOffset != TCL_INDEX_NONE) {
	internalPtr = (char *)recordPtr + internalOffset;
    } else {
	internalPtr = NULL;
    }

    if ((flags & TK_OPTION_NULL_OK) && ObjectIsEmpty(*value)) {
	*value = NULL;
    } else {
	int line;

	if (Tcl_GetIntFromObj(interp, *value, &line) != TCL_OK) {
	    return TCL_ERROR;
	}

#define INSPECT_INCLUDE_SYSTEM_COLORS   (1 << 5)

/*
 * Declarations for procedures that are used by the text-related files but
 * shouldn't be used anywhere else in Tk (or by Tk clients):
 */


inline TkSharedText *	TkBTreeGetShared(TkTextBTree tree);
inline int		TkBTreeGetNumberOfDisplayLines(const TkTextPixelInfo *pixelInfo);
MODULE_SCOPE void	TkBTreeAdjustPixelHeight(const TkText *textPtr,
			TkTextLine *linePtr, int newPixelHeight, unsigned mergedLogicalLines,
			    unsigned oldNumDispLines);
MODULE_SCOPE void	TkBTreeUpdatePixelHeights(const TkText *textPtr, TkTextLine *linePtr,
			    int numLines, unsigned epoch);

 * the Text widget. These values are used as indices into the string table below.
 */

static const char *const justifyStrings[] = {
    "left", "right", "center", "full", NULL
};





static const Tk_OptionSpec tagOptionSpecs[] = {
    {TK_OPTION_BORDER, "-background", NULL, NULL,
	NULL, TCL_INDEX_NONE, offsetof(TkTextTag, attrs.border), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BITMAP, "-bgstipple", NULL, NULL,
	NULL, TCL_INDEX_NONE, offsetof(TkTextTag, bgStipple), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", NULL, NULL,

    {TK_OPTION_PIXELS, "-lmargin1", NULL, NULL,
	NULL, offsetof(TkTextTag, lMargin1Obj), offsetof(TkTextTag, lMargin1), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-lmargin2", NULL, NULL,
	NULL, offsetof(TkTextTag, lMargin2Obj), offsetof(TkTextTag, lMargin2), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BORDER, "-lmargincolor", NULL, NULL,
	NULL, TCL_INDEX_NONE, offsetof(TkTextTag, lMarginColor), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-offset", NULL, NULL,
	NULL, offsetof(TkTextTag, offsetObj), offsetof(TkTextTag, offset), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-overstrike", NULL, NULL,
	NULL, TCL_INDEX_NONE, offsetof(TkTextTag, overstrike), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_COLOR, "-overstrikecolor", NULL, NULL,
	NULL, TCL_INDEX_NONE, offsetof(TkTextTag, overstrikeColor), TK_OPTION_NULL_OK, 0, 0},
#if SUPPORT_DEPRECATED_TAG_OPTIONS
    {TK_OPTION_SYNONYM, "-overstrikefg", NULL, NULL,
	NULL, 0, TCL_INDEX_NONE, TK_OPTION_NULL_OK, "-overstrikecolor", TK_TEXT_DEPRECATED_OVERSTRIKE_FG},

typedef enum {
    ALIGN_BASELINE, ALIGN_BOTTOM, ALIGN_CENTER, ALIGN_TOP
} alignMode;

/*
 * Information used for parsing window configuration options:
 */






static const Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_STRING_TABLE, "-align", NULL, NULL,
	"center", TCL_INDEX_NONE, offsetof(TkTextEmbWindow, align), 0, alignStrings, 0},
    {TK_OPTION_STRING, "-create", NULL, NULL,
	NULL, offsetof(TkTextEmbWindow, createObj), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-owner", NULL, NULL,
	"1", TCL_INDEX_NONE, offsetof(TkTextEmbWindow, isOwner), 0, 0, 0},
    {TK_OPTION_PIXELS, "-padx", NULL, NULL,
	"0", offsetof(TkTextEmbWindow, padXObj), offsetof(TkTextEmbWindow, padX), 0, 0, 0},
    {TK_OPTION_PIXELS, "-pady", NULL, NULL,
	"0", offsetof(TkTextEmbWindow, padYObj), offsetof(TkTextEmbWindow, padY), 0, 0, 0},
    {TK_OPTION_BOOLEAN, "-stretch", NULL, NULL,
	"0", TCL_INDEX_NONE, offsetof(TkTextEmbWindow, stretch), 0, 0, 0},
    {TK_OPTION_STRING, "-tags", NULL, NULL,
	NULL, TCL_INDEX_NONE, TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_WINDOW, "-window", NULL, NULL,
	NULL, TCL_INDEX_NONE, offsetof(TkTextEmbWindow, tkwin), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}

    testobjconfig internal .foo -custom "this is a test"
    .foo cget -custom
} -cleanup {
    killTables
}  -result {THIS IS A TEST}


test config-5.1 {ObjectIsEmpty - object is already string} -constraints {
    testobjconfig
} -body {
    testobjconfig alltypes .foo -color [format ""]
    .foo cget -color
} -cleanup {
    killTables
}  -result {}
test config-5.2 {ObjectIsEmpty - object is already string} -constraints {
    testobjconfig
} -body {
    testobjconfig alltypes .foo -color [format " "]
} -cleanup {
    killTables
} -returnCodes error -result {unknown color name " "}
test config-5.3 {ObjectIsEmpty - must convert back to string} -constraints {
    testobjconfig
} -body {
    testobjconfig alltypes .foo -color [list]
    .foo cget -color
} -cleanup {
    killTables
} -result {}

# is needed to wait long enough for pending actions to get through
# the X server and possibly also the window manager.

proc focusClear {} {
    dobg {after 200; focus -force .; update}
    after 400
    if {[tk windowingsystem] eq "aqua"} {
	# In Aqua we need to explicitly wait until focus is cleared. 
	while {[focus] != ""} {
	    after 100 {set y 1}
	    tkwait variable y
	}
    }
        
    update
}


# Button used in some tests in the whole test file
button .b -text .b -relief raised -bd 2
pack .b