/*
 * tkTest.c --
 *
 *	This file contains C command functions for a bunch of additional Tcl
 *	commands that are used for testing out Tcl's C interfaces. These
 *	commands are not normally included in Tcl applications; they're only
 *	used for testing.
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#ifndef USE_TK_STUBS
#   define USE_TK_STUBS
#endif
#include "tkInt.h"
#include "tkText.h"

#ifdef _WIN32
#include "tkWinInt.h"
#endif

#if defined(MAC_OSX_TK)
#include "tkMacOSXInt.h"
#include "tkScrollbar.h"
#endif

#ifdef __UNIX__
#include "tkUnixInt.h"
#endif

/*
 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
 * Tcltest_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
EXTERN int		Tktest_Init(Tcl_Interp *interp);
/*
 * The following data structure represents the master for a test image:
 */

typedef struct TImageMaster {
    Tk_ImageMaster master;	/* Tk's token for image master. */
    Tcl_Interp *interp;		/* Interpreter for application. */
    int width, height;		/* Dimensions of image. */
    char *imageName;		/* Name of image (malloc-ed). */
    char *varName;		/* Name of variable in which to log events for
				 * image (malloc-ed). */
} TImageMaster;

/*
 * The following data structure represents a particular use of a particular
 * test image.
 */

typedef struct TImageInstance {
    TImageMaster *masterPtr;	/* Pointer to master for image. */
    XColor *fg;			/* Foreground color for drawing in image. */
    GC gc;			/* Graphics context for drawing in image. */
} TImageInstance;

/*
 * The type record for test images:
 */

static int		ImageCreate(Tcl_Interp *interp,
			    const char *name, int argc, Tcl_Obj *const objv[],
			    const Tk_ImageType *typePtr, Tk_ImageMaster master,
			    ClientData *clientDataPtr);
static ClientData	ImageGet(Tk_Window tkwin, ClientData clientData);
static void		ImageDisplay(ClientData clientData,
			    Display *display, Drawable drawable,
			    int imageX, int imageY, int width,
			    int height, int drawableX,
			    int drawableY);
static void		ImageFree(ClientData clientData, Display *display);
static void		ImageDelete(ClientData clientData);

static Tk_ImageType imageType = {
    "test",			/* name */
    ImageCreate,		/* createProc */
    ImageGet,			/* getProc */
    ImageDisplay,		/* displayProc */
    ImageFree,			/* freeProc */
    ImageDelete,		/* deleteProc */
    NULL,			/* postscriptPtr */
    NULL,			/* nextPtr */
    NULL
};

/*
 * One of the following structures describes each of the interpreters created
 * by the "testnewapp" command. This information is used by the
 * "testdeleteinterps" command to destroy all of those interpreters.
 */

typedef struct NewApp {
    Tcl_Interp *interp;		/* Token for interpreter. */
    struct NewApp *nextPtr;	/* Next in list of new interpreters. */
} NewApp;

static NewApp *newAppPtr = NULL;/* First in list of all new interpreters. */

/*
 * Header for trivial configuration command items.
 */

#define ODD	TK_CONFIG_USER_BIT
#define EVEN	(TK_CONFIG_USER_BIT << 1)

enum {
    NONE,
    ODD_TYPE,
    EVEN_TYPE
};

typedef struct TrivialCommandHeader {
    Tcl_Interp *interp;		/* The interp that this command lives in. */
    Tk_OptionTable optionTable;	/* The option table that go with this
				 * command. */
    Tk_Window tkwin;		/* For widgets, the window associated with
				 * this widget. */
    Tcl_Command widgetCmd;	/* For widgets, the command associated with
				 * this widget. */
} TrivialCommandHeader;

/*
 * Forward declarations for functions defined later in this file:
 */

static int		ImageCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestbitmapObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestborderObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestcolorObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestcursorObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestdeleteappsObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestfontObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestmakeexistCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
static int		TestmenubarCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
#endif
#if defined(_WIN32) || defined(MAC_OSX_TK)
static int		TestmetricsObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
#endif
static int		TestobjconfigObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		CustomOptionSet(ClientData clientData,
			    Tcl_Interp *interp, Tk_Window tkwin,
			    Tcl_Obj **value, char *recordPtr,
			    int internalOffset, char *saveInternalPtr,
			    int flags);
static Tcl_Obj *	CustomOptionGet(ClientData clientData,
			    Tk_Window tkwin, char *recordPtr,
			    int internalOffset);
static void		CustomOptionRestore(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr,
			    char *saveInternalPtr);
static void		CustomOptionFree(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr);
static int		TestpropCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
static int		TestwrapperCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
#endif
static void		TrivialCmdDeletedProc(ClientData clientData);
static int		TrivialConfigObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static void		TrivialEventProc(ClientData clientData,
			    XEvent *eventPtr);

/*
 *----------------------------------------------------------------------
 *
 * Tktest_Init --
 *
 *	This function performs intialization for the Tk test suite exensions.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	Creates several test commands.
 *
 *----------------------------------------------------------------------
 */

int
Tktest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    static int initialized = 0;

    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }

    /*
     * Create additional commands for testing Tk.
     */

    if (Tcl_PkgProvideEx(interp, "Tktest", TK_VERSION, NULL) == TCL_ERROR) {
        return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testdeleteapps", TestdeleteappsObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateCommand(interp, "testprop", TestpropCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateCommand(interp, "testtext", TkpTesttextCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);

#if defined(_WIN32) || defined(MAC_OSX_TK)
    Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
#elif !defined(__CYGWIN__)
    Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testsend", TkpTestsendCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
#endif /* _WIN32 || MAC_OSX_TK */

    /*
     * Create test image type.
     */

    if (!initialized) {
	initialized = 1;
	Tk_CreateImageType(&imageType);
    }

    /*
     *	Enable testing of legacy interfaces.
     */

    if (TkOldTestInit(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * And finally add any platform specific test commands.
     */

    return TkplatformtestInit(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TestbitmapObjCmd --
 *
 *	This function implements the "testbitmap" command, which is used to
 *	test color resource handling in tkBitmap tmp.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestbitmapObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bitmap");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugBitmap(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestborderObjCmd --
 *
 *	This function implements the "testborder" command, which is used to
 *	test color resource handling in tkBorder.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestborderObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "border");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugBorder(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcolorObjCmd --
 *
 *	This function implements the "testcolor" command, which is used to
 *	test color resource handling in tkColor.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestcolorObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "color");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugColor(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcursorObjCmd --
 *
 *	This function implements the "testcursor" command, which is used to
 *	test color resource handling in tkCursor.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestcursorObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cursor");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugCursor(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestdeleteappsObjCmd --
 *
 *	This function implements the "testdeleteapps" command. It cleans up
 *	all the interpreters left behind by the "testnewapp" command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	All the intepreters created by previous calls to "testnewapp" get
 *	deleted.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestdeleteappsObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    NewApp *nextPtr;

    while (newAppPtr != NULL) {
	nextPtr = newAppPtr->nextPtr;
	Tcl_DeleteInterp(newAppPtr->interp);
	ckfree(newAppPtr);
	newAppPtr = nextPtr;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestobjconfigObjCmd --
 *
 *	This function implements the "testobjconfig" command, which is used to
 *	test the functions in tkConfig.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestobjconfigObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"alltypes", "chain1", "chain2", "chain3", "configerror", "delete", "info",
	"internal", "new", "notenoughparams", "twowindows", NULL
    };
    enum {
	ALL_TYPES, CHAIN1, CHAIN2, CHAIN3, CONFIG_ERROR,
	DEL,			/* Can't use DELETE: VC++ compiler barfs. */
	INFO, INTERNAL, NEW, NOT_ENOUGH_PARAMS, TWO_WINDOWS
    };
    static Tk_OptionTable tables[11];
				/* Holds pointers to option tables created by
				 * commands below; indexed with same values as
				 * "options" array. */
    static const Tk_ObjCustomOption CustomOption = {
	"custom option",
	CustomOptionSet,
	CustomOptionGet,
	CustomOptionRestore,
	CustomOptionFree,
	INT2PTR(1)
    };
    Tk_Window mainWin = (Tk_Window) clientData;
    Tk_Window tkwin;
    int index, result = TCL_OK;

    /*
     * Structures used by the "chain1" subcommand and also shared by the
     * "chain2" subcommand:
     */

    typedef struct ExtensionWidgetRecord {
	TrivialCommandHeader header;
	Tcl_Obj *base1ObjPtr;
	Tcl_Obj *base2ObjPtr;
	Tcl_Obj *extension3ObjPtr;
	Tcl_Obj *extension4ObjPtr;
	Tcl_Obj *extension5ObjPtr;
    } ExtensionWidgetRecord;
    static const Tk_OptionSpec baseSpecs[] = {
	{TK_OPTION_STRING, "-one", "one", "One", "one",
		Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1, 0, NULL, 0},
	{TK_OPTION_STRING, "-two", "two", "Two", "two",
		Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0},
	{TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
	    sizeof(char *), "command", 0, &index)!= TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case ALL_TYPES: {
	typedef struct TypesRecord {
	    TrivialCommandHeader header;
	    Tcl_Obj *booleanPtr;
	    Tcl_Obj *integerPtr;
	    Tcl_Obj *doublePtr;
	    Tcl_Obj *stringPtr;
	    Tcl_Obj *stringTablePtr;
	    Tcl_Obj *colorPtr;
	    Tcl_Obj *fontPtr;
	    Tcl_Obj *bitmapPtr;
	    Tcl_Obj *borderPtr;
	    Tcl_Obj *reliefPtr;
	    Tcl_Obj *cursorPtr;
	    Tcl_Obj *activeCursorPtr;
	    Tcl_Obj *justifyPtr;
	    Tcl_Obj *anchorPtr;
	    Tcl_Obj *pixelPtr;
	    Tcl_Obj *mmPtr;
	    Tcl_Obj *customPtr;
	} TypesRecord;
	TypesRecord *recordPtr;
	static const char *const stringTable[] = {
	    "one", "two", "three", "four", NULL
	};
	static const Tk_OptionSpec typesSpecs[] = {
	    {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1",
		Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1},
	    {TK_OPTION_INT, "-integer", "integer", "Integer", "7",
		Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2},
	    {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159",
		Tk_Offset(TypesRecord, doublePtr), -1, 0, 0, 0x4},
	    {TK_OPTION_STRING, "-string", "string", "String",
		"foo", Tk_Offset(TypesRecord, stringPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x8},
	    {TK_OPTION_STRING_TABLE,
		"-stringtable", "StringTable", "stringTable",
		"one", Tk_Offset(TypesRecord, stringTablePtr), -1,
		TK_CONFIG_NULL_OK, stringTable, 0x10},
	    {TK_OPTION_COLOR, "-color", "color", "Color",
		"red", Tk_Offset(TypesRecord, colorPtr), -1,
		TK_CONFIG_NULL_OK, "black", 0x20},
	    {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12",
		Tk_Offset(TypesRecord, fontPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x40},
	    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", "gray50",
		Tk_Offset(TypesRecord, bitmapPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x80},
	    {TK_OPTION_BORDER, "-border", "border", "Border",
		"blue", Tk_Offset(TypesRecord, borderPtr), -1,
		TK_CONFIG_NULL_OK, "white", 0x100},
	    {TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised",
		Tk_Offset(TypesRecord, reliefPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x200},
	    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", "xterm",
		Tk_Offset(TypesRecord, cursorPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x400},
	    {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left",
		Tk_Offset(TypesRecord, justifyPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x800},
	    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL,
		Tk_Offset(TypesRecord, anchorPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x1000},
	    {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel",
		"1", Tk_Offset(TypesRecord, pixelPtr), -1,
		TK_CONFIG_NULL_OK, 0, 0x2000},
	    {TK_OPTION_CUSTOM, "-custom", NULL, NULL,
		"", Tk_Offset(TypesRecord, customPtr), -1,
		TK_CONFIG_NULL_OK, &CustomOption, 0x4000},
	    {TK_OPTION_SYNONYM, "-synonym", NULL, NULL,
		NULL, 0, -1, 0, "-color", 0x8000},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
	};
	Tk_OptionTable optionTable;
	Tk_Window tkwin;

	optionTable = Tk_CreateOptionTable(interp, typesSpecs);
	tables[index] = optionTable;
	tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
		Tcl_GetString(objv[2]), NULL);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_SetClass(tkwin, "Test");

	recordPtr = ckalloc(sizeof(TypesRecord));
	recordPtr->header.interp = interp;
	recordPtr->header.optionTable = optionTable;
	recordPtr->header.tkwin = tkwin;
	recordPtr->booleanPtr = NULL;
	recordPtr->integerPtr = NULL;
	recordPtr->doublePtr = NULL;
	recordPtr->stringPtr = NULL;
	recordPtr->colorPtr = NULL;
	recordPtr->fontPtr = NULL;
	recordPtr->bitmapPtr = NULL;
	recordPtr->borderPtr = NULL;
	recordPtr->reliefPtr = NULL;
	recordPtr->cursorPtr = NULL;
	recordPtr->justifyPtr = NULL;
	recordPtr->anchorPtr = NULL;
	recordPtr->pixelPtr = NULL;
	recordPtr->mmPtr = NULL;
	recordPtr->stringTablePtr = NULL;
	recordPtr->customPtr = NULL;
	result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
		tkwin);
	if (result == TCL_OK) {
	    recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
		    Tcl_GetString(objv[2]), TrivialConfigObjCmd,
		    (ClientData) recordPtr, TrivialCmdDeletedProc);
	    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		    TrivialEventProc, (ClientData) recordPtr);
	    result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
		    objc-3, objv+3, tkwin, NULL, NULL);
	    if (result != TCL_OK) {
		Tk_DestroyWindow(tkwin);
	    }
	} else {
	    Tk_DestroyWindow(tkwin);
	    ckfree(recordPtr);
	}
	if (result == TCL_OK) {
	    Tcl_SetObjResult(interp, objv[2]);
	}
	break;
    }

    case CHAIN1: {
	ExtensionWidgetRecord *recordPtr;
	Tk_Window tkwin;
	Tk_OptionTable optionTable;

	tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
		Tcl_GetString(objv[2]), NULL);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_SetClass(tkwin, "Test");
	optionTable = Tk_CreateOptionTable(interp, baseSpecs);
	tables[index] = optionTable;

	recordPtr = ckalloc(sizeof(ExtensionWidgetRecord));
	recordPtr->header.interp = interp;
	recordPtr->header.optionTable = optionTable;
	recordPtr->header.tkwin = tkwin;
	recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
	recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
	result = Tk_InitOptions(interp, (char *)recordPtr, optionTable, tkwin);
	if (result == TCL_OK) {
	    result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
		    objc-3, objv+3, tkwin, NULL, NULL);
	    if (result != TCL_OK) {
		Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin);
	    }
	}
	if (result == TCL_OK) {
	    recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
		    Tcl_GetString(objv[2]), TrivialConfigObjCmd,
		    (ClientData) recordPtr, TrivialCmdDeletedProc);
	    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		    TrivialEventProc, (ClientData) recordPtr);
	    Tcl_SetObjResult(interp, objv[2]);
	}
	break;
    }

    case CHAIN2:
    case CHAIN3: {
	ExtensionWidgetRecord *recordPtr;
	static const Tk_OptionSpec extensionSpecs[] = {
	    {TK_OPTION_STRING, "-three", "three", "Three", "three",
		Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-four", "four", "Four", "four",
		Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-two", "two", "Two", "two and a half",
		Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING,
		"-oneAgain", "oneAgain", "OneAgain", "one again",
		Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0,
		(ClientData) baseSpecs, 0}
	};
	Tk_Window tkwin;
	Tk_OptionTable optionTable;

	tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
		Tcl_GetString(objv[2]), NULL);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_SetClass(tkwin, "Test");
	optionTable = Tk_CreateOptionTable(interp, extensionSpecs);
	tables[index] = optionTable;

	recordPtr = ckalloc(sizeof(ExtensionWidgetRecord));
	recordPtr->header.interp = interp;
	recordPtr->header.optionTable = optionTable;
	recordPtr->header.tkwin = tkwin;
	recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
	recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
	recordPtr->extension5ObjPtr = NULL;
	result = Tk_InitOptions(interp, (char *)recordPtr, optionTable, tkwin);
	if (result == TCL_OK) {
	    result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
		    objc-3, objv+3, tkwin, NULL, NULL);
	    if (result != TCL_OK) {
		Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin);
	    }
	}
	if (result == TCL_OK) {
	    recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
		    Tcl_GetString(objv[2]), TrivialConfigObjCmd,
		    (ClientData) recordPtr, TrivialCmdDeletedProc);
	    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		    TrivialEventProc, (ClientData) recordPtr);
	    Tcl_SetObjResult(interp, objv[2]);
	}
	break;
    }

    case CONFIG_ERROR: {
	typedef struct ErrorWidgetRecord {
	    Tcl_Obj *intPtr;
	} ErrorWidgetRecord;
	ErrorWidgetRecord widgetRecord;
	static const Tk_OptionSpec errorSpecs[] = {
	    {TK_OPTION_INT, "-int", "integer", "Integer", "bogus",
		Tk_Offset(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
	};
	Tk_OptionTable optionTable;

	widgetRecord.intPtr = NULL;
	optionTable = Tk_CreateOptionTable(interp, errorSpecs);
	tables[index] = optionTable;
	return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable,
		(Tk_Window) NULL);
    }

    case DEL:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "tableName");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
		sizeof(char *), "table", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (tables[index] != NULL) {
	    Tk_DeleteOptionTable(tables[index]);
	    /* Make sure that Tk_DeleteOptionTable() is never done
	     * twice for the same table. */
	    tables[index] = NULL;
	}
	break;

    case INFO:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "tableName");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
		sizeof(char *), "table", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index]));
	break;

    case INTERNAL: {
	/*
	 * This command is similar to the "alltypes" command except that it
	 * stores all the configuration options as internal forms instead of
	 * objects.
	 */

	typedef struct InternalRecord {
	    TrivialCommandHeader header;
	    int boolean;
	    int integer;
	    double doubleValue;
	    char *string;
	    int index;
	    XColor *colorPtr;
	    Tk_Font tkfont;
	    Pixmap bitmap;
	    Tk_3DBorder border;
	    int relief;
	    Tk_Cursor cursor;
	    Tk_Justify justify;
	    Tk_Anchor anchor;
	    int pixels;
	    double mm;
	    Tk_Window tkwin;
	    char *custom;
	} InternalRecord;
	InternalRecord *recordPtr;
	static const char *const internalStringTable[] = {
	    "one", "two", "three", "four", NULL
	};
	static const Tk_OptionSpec internalSpecs[] = {
	    {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1",
		-1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1},
	    {TK_OPTION_INT, "-integer", "integer", "Integer", "148962237",
		-1, Tk_Offset(InternalRecord, integer), 0, 0, 0x2},
	    {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159",
		-1, Tk_Offset(InternalRecord, doubleValue), 0, 0, 0x4},
	    {TK_OPTION_STRING, "-string", "string", "String", "foo",
		-1, Tk_Offset(InternalRecord, string),
		TK_CONFIG_NULL_OK, 0, 0x8},
	    {TK_OPTION_STRING_TABLE,
		"-stringtable", "StringTable", "stringTable", "one",
		-1, Tk_Offset(InternalRecord, index),
		TK_CONFIG_NULL_OK, internalStringTable, 0x10},
	    {TK_OPTION_COLOR, "-color", "color", "Color", "red",
		-1, Tk_Offset(InternalRecord, colorPtr),
		TK_CONFIG_NULL_OK, "black", 0x20},
	    {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12",
		-1, Tk_Offset(InternalRecord, tkfont),
		TK_CONFIG_NULL_OK, 0, 0x40},
	    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", "gray50",
		-1, Tk_Offset(InternalRecord, bitmap),
		TK_CONFIG_NULL_OK, 0, 0x80},
	    {TK_OPTION_BORDER, "-border", "border", "Border", "blue",
		-1, Tk_Offset(InternalRecord, border),
		TK_CONFIG_NULL_OK, "white", 0x100},
	    {TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised",
		-1, Tk_Offset(InternalRecord, relief),
		TK_CONFIG_NULL_OK, 0, 0x200},
	    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", "xterm",
		-1, Tk_Offset(InternalRecord, cursor),
		TK_CONFIG_NULL_OK, 0, 0x400},
	    {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left",
		-1, Tk_Offset(InternalRecord, justify),
		TK_CONFIG_NULL_OK, 0, 0x800},
	    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL,
		-1, Tk_Offset(InternalRecord, anchor),
		TK_CONFIG_NULL_OK, 0, 0x1000},
	    {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", "1",
		-1, Tk_Offset(InternalRecord, pixels),
		TK_CONFIG_NULL_OK, 0, 0x2000},
	    {TK_OPTION_WINDOW, "-window", "window", "Window", NULL,
		-1, Tk_Offset(InternalRecord, tkwin),
		TK_CONFIG_NULL_OK, 0, 0},
	    {TK_OPTION_CUSTOM, "-custom", NULL, NULL, "",
		-1, Tk_Offset(InternalRecord, custom),
		TK_CONFIG_NULL_OK, &CustomOption, 0x4000},
	    {TK_OPTION_SYNONYM, "-synonym", NULL, NULL,
		NULL, -1, -1, 0, "-color", 0x8000},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
	};
	Tk_OptionTable optionTable;
	Tk_Window tkwin;

	optionTable = Tk_CreateOptionTable(interp, internalSpecs);
	tables[index] = optionTable;
	tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
		Tcl_GetString(objv[2]), NULL);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_SetClass(tkwin, "Test");

	recordPtr = ckalloc(sizeof(InternalRecord));
	recordPtr->header.interp = interp;
	recordPtr->header.optionTable = optionTable;
	recordPtr->header.tkwin = tkwin;
	recordPtr->boolean = 0;
	recordPtr->integer = 0;
	recordPtr->doubleValue = 0.0;
	recordPtr->string = NULL;
	recordPtr->index = 0;
	recordPtr->colorPtr = NULL;
	recordPtr->tkfont = NULL;
	recordPtr->bitmap = None;
	recordPtr->border = NULL;
	recordPtr->relief = TK_RELIEF_FLAT;
	recordPtr->cursor = NULL;
	recordPtr->justify = TK_JUSTIFY_LEFT;
	recordPtr->anchor = TK_ANCHOR_N;
	recordPtr->pixels = 0;
	recordPtr->mm = 0.0;
	recordPtr->tkwin = NULL;
	recordPtr->custom = NULL;
	result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
		tkwin);
	if (result == TCL_OK) {
	    recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
		    Tcl_GetString(objv[2]), TrivialConfigObjCmd,
		    recordPtr, TrivialCmdDeletedProc);
	    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		    TrivialEventProc, recordPtr);
	    result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
		    objc - 3, objv + 3, tkwin, NULL, NULL);
	    if (result != TCL_OK) {
		Tk_DestroyWindow(tkwin);
	    }
	} else {
	    Tk_DestroyWindow(tkwin);
	    ckfree(recordPtr);
	}
	if (result == TCL_OK) {
	    Tcl_SetObjResult(interp, objv[2]);
	}
	break;
    }

    case NEW: {
	typedef struct FiveRecord {
	    TrivialCommandHeader header;
	    Tcl_Obj *one;
	    Tcl_Obj *two;
	    Tcl_Obj *three;
	    Tcl_Obj *four;
	    Tcl_Obj *five;
	} FiveRecord;
	FiveRecord *recordPtr;
	static const Tk_OptionSpec smallSpecs[] = {
	    {TK_OPTION_INT, "-one", "one", "One", "1",
		Tk_Offset(FiveRecord, one), -1, 0, NULL, 0},
	    {TK_OPTION_INT, "-two", "two", "Two", "2",
		Tk_Offset(FiveRecord, two), -1, 0, NULL, 0},
	    {TK_OPTION_INT, "-three", "three", "Three", "3",
		Tk_Offset(FiveRecord, three), -1, 0, NULL, 0},
	    {TK_OPTION_INT, "-four", "four", "Four", "4",
		Tk_Offset(FiveRecord, four), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-five", NULL, NULL, NULL,
		Tk_Offset(FiveRecord, five), -1, 0, NULL, 0},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
	};

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "new name ?-option value ...?");
	    return TCL_ERROR;
	}

	recordPtr = ckalloc(sizeof(FiveRecord));
	recordPtr->header.interp = interp;
	recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
		smallSpecs);
	tables[index] = recordPtr->header.optionTable;
	recordPtr->header.tkwin = NULL;
	recordPtr->one = recordPtr->two = recordPtr->three = NULL;
	recordPtr->four = recordPtr->five = NULL;
	Tcl_SetObjResult(interp, objv[2]);
	result = Tk_InitOptions(interp, (char *) recordPtr,
		recordPtr->header.optionTable, (Tk_Window) NULL);
	if (result == TCL_OK) {
	    result = Tk_SetOptions(interp, (char *) recordPtr,
		    recordPtr->header.optionTable, objc - 3, objv + 3,
		    (Tk_Window) NULL, NULL, NULL);
	    if (result == TCL_OK) {
		recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			Tcl_GetString(objv[2]), TrivialConfigObjCmd,
			(ClientData) recordPtr, TrivialCmdDeletedProc);
	    } else {
		Tk_FreeConfigOptions((char *) recordPtr,
			recordPtr->header.optionTable, (Tk_Window) NULL);
	    }
	}
	if (result != TCL_OK) {
	    ckfree(recordPtr);
	}

	break;
    }
    case NOT_ENOUGH_PARAMS: {
	typedef struct NotEnoughRecord {
	    Tcl_Obj *fooObjPtr;
	} NotEnoughRecord;
	NotEnoughRecord record;
	static const Tk_OptionSpec errorSpecs[] = {
	    {TK_OPTION_INT, "-foo", "foo", "Foo", "0",
		Tk_Offset(NotEnoughRecord, fooObjPtr), 0, 0, NULL, 0},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
	};
	Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1);
	Tk_OptionTable optionTable;

	record.fooObjPtr = NULL;

	tkwin = Tk_CreateWindowFromPath(interp, mainWin, ".config", NULL);
	Tk_SetClass(tkwin, "Config");
	optionTable = Tk_CreateOptionTable(interp, errorSpecs);
	tables[index] = optionTable;
	Tk_InitOptions(interp, (char *) &record, optionTable, tkwin);
	if (Tk_SetOptions(interp, (char *) &record, optionTable, 1,
		&newObjPtr, tkwin, NULL, NULL) != TCL_OK) {
	    result = TCL_ERROR;
	}
	Tcl_DecrRefCount(newObjPtr);
	Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin);
	Tk_DestroyWindow(tkwin);
	return result;
    }

    case TWO_WINDOWS: {
	typedef struct SlaveRecord {
	    TrivialCommandHeader header;
	    Tcl_Obj *windowPtr;
	} SlaveRecord;
	SlaveRecord *recordPtr;
	static const Tk_OptionSpec slaveSpecs[] = {
	    {TK_OPTION_WINDOW, "-window", "window", "Window", ".bar",
		Tk_Offset(SlaveRecord, windowPtr), -1, TK_CONFIG_NULL_OK, NULL, 0},
	    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
	};
	Tk_Window tkwin = Tk_CreateWindowFromPath(interp,
		(Tk_Window) clientData, Tcl_GetString(objv[2]), NULL);

	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_SetClass(tkwin, "Test");

	recordPtr = ckalloc(sizeof(SlaveRecord));
	recordPtr->header.interp = interp;
	recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
		slaveSpecs);
	tables[index] = recordPtr->header.optionTable;
	recordPtr->header.tkwin = tkwin;
	recordPtr->windowPtr = NULL;

	result = Tk_InitOptions(interp,  (char *) recordPtr,
		recordPtr->header.optionTable, tkwin);
	if (result == TCL_OK) {
	    result = Tk_SetOptions(interp, (char *) recordPtr,
		    recordPtr->header.optionTable, objc - 3, objv + 3,
		    tkwin, NULL, NULL);
	    if (result == TCL_OK) {
		recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			Tcl_GetString(objv[2]), TrivialConfigObjCmd,
			recordPtr, TrivialCmdDeletedProc);
		Tk_CreateEventHandler(tkwin, StructureNotifyMask,
			TrivialEventProc, recordPtr);
		Tcl_SetObjResult(interp, objv[2]);
	    } else {
		Tk_FreeConfigOptions((char *) recordPtr,
			recordPtr->header.optionTable, tkwin);
	    }
	}
	if (result != TCL_OK) {
	    Tk_DestroyWindow(tkwin);
	    ckfree(recordPtr);
	}
    }
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TrivialConfigObjCmd --
 *
 *	This command is used to test the configuration package. It only
 *	handles the "configure" and "cget" subcommands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TrivialConfigObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result = TCL_OK;
    static const char *const options[] = {
	"cget", "configure", "csave", NULL
    };
    enum {
	CGET, CONFIGURE, CSAVE
    };
    Tcl_Obj *resultObjPtr;
    int index, mask;
    TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
    Tk_Window tkwin = headerPtr->tkwin;
    Tk_SavedOptions saved;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
	    sizeof(char *), "command", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_Preserve(clientData);

    switch (index) {
    case CGET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "option");
	    result = TCL_ERROR;
	    goto done;
	}
	resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData,
		headerPtr->optionTable, objv[2], tkwin);
	if (resultObjPtr != NULL) {
	    Tcl_SetObjResult(interp, resultObjPtr);
	    result = TCL_OK;
	} else {
	    result = TCL_ERROR;
	}
	break;
    case CONFIGURE:
	if (objc == 2) {
	    resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
		    headerPtr->optionTable, NULL, tkwin);
	    if (resultObjPtr == NULL) {
		result = TCL_ERROR;
	    } else {
		Tcl_SetObjResult(interp, resultObjPtr);
	    }
	} else if (objc == 3) {
	    resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
		    headerPtr->optionTable, objv[2], tkwin);
	    if (resultObjPtr == NULL) {
		result = TCL_ERROR;
	    } else {
		Tcl_SetObjResult(interp, resultObjPtr);
	    }
	} else {
	    result = Tk_SetOptions(interp, (char *) clientData,
		    headerPtr->optionTable, objc - 2, objv + 2,
		    tkwin, NULL, &mask);
	    if (result == TCL_OK) {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
	    }
	}
	break;
    case CSAVE:
	result = Tk_SetOptions(interp, (char *) clientData,
		headerPtr->optionTable, objc - 2, objv + 2,
		tkwin, &saved, &mask);
	Tk_FreeSavedOptions(&saved);
	if (result == TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
	}
	break;
    }
  done:
    Tcl_Release(clientData);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TrivialCmdDeletedProc --
 *
 *	This function is invoked when a widget command is deleted. If the
 *	widget isn't already in the process of being destroyed, this command
 *	destroys it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
TrivialCmdDeletedProc(
    ClientData clientData)	/* Pointer to widget record for widget. */
{
    TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
    Tk_Window tkwin = headerPtr->tkwin;

    if (tkwin != NULL) {
	Tk_DestroyWindow(tkwin);
    } else if (headerPtr->optionTable != NULL) {
	/*
	 * This is a "new" object, which doesn't have a window, so we can't
	 * depend on cleaning up in the event function. Free its resources
	 * here.
	 */

	Tk_FreeConfigOptions((char *) clientData,
		headerPtr->optionTable, (Tk_Window) NULL);
	Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
    }
}

/*
 *--------------------------------------------------------------
 *
 * TrivialEventProc --
 *
 *	A dummy event proc.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When the window gets deleted, internal structures get cleaned up.
 *
 *--------------------------------------------------------------
 */

static void
TrivialEventProc(
    ClientData clientData,	/* Information about window. */
    XEvent *eventPtr)		/* Information about event. */
{
    TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;

    if (eventPtr->type == DestroyNotify) {
	if (headerPtr->tkwin != NULL) {
	    Tk_FreeConfigOptions((char *) clientData,
		    headerPtr->optionTable, headerPtr->tkwin);
	    headerPtr->optionTable = NULL;
	    headerPtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(headerPtr->interp,
		    headerPtr->widgetCmd);
	}
	Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TestfontObjCmd --
 *
 *	This function implements the "testfont" command, which is used to test
 *	TkFont objects.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestfontObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {"counts", "subfonts", NULL};
    enum option {COUNTS, SUBFONTS};
    int index;
    Tk_Window tkwin;
    Tk_Font tkfont;

    tkwin = (Tk_Window) clientData;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option fontName");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
	    sizeof(char *), "command", 0, &index)!= TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum option) index) {
    case COUNTS:
	Tcl_SetObjResult(interp,
		TkDebugFont(Tk_MainWindow(interp), Tcl_GetString(objv[2])));
	break;
    case SUBFONTS:
	tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
	if (tkfont == NULL) {
	    return TCL_ERROR;
	}
	TkpGetSubFonts(interp, tkfont);
	Tk_FreeFont(tkfont);
	break;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ImageCreate --
 *
 *	This function is called by the Tk image code to create "test" images.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The data structure for a new image is allocated.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ImageCreate(
    Tcl_Interp *interp,		/* Interpreter for application containing
				 * image. */
    const char *name,			/* Name to use for image. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument strings for options (doesn't
				 * include image name or type). */
    const Tk_ImageType *typePtr,	/* Pointer to our type record (not used). */
    Tk_ImageMaster master,	/* Token for image, to be used by us in later
				 * callbacks. */
    ClientData *clientDataPtr)	/* Store manager's token for image here; it
				 * will be returned in later callbacks. */
{
    TImageMaster *timPtr;
    const char *varName;
    int i;

    varName = "log";
    for (i = 0; i < objc; i += 2) {
	if (strcmp(Tcl_GetString(objv[i]), "-variable") != 0) {
	    Tcl_AppendResult(interp, "bad option name \"",
		    Tcl_GetString(objv[i]), "\"", NULL);
	    return TCL_ERROR;
	}
	if ((i+1) == objc) {
	    Tcl_AppendResult(interp, "no value given for \"",
		    Tcl_GetString(objv[i]), "\" option", NULL);
	    return TCL_ERROR;
	}
	varName = Tcl_GetString(objv[i+1]);
    }

    timPtr = ckalloc(sizeof(TImageMaster));
    timPtr->master = master;
    timPtr->interp = interp;
    timPtr->width = 30;
    timPtr->height = 15;
    timPtr->imageName = ckalloc(strlen(name) + 1);
    strcpy(timPtr->imageName, name);
    timPtr->varName = ckalloc(strlen(varName) + 1);
    strcpy(timPtr->varName, varName);
    Tcl_CreateCommand(interp, name, ImageCmd, timPtr, NULL);
    *clientDataPtr = timPtr;
    Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ImageCmd --
 *
 *	This function implements the commands corresponding to individual
 *	images.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Forces windows to be created.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ImageCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TImageMaster *timPtr = (TImageMaster *) clientData;
    int x, y, width, height;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], "option ?arg ...?", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "changed") == 0) {
	if (argc != 8) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " changed x y width height imageWidth imageHeight", NULL);
	    return TCL_ERROR;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
		timPtr->height);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be changed", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ImageGet --
 *
 *	This function is called by Tk to set things up for using a test image
 *	in a particular widget.
 *
 * Results:
 *	The return value is a token for the image instance, which is used in
 *	future callbacks to ImageDisplay and ImageFree.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static ClientData
ImageGet(
    Tk_Window tkwin,		/* Token for window in which image will be
				 * used. */
    ClientData clientData)	/* Pointer to TImageMaster for image. */
{
    TImageMaster *timPtr = (TImageMaster *) clientData;
    TImageInstance *instPtr;
    char buffer[100];
    XGCValues gcValues;

    sprintf(buffer, "%s get", timPtr->imageName);
    Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);

    instPtr = ckalloc(sizeof(TImageInstance));
    instPtr->masterPtr = timPtr;
    instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
    gcValues.foreground = instPtr->fg->pixel;
    instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
    return instPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ImageDisplay --
 *
 *	This function is invoked to redisplay part or all of an image in a
 *	given drawable.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The image gets partially redrawn, as an "X" that shows the exact
 *	redraw area.
 *
 *----------------------------------------------------------------------
 */

static void
ImageDisplay(
    ClientData clientData,	/* Pointer to TImageInstance for image. */
    Display *display,		/* Display to use for drawing. */
    Drawable drawable,		/* Where to redraw image. */
    int imageX, int imageY,	/* Origin of area to redraw, relative to
				 * origin of image. */
    int width, int height,	/* Dimensions of area to redraw. */
    int drawableX, int drawableY)
				/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = (TImageInstance *) clientData;
    char buffer[200 + TCL_INTEGER_SPACE * 6];

    sprintf(buffer, "%s display %d %d %d %d %d %d",
	    instPtr->masterPtr->imageName, imageX, imageY, width, height,
	    drawableX, drawableY);
    Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
	    buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    if (width > (instPtr->masterPtr->width - imageX)) {
	width = instPtr->masterPtr->width - imageX;
    }
    if (height > (instPtr->masterPtr->height - imageY)) {
	height = instPtr->masterPtr->height - imageY;
    }
    XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
	    (unsigned) (width-1), (unsigned) (height-1));
    XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
	    (int) (drawableX + width - 1), (int) (drawableY + height - 1));
    XDrawLine(display, drawable, instPtr->gc, drawableX,
	    (int) (drawableY + height - 1),
	    (int) (drawableX + width - 1), drawableY);
}

/*
 *----------------------------------------------------------------------
 *
 * ImageFree --
 *
 *	This function is called when an instance of an image is no longer
 *	used.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information related to the instance is freed.
 *
 *----------------------------------------------------------------------
 */

static void
ImageFree(
    ClientData clientData,	/* Pointer to TImageInstance for instance. */
    Display *display)		/* Display where image was to be drawn. */
{
    TImageInstance *instPtr = (TImageInstance *) clientData;
    char buffer[200];

    sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
    Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
	    buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    Tk_FreeColor(instPtr->fg);
    Tk_FreeGC(display, instPtr->gc);
    ckfree(instPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ImageDelete --
 *
 *	This function is called to clean up a test image when an application
 *	goes away.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information about the image is deleted.
 *
 *----------------------------------------------------------------------
 */

static void
ImageDelete(
    ClientData clientData)	/* Pointer to TImageMaster for image. When
				 * this function is called, no more instances
				 * exist. */
{
    TImageMaster *timPtr = (TImageMaster *) clientData;
    char buffer[100];

    sprintf(buffer, "%s delete", timPtr->imageName);
    Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);

    Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
    ckfree(timPtr->imageName);
    ckfree(timPtr->varName);
    ckfree(timPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestmakeexistCmd --
 *
 *	This function implements the "testmakeexist" command. It calls
 *	Tk_MakeWindowExist on each of its arguments to force the windows to be
 *	created.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Forces windows to be created.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestmakeexistCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tk_Window mainWin = (Tk_Window) clientData;
    int i;
    Tk_Window tkwin;

    for (i = 1; i < argc; i++) {
	tkwin = Tk_NameToWindow(interp, argv[i], mainWin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_MakeWindowExist(tkwin);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestmenubarCmd --
 *
 *	This function implements the "testmenubar" command. It is used to test
 *	the Unix facilities for creating space above a toplevel window for a
 *	menubar.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Changes menubar related stuff.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
static int
TestmenubarCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
#ifdef __UNIX__
    Tk_Window mainWin = (Tk_Window) clientData;
    Tk_Window tkwin, menubar;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "window") == 0) {
	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		    "window toplevel menubar\"", NULL);
	    return TCL_ERROR;
	}
	tkwin = Tk_NameToWindow(interp, argv[2], mainWin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	if (argv[3][0] == 0) {
	    TkUnixSetMenubar(tkwin, NULL);
	} else {
	    menubar = Tk_NameToWindow(interp, argv[3], mainWin);
	    if (menubar == NULL) {
		return TCL_ERROR;
	    }
	    TkUnixSetMenubar(tkwin, menubar);
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be  window", NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
#else
    Tcl_AppendResult(interp, "testmenubar is supported only under Unix", NULL);
    return TCL_ERROR;
#endif
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TestmetricsObjCmd --
 *
 *	This function implements the testmetrics command. It provides a way to
 *	determine the size of various widget components.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if defined(_WIN32) || defined(MAC_OSX_TK)
static int
TestmetricsObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    char buf[TCL_INTEGER_SPACE];
    int val;

#ifdef _WIN32
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
#else
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr;

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

    winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
    if (winPtr == NULL) {
	return TCL_ERROR;
    }
#endif

    if (strcmp(Tcl_GetString(objv[1]), "cyvscroll") == 0) {
#ifdef _WIN32
	val = GetSystemMetrics(SM_CYVSCROLL);
#else
	val = ((TkScrollbar *) winPtr->instanceData)->width;
#endif
    } else  if (strcmp(Tcl_GetString(objv[1]), "cxhscroll") == 0) {
#ifdef _WIN32
	val = GetSystemMetrics(SM_CXHSCROLL);
#else
	val = ((TkScrollbar *) winPtr->instanceData)->width;
#endif
    } else {
	Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
		"\": must be cxhscroll or cyvscroll", NULL);
	return TCL_ERROR;
    }
    sprintf(buf, "%d", val);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TestpropCmd --
 *
 *	This function implements the "testprop" command. It fetches and prints
 *	the value of a property on a window.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestpropCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tk_Window mainWin = (Tk_Window) clientData;
    int result, actualFormat;
    unsigned long bytesAfter, length, value;
    Atom actualType, propName;
    unsigned char *property, *p;
    char *end;
    Window w;
    char buffer[30];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" window property\"", NULL);
	return TCL_ERROR;
    }

    w = strtoul(argv[1], &end, 0);
    propName = Tk_InternAtom(mainWin, argv[2]);
    property = NULL;
    result = XGetWindowProperty(Tk_Display(mainWin),
	    w, propName, 0, 100000, False, AnyPropertyType,
	    &actualType, &actualFormat, &length,
	    &bytesAfter, &property);
    if ((result == Success) && (actualType != None)) {
	if ((actualFormat == 8) && (actualType == XA_STRING)) {
	    for (p = property; ((unsigned long)(p-property)) < length; p++) {
		if (*p == 0) {
		    *p = '\n';
		}
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj((/*!unsigned*/char*)property, -1));
	} else {
	    for (p = property; length > 0; length--) {
		if (actualFormat == 32) {
		    value = *((long *) p);
		    p += sizeof(long);
		} else if (actualFormat == 16) {
		    value = 0xffff & (*((short *) p));
		    p += sizeof(short);
		} else {
		    value = 0xff & *p;
		    p += 1;
		}
		sprintf(buffer, "0x%lx", value);
		Tcl_AppendElement(interp, buffer);
	    }
	}
    }
    if (property != NULL) {
	XFree(property);
    }
    return TCL_OK;
}

#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
/*
 *----------------------------------------------------------------------
 *
 * TestwrapperCmd --
 *
 *	This function implements the "testwrapper" command. It provides a way
 *	from Tcl to determine the extra window Tk adds in between the toplevel
 *	window and the window decorations.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestwrapperCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TkWindow *winPtr, *wrapperPtr;
    Tk_Window tkwin;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" window\"", NULL);
	return TCL_ERROR;
    }

    tkwin = (Tk_Window) clientData;
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
    if (winPtr == NULL) {
	return TCL_ERROR;
    }

    wrapperPtr = TkpGetWrapperWindow(winPtr);
    if (wrapperPtr != NULL) {
	char buf[TCL_INTEGER_SPACE];

	TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr));
	Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * CustomOptionSet, CustomOptionGet, CustomOptionRestore, CustomOptionFree --
 *
 *	Handlers for object-based custom configuration options. See
 *	Testobjconfigcommand.
 *
 * Results:
 *	See user documentation for expected results from these functions.
 *		CustomOptionSet		Standard Tcl Result.
 *		CustomOptionGet		Tcl_Obj * containing value.
 *		CustomOptionRestore	None.
 *		CustomOptionFree	None.
 *
 * Side effects:
 *	Depends on the function.
 *		CustomOptionSet		Sets option value to new setting.
 *		CustomOptionGet		Creates a new Tcl_Obj.
 *		CustomOptionRestore	Resets option value to original value.
 *		CustomOptionFree	Free storage for internal rep of
 *					option.
 *
 *----------------------------------------------------------------------
 */

static int
CustomOptionSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tk_Window tkwin,
    Tcl_Obj **value,
    char *recordPtr,
    int internalOffset,
    char *saveInternalPtr,
    int flags)
{
    int objEmpty;
    char *newStr, *string, *internalPtr;

    objEmpty = 0;

    if (internalOffset >= 0) {
	internalPtr = recordPtr + internalOffset;
    } else {
	internalPtr = NULL;
    }

    /*
     * See if the object is empty.
     */

    if (value == NULL) {
	objEmpty = 1;
	CLANG_ASSERT(value);
    } else if ((*value)->bytes != NULL) {
	objEmpty = ((*value)->length == 0);
    } else {
	(void)Tcl_GetString(*value);
	objEmpty = ((*value)->length == 0);
    }

    if ((flags & TK_OPTION_NULL_OK) && objEmpty) {
	*value = NULL;
    } else {
	string = Tcl_GetString(*value);
	Tcl_UtfToUpper(string);
	if (strcmp(string, "BAD") == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("expected good value, got \"BAD\"", -1));
	    return TCL_ERROR;
	}
    }
    if (internalPtr != NULL) {
	if (*value != NULL) {
	    string = Tcl_GetString(*value);
	    newStr = ckalloc((*value)->length + 1);
	    strcpy(newStr, string);
	} else {
	    newStr = NULL;
	}
	*((char **) saveInternalPtr) = *((char **) internalPtr);
	*((char **) internalPtr) = newStr;
    }

    return TCL_OK;
}

static Tcl_Obj *
CustomOptionGet(
    ClientData clientData,
    Tk_Window tkwin,
    char *recordPtr,
    int internalOffset)
{
    return (Tcl_NewStringObj(*(char **)(recordPtr + internalOffset), -1));
}

static void
CustomOptionRestore(
    ClientData clientData,
    Tk_Window tkwin,
    char *internalPtr,
    char *saveInternalPtr)
{
    *(char **)internalPtr = *(char **)saveInternalPtr;
    return;
}

static void
CustomOptionFree(
    ClientData clientData,
    Tk_Window tkwin,
    char *internalPtr)
{
    if (*(char **)internalPtr != NULL) {
	ckfree(*(char **)internalPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */