Index: doc/menu.n ================================================================== --- doc/menu.n +++ doc/menu.n @@ -354,13 +354,18 @@ . 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 +\fIid\fR +. +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 the index does not satisfy one of the above forms then this +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 @@ -376,19 +381,22 @@ 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. @@ -444,24 +452,33 @@ 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 Index: generic/tkMenu.c ================================================================== --- generic/tkMenu.c +++ generic/tkMenu.c @@ -304,16 +304,16 @@ * 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 }; /* @@ -449,10 +449,12 @@ 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, @@ -818,10 +820,32 @@ 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) { @@ -1187,10 +1211,11 @@ } 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; @@ -1453,10 +1478,14 @@ 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); } @@ -2110,10 +2139,11 @@ * *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) { @@ -2150,10 +2180,17 @@ 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); @@ -2299,10 +2336,11 @@ 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); @@ -2341,10 +2379,14 @@ { 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; } @@ -2367,23 +2409,38 @@ 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; @@ -2403,10 +2460,27 @@ } } 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 @@ -2448,10 +2522,12 @@ Tcl_DecrRefCount(windowNamePtr); Tcl_DecrRefCount(normalPtr); } } } + + Tcl_SetObjResult(interp, idPtr); return TCL_OK; } /* *-------------------------------------------------------------- Index: generic/tkMenu.h ================================================================== --- generic/tkMenu.h +++ generic/tkMenu.h @@ -181,10 +181,11 @@ 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. */ @@ -377,10 +378,12 @@ 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 Index: library/tearoff.tcl ================================================================== --- library/tearoff.tcl +++ library/tearoff.tcl @@ -138,11 +138,11 @@ # 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 } Index: tests/menu.test ================================================================== --- tests/menu.test +++ tests/menu.test @@ -1308,11 +1308,11 @@ } -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 @@ -1817,11 +1817,11 @@ } -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 @@ -2645,19 +2645,19 @@ } -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 @@ -2816,20 +2816,20 @@ 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" @@ -2922,38 +2922,38 @@ } -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 @@ -2965,11 +2965,11 @@ 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" @@ -2989,43 +2989,43 @@ } -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 @@ -3035,36 +3035,36 @@ } -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 @@ -3072,21 +3072,21 @@ 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 @@ -3093,11 +3093,11 @@ . 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 @@ -3104,11 +3104,11 @@ .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 @@ -3133,11 +3133,11 @@ 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} @@ -3144,11 +3144,11 @@ 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 @@ -3155,31 +3155,31 @@ 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 @@ -4054,10 +4054,161 @@ 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 Index: tests/menuDraw.test ================================================================== --- tests/menuDraw.test +++ tests/menuDraw.test @@ -25,11 +25,11 @@ } -body { menu .m1 .m1 add command } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-3.1 {TkMenuFreeDrawOptions} -setup { deleteWindows } -body { @@ -84,19 +84,19 @@ } -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" @@ -138,51 +138,51 @@ } -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" Index: tests/winMenu.test ================================================================== --- tests/winMenu.test +++ tests/winMenu.test @@ -91,95 +91,95 @@ } -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 @@ -425,11 +425,11 @@ 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 { @@ -857,21 +857,21 @@ 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 {