Tk Source Code

.TP 12
\fInumber\fR
.
Specifies the entry numerically, where 0 corresponds
to the top-most entry of the menu, 1 to the entry below it, and
so on.
.TP 12
\fIpattern\fR
\fIid\fR
.
If the index does not satisfy one of the above forms then this
If the index does not satisfy one of the above forms then the menu is
searched for an entry with the specified id.
.TP 12
\fIpattern\fR
.
If all of the above methods for finding an entry fail, this
form is used.  \fIPattern\fR is pattern-matched against the label of
each entry in the menu, in order from the top down, until a
matching entry is found.  The rules of \fBstring match\fR
are used.
.PP
If the index could match more than one of the above forms, then
the form earlier in the above list takes precedence.
.PP
The following widget commands are possible for menu widgets:
.TP
\fIpathName \fBactivate \fIindex\fR
.
Change the state of the entry indicated by \fIindex\fR to \fBactive\fR
and redisplay it using its active colors.
Any previously-active entry is deactivated.  If \fIindex\fR
is specified as \fB{}\fR or \fBnone\fR, or if the specified entry is
disabled, then the menu ends up with no active entry.
Returns an empty string.
.TP
\fIpathName \fBadd \fItype \fR?\fIoption value option value ...\fR?
\fIpathName \fBadd \fItype \fR?\fIid\fR? ?\fIoption value option value ...\fR?
.
Add a new entry to the bottom of the menu.  The new entry's type
is given by \fItype\fR and must be one of \fBcascade\fR,
\fBcheckbutton\fR, \fBcommand\fR, \fBradiobutton\fR, or \fBseparator\fR,
or a unique abbreviation of one of the above.  If additional arguments
are present, they specify the options listed in the \fBMENU ENTRY OPTIONS\fR
section below.
The \fBadd\fR widget command returns an empty string.
or a unique abbreviation of one of the above.
If the \fIid\fR argument is specified, it is used as the entry identifier;
\fIid\fR must not already exist in the menu. Otherwise, a new unique
identifier is generated.
If additional arguments are present, they specify the options listed in the
\fBMENU ENTRY OPTIONS\fR section below.
The \fBadd\fR widget command returns the id of the new entry.
.TP
\fIpathName \fBcget \fIoption\fR
.
Returns the current value of the configuration option given
by \fIoption\fR.
\fIOption\fR may have any of the values accepted by the \fBmenu\fR
command.

\fIOptions\fR may have any of the values described in the
\fBMENU ENTRY OPTIONS\fR
section below.  If \fIoptions\fR are specified, options are
modified as indicated in the command and the command returns an empty string.
If no \fIoptions\fR are specified, returns a list describing
the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for
information on the format of this list).
.TP
\fIpathName \fBid \fIindex\fR
.
Returns the id of the menu entry given by \fIindex\fR.
This is the identifier that was assigned to the entry when it was created
using the \fBadd\fR or \fBinsert\fR widget command.
Returns an empty string for the tear-off entry, or if \fIindex\fR is
equivalent to \fB{}\fR.
.TP
\fIpathName \fBindex \fIindex\fR
.
Returns the numerical index corresponding to \fIindex\fR, or
\fB{}\fR if \fIindex\fR was specified as \fB{}\fR or \fBnone\fR.
.TP
\fIpathName \fBinsert \fIindex type \fR?\fIoption value option value ...\fR?
\fIpathName \fBinsert \fIindex type \fR?\fIid\fR? ?\fIoption value option value ...\fR?
.
Same as the \fBadd\fR widget command except that it inserts the new
entry just before the entry given by \fIindex\fR, instead of appending
to the end of the menu.  The \fItype\fR, \fIoption\fR, and \fIvalue\fR
arguments have the same interpretation as for the \fBadd\fR widget
command.  It is not possible to insert new menu entries before the
to the end of the menu.  The \fItype\fR, \fIid\fR, \fIoption\fR, and
\fIvalue\fR arguments have the same interpretation as for the \fBadd\fR
widget command.  It is not possible to insert new menu entries before the
tear-off entry, if the menu has one.
The \fBinsert\fR widget command returns the id of the new entry.
.TP
\fIpathName \fBinvoke \fIindex\fR
.
Invoke the action of the menu entry.  See the sections on the
individual entries above for details on what happens.  If the
menu entry is disabled then nothing happens.  If the
entry has a command associated with it then the result of that

/*
 * Command line options. Put here because MenuCmd has to look at them along
 * with MenuWidgetObjCmd.
 */

static const char *const menuOptions[] = {
    "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
    "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
    "entryconfigure", "id", "index", "insert", "invoke", "post", "postcascade",
    "type", "unpost", "xposition", "yposition", NULL
};
enum options {
    MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,
    MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX,
    MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_ID, MENU_INDEX,
    MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,
    MENU_UNPOST, MENU_XPOSITION, MENU_YPOSITION
};

/*
 * Prototypes for static functions in this file:
 */

    menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
	    Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, menuPtr,
	    MenuCmdDeletedProc);
    menuPtr->active = TCL_INDEX_NONE;
    menuPtr->cursorPtr = NULL;
    menuPtr->mainMenuPtr = menuPtr;
    menuPtr->menuType = UNKNOWN_TYPE;
    Tcl_InitHashTable(&menuPtr->items, TCL_STRING_KEYS);
    menuPtr->serial = 0;
    TkMenuInitializeDrawingFields(menuPtr);

    Tk_SetClass(menuPtr->tkwin, "Menu");
    Tk_SetClassProcs(menuPtr->tkwin, &menuClass, menuPtr);
    Tk_CreateEventHandler(newWin,
	    ExposureMask|StructureNotifyMask|ActivateMask,
	    TkMenuEventProc, menuPtr);

	    }
	} else {
	    result = ConfigureMenuCloneEntries(menuPtr, index,
		    objc-3, objv+3);
	}
	Tcl_Release(mePtr);
	break;
    }
    case MENU_ID: {
	Tcl_Size index;
	const char *idStr;
        Tcl_HashEntry *entryPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	    goto error;
	}
	if (GetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
	    goto error;
	}
	if (index == TCL_INDEX_NONE) {
	    goto done;
	}
        entryPtr = menuPtr->entries[index]->entryPtr;
        if (entryPtr) {
            idStr = Tcl_GetHashKey(&menuPtr->items, entryPtr);
            Tcl_SetObjResult(interp, Tcl_NewStringObj(idStr, TCL_INDEX_NONE));
        }
	break;
    }
    case MENU_INDEX: {
	Tcl_Size index;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "string");
	    goto error;

	DestroyMenuEntry(menuPtr->entries[i]);
	menuPtr->numEntries = i;
    }
    if (menuPtr->entries != NULL) {
	ckfree(menuPtr->entries);
	menuPtr->entries = NULL;
    }
    Tcl_DeleteHashTable(&menuPtr->items);
    TkMenuFreeDrawOptions(menuPtr);
    Tk_FreeConfigOptions((char *) menuPtr,
	    tsdPtr->menuOptionTable, menuPtr->tkwin);
    if (menuPtr->tkwin != NULL) {
	Tk_Window tkwin = menuPtr->tkwin;

	menuPtr->tkwin = NULL;

	    && (mePtr->namePtr != NULL)) {
	const char *varName = Tcl_GetString(mePtr->namePtr);

	Tcl_UntraceVar2(menuPtr->interp, varName, NULL,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuVarProc, mePtr);
    }
    if (mePtr->entryPtr) {
        Tcl_DeleteHashEntry(mePtr->entryPtr);
        mePtr->entryPtr = NULL;
    }
    TkpDestroyMenuEntry(mePtr);
    TkMenuEntryFreeDrawOptions(mePtr);
    Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);
    ckfree(mePtr);
}

/*

				 * manual entry for valid .*/
    int lastOK,			/* Non-zero means its OK to return index just
				 * *after* last entry. */
    Tcl_Size *indexPtr)		/* Where to store converted index. */
{
    int i;
    const char *string;
    Tcl_HashEntry *entryPtr;

    if (TkGetIntForIndex(objPtr, menuPtr->numEntries - 1, lastOK, indexPtr) == TCL_OK) {
	/* TCL_INDEX_NONE is only accepted if it does not result from a negative number */
	if (*indexPtr != TCL_INDEX_NONE || Tcl_GetString(objPtr)[0] != '-') {
	    if (*indexPtr >= menuPtr->numEntries) {
		*indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
	    }

    if (string[0] == '@') {
	if (GetIndexFromCoords(NULL, menuPtr, string, indexPtr)
		== TCL_OK) {
	    goto success;
	}
    }

    entryPtr = Tcl_FindHashEntry(&menuPtr->items, string);
    if (entryPtr) {
        TkMenuEntry *mePtr = Tcl_GetHashValue(entryPtr);
        *indexPtr = mePtr->index;
        return TCL_OK;
    }

    for (i = 0; i < (int)menuPtr->numEntries; i++) {
	Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
	const char *label = (labelPtr == NULL) ? NULL : Tcl_GetString(labelPtr);

	if ((label != NULL) && (Tcl_StringCaseMatch(label, string, 0))) {
	    *indexPtr = i;

    mePtr->index = index;
    mePtr->nextCascadePtr = NULL;
    if (Tk_InitOptions(menuPtr->interp, mePtr,
	    mePtr->optionTable, menuPtr->tkwin) != TCL_OK) {
	ckfree(mePtr);
	return NULL;
    }
    mePtr->entryPtr = NULL;
    TkMenuInitializeEntryDrawingFields(mePtr);
    if (TkpMenuNewEntry(mePtr) != TCL_OK) {
	Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable,
		menuPtr->tkwin);
    	ckfree(mePtr);
    	return NULL;
    }

    Tcl_Obj *const objv[])	/* Arguments to command: first arg is type of
				 * entry, others are config options. */
{
    int type;
    Tcl_Size index;
    TkMenuEntry *mePtr;
    TkMenu *menuListPtr;
    Tcl_HashEntry *entryPtr;
    Tcl_Obj *idPtr = NULL;
    int isNew;
    int offs;

    if (indexPtr != NULL) {
	if (GetMenuIndex(interp, menuPtr, indexPtr, 1, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	index = menuPtr->numEntries;

     * Figure out the type of the new entry.
     */

    if (Tcl_GetIndexFromObjStruct(interp, objv[0], menuEntryTypeStrings,
	    sizeof(char *), "menu entry type", 0, &type) != TCL_OK) {
	return TCL_ERROR;
    }
    offs = 1;

    /*
     * Check for a user supplied id
     */

    if (objc % 2 == 0) {
        idPtr = objv[offs];
        if (Tcl_FindHashEntry(&menuPtr->items, Tcl_GetString(idPtr))) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "entry \"%s\" already exists", Tcl_GetString(idPtr)));
            Tcl_SetErrorCode(interp, "TK", "MENU", "ENTRY_EXISTS", NULL);
            return TCL_ERROR;
        }
        offs++;
    }

    /*
     * Now we have to add an entry for every instance related to this menu.
     */

    for (menuListPtr = menuPtr->mainMenuPtr; menuListPtr != NULL;
    	    menuListPtr = menuListPtr->nextInstancePtr) {

    	mePtr = MenuNewEntry(menuListPtr, index, type);
    	if (mePtr == NULL) {
    	    return TCL_ERROR;
    	}
    	if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
    	if (ConfigureMenuEntry(mePtr, objc - offs, objv + offs) != TCL_OK) {
	    TkMenu *errorMenuPtr;
	    Tcl_Size i;

	    for (errorMenuPtr = menuPtr->mainMenuPtr;
		    errorMenuPtr != NULL;
		    errorMenuPtr = errorMenuPtr->nextInstancePtr) {
    		Tcl_EventuallyFree(errorMenuPtr->entries[index],

		if (errorMenuPtr == menuListPtr) {
		    break;
		}
	    }
    	    return TCL_ERROR;
    	}

        if (idPtr == NULL) {
            char idbuf[16];
            /* Generate an id for the new entry on the main menu */
            do {
                snprintf(idbuf, sizeof(idbuf), "e%03X", ++menuPtr->serial);
                entryPtr = Tcl_CreateHashEntry(
			&menuListPtr->items, idbuf, &isNew);
            } while (!isNew);
            idPtr = Tcl_NewStringObj(idbuf, TCL_INDEX_NONE);
        } else {
            /* Reuse the specified or previously generated id on all clones */
            entryPtr = Tcl_CreateHashEntry(
		    &menuListPtr->items, Tcl_GetString(idPtr), &isNew);
        }
        Tcl_SetHashValue(entryPtr, mePtr);
        mePtr->entryPtr = entryPtr;

    	/*
	 * If a menu has cascades, then every instance of the menu has to have
	 * its own parallel cascade structure. So adding an entry to a menu
	 * with clones means that the menu that the entry points to has to be
	 * cloned for every clone the main menu has. This is special case #2
	 * in the comment at the top of this file.
    	 */

		Tcl_DecrRefCount(newCascadePtr);
		Tcl_DecrRefCount(menuNamePtr);
		Tcl_DecrRefCount(windowNamePtr);
		Tcl_DecrRefCount(normalPtr);
    	    }
    	}
    }

    Tcl_SetObjResult(interp, idPtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * MenuVarProc --

     */

    int entryFlags;		/* Various flags. See below for
				 * definitions. */
    int index;			/* Need to know which index we are. This is
    				 * zero-based. This is the top-left entry of
    				 * the menu. */
    Tcl_HashEntry *entryPtr;	/* Back-pointer to hash table entry */

    /*
     * Bookeeping for main menus and cascade menus.
     */

    struct TkMenuReferences *childMenuRefPtr;
    				/* A pointer to the hash table entry for the

    Tk_OptionSpec *extensionPtr;/* Needed by the configuration package for
				 * this widget to be extended. */
    Tk_SavedOptions *errorStructPtr;
				/* We actually have to allocate these because
				 * multiple menus get changed during one
				 * ConfigureMenu call. */
    Tcl_Obj *activeReliefPtr;	/* 3-d effect for active element. */
    Tcl_HashTable items;	/* Map: id -> entry */
    int serial;			/* Next item # for autogenerated ids */
} TkMenu;

/*
 * When the toplevel configure -menu command is executed, the menu may not
 * exist yet. We need to keep a linked list of windows that reference a
 * particular menu.
 */

    eval $cmd

    # Copy the meny entries, if any

    set last [$src index last]
    if {$last >= 0} {
	for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
	    set cmd [list $dst add [$src type $i]]
	    set cmd [list $dst add [$src type $i] [$src id $i]]
	    foreach option [$src entryconfigure $i]  {
		lappend cmd [lindex $option 0] [lindex $option 4]
	    }
	    eval $cmd
	}
    }

test menu-3.10 {MenuWidgetCmd procedure, "add" option} -setup {
    destroy .m1
} -body {
    menu .m1
    .m1 add separator
} -cleanup {
    destroy .m1
} -result {}
} -result {e001}
test menu-3.11 {MenuWidgetCmd procedure, "cget" option} -setup {
    destroy .m1
} -body {
    menu .m1
    .m1 cget
} -returnCodes error -result {wrong # args: should be ".m1 cget option"}
test menu-3.12 {MenuWidgetCmd procedure, "cget" option} -setup {

test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup {
    destroy .m1
} -body {
    menu .m1
    .m1 foo
} -cleanup {
    destroy .m1
} -returnCodes error -result {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition}
} -returnCodes error -result {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, id, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition}
test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} -setup {
    deleteWindows
} -body {
    set t .t
    set m1 .t.m1
    set c1 .t.c1
    set c2 .t.c2

test menu-11.15 {ConfigureMenuEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    list [.m1 add checkbutton -label "test"] [.m1 entrycget 1 -variable]
} -cleanup {
    deleteWindows
} -result {{} test}
} -result {e001 test}
test menu-11.16 {ConfigureMenuEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add radiobutton -label "test"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-11.17 {ConfigureMenuEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add checkbutton
    list [.m1 entryconfigure 1 -onvalue "test"] [.m1 entrycget 1 -onvalue]
} -cleanup {

    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
    list [.m1 insert last command -label "test2"] [.m1 entrycget last -label]
} -cleanup {
    deleteWindows
} -result {{} test2}
} -result {e002 test2}
test menu-13.5 {TkGetMenuIndex} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
    list [.m1 insert end command -label "test2"] [.m1 entrycget end -label]
} -cleanup {
    deleteWindows
} -result {{} test2}
} -result {e002 test2}
test menu-13.6 {TkGetMenuIndex} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"

test menu-15.1 {MenuNewEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-15.2 {MenuNewEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test3"
    .m1 insert 2 command -label "test2"
} -cleanup {
    deleteWindows
} -result {}
} -result {e003}
test menu-15.3 {MenuNewEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
} -cleanup {
    deleteWindows
} -result {}
} -result {e002}
test menu-15.4 {MenuNewEntry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}

test menu-16.1 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 insert foo command -label "test"
} -returnCodes error -result {bad menu entry index "foo"}
test menu-16.2 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"
    .m1 insert test command -label "foo"
} -cleanup {
    deleteWindows
} -result {}
} -result {e002}
test menu-16.3 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 insert -1 command -label "test"
} -returnCodes error -result {bad menu entry index "-1"}
test menu-16.4 {MenuAddOrInsert} -setup {

test menu-16.5 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add cascade
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-16.6 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add checkbutton
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-16.7 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-16.8 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add radiobutton
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-16.9 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add separator
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-16.10 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add blork
} -returnCodes error -result {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator}
test menu-16.11 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menu-16.12 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 clone .m2
    .m2 clone .m3
    list [.m2 add command -label "test"] [.m1 entrycget 1 -label] [.m3 entrycget 1 -label]
} -cleanup {
    deleteWindows
} -result {{} test test}
} -result {e001 test test}
test menu-16.13 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 clone .m2
    .m2 clone .m3
    list [.m3 add command -label "test"] [.m1 entrycget 1 -label] [.m2 entrycget 1 -label]
} -cleanup {
    deleteWindows
} -result {{} test test}
} -result {e001 test test}
test menu-16.14 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -blork
    .m1 add command -blork fish
} -returnCodes error -result {unknown option "-blork"}
test menu-16.15 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "File"
    menu .container
    . configure -menu .container
    list [.container add cascade -label "File" -menu .m1] [. configure -menu ""]
} -cleanup {
    deleteWindows
} -result {{} {}}
} -result {e001 {}}
test menu-16.16 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    menu .m2
    set tearoff [tk::TearOffMenu .m2]
    list [.m2 add cascade -menu .m1] [$tearoff unpost]
} -cleanup {
    deleteWindows
} -result {{} {}}
} -result {e001 {}}
test menu-16.17 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    menu .container
    . configure -menu .container
    set tearoff [tk::TearOffMenu .container]
    list [.container add cascade -label "File" -menu .m1] [. configure -menu ""]
} -cleanup {
    deleteWindows
} -result {{} {}}
} -result {e001 {}}
test menu-16.18 {MenuAddOrInsert} -setup {
    deleteWindows
} -body {
    menu .m1
    menu .container
    .container add cascade -menu .m1
    . configure -menu .container
    list [.container add cascade -label "File" -menu .m1] [. configure -menu ""]
} -cleanup {
    deleteWindows
} -result {{} {}}
} -result {e002 {}}
test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} -setup {
    deleteWindows
} -body {
    menu .menubar
    menu .menubar.test -tearoff 0
    .menubar add cascade -label Test -underline 0 -menu .menubar.test
    menu .menubar.test.cascade -tearoff 0

    catch {unset foo}
    menu .m1
    set foo "hello"
    list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
            [unset foo]
} -cleanup {
    deleteWindows
} -result {{} {}}
} -result {e001 {}}
# menu-17.2 - Don't know how to generate the flags in the if
test menu-17.2 {MenuVarProc} -setup {
    deleteWindows
} -body {
    catch {unset foo}
    menu .m1
    list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
            [set foo ""]
} -cleanup {
    deleteWindows
} -result {{} {}}
} -result {e001 {}}
test menu-17.3 {MenuVarProc} -setup {
    deleteWindows
} -body {
    catch {unset foo}
    menu .m1
    set foo "hello"
    list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
            [set foo "hello"] [unset foo]
} -cleanup {
    deleteWindows
} -result {{} hello {}}
} -result {e001 hello {}}
test menu-17.4 {MenuVarProc} -setup {
    deleteWindows
} -body {
    menu .m1
    set foo "goodbye"
    list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
            [set foo "hello"] [unset foo]
} -cleanup {
    deleteWindows
} -result {{} hello {}}
} -result {e001 hello {}}
test menu-17.5 {MenuVarProc} -setup {
    deleteWindows
} -body {
    menu .m1
    set foo "hello"
    list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
            [set foo "goodbye"] [unset foo]
} -cleanup {
    deleteWindows
} -result {{} goodbye {}}
} -result {e001 goodbye {}}
test menu-17.6 {MenuVarProc [5d991b822e]} -setup {
    deleteWindows
} -body {
    # Want this not to crash
    menu .b
    set var INIT
    .b add checkbutton -variable var

    catch {destroy .m}
} -body {
    menu .m -type {}
} -cleanup {
    destroy .m
} -returnCodes error -result {ambiguous type "": must be menubar, normal, or tearoff}

test menu-40.1 {identifiers - auto generated} -setup {
    destroy .m
} -body {
    menu .m
    list [.m add command -label 1] [.m add command -label 2] [.m add command -label 3]
} -cleanup {
    destroy .m
} -result {e001 e002 e003}
test menu-40.2 {identifiers - out of sequence} -setup {
    destroy .m
} -body {
    menu .m -tearoff 0
    .m add command -label 1
    .m insert 0 command -label 2
    .m add command -label 3
    list [.m index e001] [.m index e002] [.m index e003]
} -cleanup {
    destroy .m
} -result {1 0 2}
test menu-40.3 {identifiers - out of sequence with tearoff} -setup {
    destroy .m
} -body {
    menu .m -tearoff 1
    .m add command -label 1
    .m insert 0 command -label 2
    .m add command -label 3
    list [.m index e001] [.m index e002] [.m index e003]
} -cleanup {
    destroy .m
} -result {2 1 3}
test menu-40.4 {identifiers - entry id} -setup {
    destroy .m
} -body {
    menu .m -tearoff 1
    .m add command -label 1
    .m insert 0 command -label 2
    .m add command -label 3
    list [.m id 0] [.m id 1] [.m id 2] [.m id 3]
} -cleanup {
    destroy .m
} -result {{} e002 e001 e003}
test menu-40.5 {identifiers - assigned} -setup {
    destroy .m
} -body {
    menu .m
    list [.m add command cmd1 -label 1] [.m insert 0 command cmd2 -label 2] [.m add command cmd3 -label 3]
} -cleanup {
    destroy .m
} -result {cmd1 cmd2 cmd3}
test menu-40.6 {identifiers - mixed} -setup {
    destroy .m
} -body {
    menu .m
    list [.m add command -label 1] [.m insert 0 command cmd2 -label 2] [.m add command -label 3]
} -cleanup {
    destroy .m
} -result {e001 cmd2 e002}
test menu-40.7 {identifiers - conflict} -setup {
    destroy .m
} -body {
    menu .m
    list [.m add command e002 -label 1] [.m add command -label 2] [.m add command -label 3]
} -cleanup {
    destroy .m
} -result {e002 e001 e003}
test menu-40.8 {identifiers - clone of complete menu} -setup {
    destroy .m1 .m2
} -body {
    menu .m1 -tearoff 0
    .m1 add command -label 1
    .m1 insert 0 command -label 2
    .m1 add command cmd3 -label 3
    .m1 clone .m2
    list [.m2 index e001] [.m2 index e002] [.m2 index cmd3]
} -cleanup {
    destroy .m1 .m2
} -result {1 0 2}
test menu-40.9 {identifiers - modify after cloning} -setup {
    destroy .m1 .m2
} -body {
    menu .m1 -tearoff 0
    .m1 clone .m2
    .m1 add command -label 1
    .m1 insert 0 command -label 2
    .m1 add command cmd3 -label 3
    list [.m2 index e001] [.m2 index e002] [.m2 index cmd3]
} -cleanup {
    destroy .m1 .m2
} -result {1 0 2}
test menu-40.10 {identifiers - modify clone} -setup {
    destroy .m1 .m2
} -body {
    menu .m1 -tearoff 0
    .m1 clone .m2
    .m2 add command -label 1
    .m2 insert 0 command -label 2
    .m2 add command cmd3 -label 3
    list [.m1 index e001] [.m1 index e002] [.m1 index cmd3]
} -cleanup {
    destroy .m1 .m2
} -result {1 0 2}
test menu-40.11 {identifiers - entrycget by id} -setup {
    destroy .m
} -body {
    menu .m
    .m add command -label 1
    .m add command -label 2
    .m add command cmd3 -label 3
    list [.m entrycget e001 -label] [.m entrycget e002 -label] [.m entrycget cmd3 -label]
} -cleanup {
    destroy .m
} -result {1 2 3}
test menu-40.12 {identifiers - delete by id} -setup {
    destroy .m
} -body {
    menu .m
    .m add command -label 1
    .m add command -label 2
    .m add command -label 3
    .m add command -label 4
    .m add command -label 5
    .m add command -label 6
    .m add command -label 7
    .m add command cmd8 -label 8
    .m add command cmd9 -label 9
    .m delete e003 cmd8
    list [.m id 0] [.m id 1] [.m id 2]
} -cleanup {
    destroy .m
} -result {e001 e002 cmd9}
test menu-40.13 {identifiers - duplicate} -setup {
    destroy .m
} -body {
    menu .m
    .m add command foo -label 1
    .m add command bar -label 2
    .m add command foo -label 3
} -cleanup {
    destroy .m
} -returnCodes error -result {entry "foo" already exists}
test menu-40.14 {identifiers - reserved word} -setup {
    destroy .m
} -body {
    menu .m -tearoff 0
    .m add command last -label 1
    .m add command -label 2
    .m add command -label 3
    .m index last
} -cleanup {
    destroy .m
} -result {2}

# cleanup
imageFinish
deleteWindows
cleanupTests
return

# Local variables:
# mode: tcl
# End:

test menuDraw-2.1 {TkInitializeMenuEntryDrawingFields} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}


test menuDraw-3.1 {TkMenuFreeDrawOptions} -setup {
    deleteWindows
} -body {
    menu .m1
    destroy .m1

test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -font "Courier 12"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.3 {TkMenuConfigureEntryDrawOptions - active state - wrong entry} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo"
    .m1 entryconfigure 1 -state active
} -cleanup {

test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -font "Courier 12"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -background "red"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -foreground "red"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -activebackground "red"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -activeforeground "red"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add radiobutton -label "foo" -selectcolor "red"
} -cleanup {
    deleteWindows
} -result {}
} -result {e001}
test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} -setup {
    deleteWindows
} -body {
    menu .m1
    .m1 add command -label "foo" -font "Helvetica 12"
    .m1 entryconfigure 1 -font "Courier 12"
} -cleanup {

} -setup {
    destroy .m1
} -body {
    catch {image delete image1}
    menu .m1
    image create test image1
    list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
} -result {0 {} {} {}}
} -result {0 e001 {} {}}
test winMenu-6.3 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.4 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.5 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.6 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.7 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.8 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.9 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.10 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.11 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.12 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.13 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.14 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.15 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}
test winMenu-6.16 {GetEntryText} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}

test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} -constraints {
    win
} -setup {
    destroy .m1
} -body {
    menu .m1

test winMenu-9.1 {TkpMenuNewEntry} -constraints win -setup {
    destroy .m1
} -body {
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e001 {}}


test winMenu-10.1 {TkwinMenuProc} -constraints {
    win userInteraction
} -setup {
    destroy .m1
} -body {

    win
} -setup {
    destroy .m1
} -body {
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e002 {}}
test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} -constraints {
    win
} -setup {
    destroy .m1
} -body {
    menu .m1 -tearoff 0
    .m1 add command -label One
    update idletasks
    list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} -result {0 {} {}}
} -result {0 e002 {}}


test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} -constraints {
    win
} -setup {
    destroy .m1
} -body {