From 54ada25aed7a1c8425bc546d8c2e5376a6656190 Mon Sep 17 00:00:00 2001 From: sbron Date: Thu, 16 Mar 2023 23:08:12 +0000 Subject: Implement TIP 658 --- doc/menu.n | 34 ++++++++++++++++------ generic/tkMenu.c | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++--- generic/tkMenu.h | 3 ++ library/tearoff.tcl | 2 +- tests/menu.test | 58 ++++++++++++++++++------------------ 5 files changed, 138 insertions(+), 43 deletions(-) diff --git a/doc/menu.n b/doc/menu.n index 42d1775..a7c52ab 100644 --- a/doc/menu.n +++ b/doc/menu.n @@ -356,6 +356,10 @@ 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 +. +Indicates the entry with the specified id. +.TP 12 \fIpattern\fR . If the index does not satisfy one of the above forms then this @@ -378,15 +382,18 @@ 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 . @@ -447,19 +454,28 @@ 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 . diff --git a/generic/tkMenu.c b/generic/tkMenu.c index c5d2bf5..69ef6da 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -306,12 +306,12 @@ static const Tk_OptionSpec tkMenuConfigSpecs[] = { 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 }; @@ -451,6 +451,8 @@ Tk_MenuObjCmd( 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"); @@ -821,6 +823,28 @@ MenuWidgetObjCmd( 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; @@ -1189,6 +1213,7 @@ DestroyMenuInstance( ckfree(menuPtr->entries); menuPtr->entries = NULL; } + Tcl_DeleteHashTable(&menuPtr->items); TkMenuFreeDrawOptions(menuPtr); Tk_FreeConfigOptions((char *) menuPtr, tsdPtr->menuOptionTable, menuPtr->tkwin); @@ -1455,6 +1480,10 @@ DestroyMenuEntry( 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); @@ -2112,6 +2141,7 @@ GetMenuIndex( { 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 */ @@ -2153,6 +2183,13 @@ GetMenuIndex( } } + 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); @@ -2301,6 +2338,7 @@ MenuNewEntry( ckfree(mePtr); return NULL; } + mePtr->entryPtr = NULL; TkMenuInitializeEntryDrawingFields(mePtr); if (TkpMenuNewEntry(mePtr) != TCL_OK) { Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, @@ -2343,6 +2381,10 @@ MenuAddOrInsert( 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) { @@ -2369,11 +2411,26 @@ MenuAddOrInsert( sizeof(char *), "menu entry type", 0, &type) != TCL_OK) { return TCL_ERROR; } + offs = 1; /* - * Now we have to add an entry for every instance related to this menu. + * 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) { @@ -2381,7 +2438,7 @@ MenuAddOrInsert( 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; @@ -2405,6 +2462,23 @@ MenuAddOrInsert( 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 @@ -2450,6 +2524,8 @@ MenuAddOrInsert( } } } + + Tcl_SetObjResult(interp, idPtr); return TCL_OK; } diff --git a/generic/tkMenu.h b/generic/tkMenu.h index 21ca097..f459277 100644 --- a/generic/tkMenu.h +++ b/generic/tkMenu.h @@ -183,6 +183,7 @@ typedef struct TkMenuEntry { 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. @@ -379,6 +380,8 @@ typedef struct TkMenu { * 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; /* diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 3edae7b..ef51fb3 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -139,7 +139,7 @@ proc ::tk::MenuDup {src dst type} { return } 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] } diff --git a/tests/menu.test b/tests/menu.test index c18a274..47f9919 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1310,7 +1310,7 @@ test menu-3.10 {MenuWidgetCmd procedure, "add" option} -setup { .m1 add separator } -cleanup { destroy .m1 -} -result {} +} -result {e001} test menu-3.11 {MenuWidgetCmd procedure, "cget" option} -setup { destroy .m1 } -body { @@ -1819,7 +1819,7 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup { .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 { @@ -2647,7 +2647,7 @@ test menu-11.15 {ConfigureMenuEntry} -setup { 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 { @@ -2655,7 +2655,7 @@ test menu-11.16 {ConfigureMenuEntry} -setup { .m1 add radiobutton -label "test" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-11.17 {ConfigureMenuEntry} -setup { deleteWindows } -body { @@ -2818,7 +2818,7 @@ test menu-13.4 {TkGetMenuIndex} -setup { 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 { @@ -2827,7 +2827,7 @@ test menu-13.5 {TkGetMenuIndex} -setup { 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 { @@ -2924,7 +2924,7 @@ test menu-15.1 {MenuNewEntry} -setup { .m1 add command -label "test" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-15.2 {MenuNewEntry} -setup { deleteWindows } -body { @@ -2934,7 +2934,7 @@ test menu-15.2 {MenuNewEntry} -setup { .m1 insert 2 command -label "test2" } -cleanup { deleteWindows -} -result {} +} -result {e003} test menu-15.3 {MenuNewEntry} -setup { deleteWindows } -body { @@ -2943,7 +2943,7 @@ test menu-15.3 {MenuNewEntry} -setup { .m1 add command -label "test2" } -cleanup { deleteWindows -} -result {} +} -result {e002} test menu-15.4 {MenuNewEntry} -setup { deleteWindows } -body { @@ -2951,7 +2951,7 @@ test menu-15.4 {MenuNewEntry} -setup { .m1 add command -label "test" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.1 {MenuAddOrInsert} -setup { deleteWindows @@ -2967,7 +2967,7 @@ test menu-16.2 {MenuAddOrInsert} -setup { .m1 insert test command -label "foo" } -cleanup { deleteWindows -} -result {} +} -result {e002} test menu-16.3 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -2991,7 +2991,7 @@ test menu-16.5 {MenuAddOrInsert} -setup { .m1 add cascade } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.6 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -2999,7 +2999,7 @@ test menu-16.6 {MenuAddOrInsert} -setup { .m1 add checkbutton } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.7 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3007,7 +3007,7 @@ test menu-16.7 {MenuAddOrInsert} -setup { .m1 add command } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.8 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3015,7 +3015,7 @@ test menu-16.8 {MenuAddOrInsert} -setup { .m1 add radiobutton } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.9 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3023,7 +3023,7 @@ test menu-16.9 {MenuAddOrInsert} -setup { .m1 add separator } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.10 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3037,7 +3037,7 @@ test menu-16.11 {MenuAddOrInsert} -setup { .m1 add command } -cleanup { deleteWindows -} -result {} +} -result {e001} test menu-16.12 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3047,7 +3047,7 @@ test menu-16.12 {MenuAddOrInsert} -setup { 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 { @@ -3057,12 +3057,12 @@ test menu-16.13 {MenuAddOrInsert} -setup { 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 @@ -3074,7 +3074,7 @@ test menu-16.15 {MenuAddOrInsert} -setup { list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] } -cleanup { deleteWindows -} -result {{} {}} +} -result {e001 {}} test menu-16.16 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3084,7 +3084,7 @@ test menu-16.16 {MenuAddOrInsert} -setup { list [.m2 add cascade -menu .m1] [$tearoff unpost] } -cleanup { deleteWindows -} -result {{} {}} +} -result {e001 {}} test menu-16.17 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3095,7 +3095,7 @@ test menu-16.17 {MenuAddOrInsert} -setup { list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] } -cleanup { deleteWindows -} -result {{} {}} +} -result {e001 {}} test menu-16.18 {MenuAddOrInsert} -setup { deleteWindows } -body { @@ -3106,7 +3106,7 @@ test menu-16.18 {MenuAddOrInsert} -setup { 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 { @@ -3135,7 +3135,7 @@ test menu-17.1 {MenuVarProc} -setup { [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 @@ -3146,7 +3146,7 @@ test menu-17.2 {MenuVarProc} -setup { [set foo ""] } -cleanup { deleteWindows -} -result {{} {}} +} -result {e001 {}} test menu-17.3 {MenuVarProc} -setup { deleteWindows } -body { @@ -3157,7 +3157,7 @@ test menu-17.3 {MenuVarProc} -setup { [set foo "hello"] [unset foo] } -cleanup { deleteWindows -} -result {{} hello {}} +} -result {e001 hello {}} test menu-17.4 {MenuVarProc} -setup { deleteWindows } -body { @@ -3167,7 +3167,7 @@ test menu-17.4 {MenuVarProc} -setup { [set foo "hello"] [unset foo] } -cleanup { deleteWindows -} -result {{} hello {}} +} -result {e001 hello {}} test menu-17.5 {MenuVarProc} -setup { deleteWindows } -body { @@ -3177,7 +3177,7 @@ test menu-17.5 {MenuVarProc} -setup { [set foo "goodbye"] [unset foo] } -cleanup { deleteWindows -} -result {{} goodbye {}} +} -result {e001 goodbye {}} test menu-17.6 {MenuVarProc [5d991b822e]} -setup { deleteWindows } -body { -- cgit v0.12 From c9fa73560e09fd8645deaee8706d15a6f0d8c80c Mon Sep 17 00:00:00 2001 From: sbron Date: Mon, 20 Mar 2023 10:04:59 +0000 Subject: Add tests for TIP 658. --- tests/menu.test | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) diff --git a/tests/menu.test b/tests/menu.test index 47f9919..e330417 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -4004,6 +4004,136 @@ test menu-39.1 {empty -type - bug be8f5b9fc2} -setup { 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} # cleanup imageFinish -- cgit v0.12 From d506153e3da3be7340e7242424d74a23342d8428 Mon Sep 17 00:00:00 2001 From: sbron Date: Mon, 20 Mar 2023 10:35:49 +0000 Subject: Fix error message formatting and add a test for the error scenario. --- generic/tkMenu.c | 2 +- tests/menu.test | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 69ef6da..1d607ff 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -2421,7 +2421,7 @@ MenuAddOrInsert( idPtr = objv[offs]; if (Tcl_FindHashEntry(&menuPtr->items, Tcl_GetString(idPtr))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Entry %s already exists", Tcl_GetString(idPtr))); + "entry \"%s\" already exists", Tcl_GetString(idPtr))); Tcl_SetErrorCode(interp, "TK", "MENU", "ENTRY_EXISTS", NULL); return TCL_ERROR; } diff --git a/tests/menu.test b/tests/menu.test index e330417..a114269 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -4134,6 +4134,16 @@ test menu-40.12 {identifiers - delete by id} -setup { } -cleanup { destroy .m } -result {e001 e002 cmd9} +test menu-40.12 {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} # cleanup imageFinish -- cgit v0.12 From b45b889e42c564146e30421a45430524ad4901e3 Mon Sep 17 00:00:00 2001 From: sbron Date: Tue, 21 Mar 2023 09:25:50 +0000 Subject: Fix menuDraw tests impacted by the tip. --- tests/menuDraw.test | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/menuDraw.test b/tests/menuDraw.test index ff639c1..2cafc31 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -27,7 +27,7 @@ test menuDraw-2.1 {TkInitializeMenuEntryDrawingFields} -setup { .m1 add command } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-3.1 {TkMenuFreeDrawOptions} -setup { @@ -86,7 +86,7 @@ test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} -setup .m1 add command -label "foo" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup { deleteWindows } -body { @@ -94,7 +94,7 @@ test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup { .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 { @@ -140,7 +140,7 @@ test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup { .m1 add command -label "foo" -font "Courier 12" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} -setup { deleteWindows } -body { @@ -148,7 +148,7 @@ test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} -setup { .m1 add command -label "foo" -background "red" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} -setup { deleteWindows } -body { @@ -156,7 +156,7 @@ test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} -setu .m1 add command -label "foo" -foreground "red" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} -setup { deleteWindows } -body { @@ -164,7 +164,7 @@ test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} -s .m1 add command -label "foo" -activebackground "red" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} -setup { deleteWindows } -body { @@ -172,7 +172,7 @@ test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified .m1 add command -label "foo" -activeforeground "red" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} -setup { deleteWindows } -body { @@ -180,7 +180,7 @@ test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} -se .m1 add radiobutton -label "foo" -selectcolor "red" } -cleanup { deleteWindows -} -result {} +} -result {e001} test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} -setup { deleteWindows } -body { -- cgit v0.12 From 05c5d0fe0705587ef8e1c9bf338d545a216c366e Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 21 Mar 2023 20:27:22 +0000 Subject: Fix winMenu tests impacted by the tip. --- tests/winMenu.test | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/tests/winMenu.test b/tests/winMenu.test index 3b7dbec..21768ef 100644 --- a/tests/winMenu.test +++ b/tests/winMenu.test @@ -93,91 +93,91 @@ test winMenu-6.2 {GetEntryText} -constraints { 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 @@ -427,7 +427,7 @@ test winMenu-9.1 {TkpMenuNewEntry} -constraints win -setup { } -body { menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] -} -result {0 {} {}} +} -result {0 e001 {}} test winMenu-10.1 {TkwinMenuProc} -constraints { @@ -859,7 +859,7 @@ test winMenu-28.1 {TkpConfigureMenuEntry - update pending} -constraints { 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 { @@ -869,7 +869,7 @@ test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} -constraints { .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 { -- cgit v0.12 From 7507eed9e7847c0439c3077014323566869d5a46 Mon Sep 17 00:00:00 2001 From: sbron Date: Wed, 22 Mar 2023 10:19:09 +0000 Subject: Describe the search order more explicitly. --- doc/menu.n | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/menu.n b/doc/menu.n index a7c52ab..7d16e01 100644 --- a/doc/menu.n +++ b/doc/menu.n @@ -358,11 +358,12 @@ so on. .TP 12 \fIid\fR . -Indicates the entry with the specified id. +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 -- cgit v0.12 From 6690b12e0d44f29ed6d22f886d370adba7368924 Mon Sep 17 00:00:00 2001 From: sbron Date: Wed, 22 Mar 2023 10:29:02 +0000 Subject: Add a test for an id that is equal to a special index. --- tests/menu.test | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/tests/menu.test b/tests/menu.test index a114269..756c4ed 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -4134,7 +4134,7 @@ test menu-40.12 {identifiers - delete by id} -setup { } -cleanup { destroy .m } -result {e001 e002 cmd9} -test menu-40.12 {identifiers - duplicate} -setup { +test menu-40.13 {identifiers - duplicate} -setup { destroy .m } -body { menu .m @@ -4144,6 +4144,17 @@ test menu-40.12 {identifiers - duplicate} -setup { } -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 -- cgit v0.12 From 3813048adc609662006a24942ac3f05c76f6ae79 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 May 2023 10:21:41 +0000 Subject: Continuation lines should be indented 8 chars. --- generic/tkMenu.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tkMenu.c b/generic/tkMenu.c index f07b224..58489b3 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -2421,7 +2421,7 @@ MenuAddOrInsert( idPtr = objv[offs]; if (Tcl_FindHashEntry(&menuPtr->items, Tcl_GetString(idPtr))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "entry \"%s\" already exists", Tcl_GetString(idPtr))); + "entry \"%s\" already exists", Tcl_GetString(idPtr))); Tcl_SetErrorCode(interp, "TK", "MENU", "ENTRY_EXISTS", NULL); return TCL_ERROR; } @@ -2467,14 +2467,14 @@ MenuAddOrInsert( /* 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); + 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); + &menuListPtr->items, Tcl_GetString(idPtr), &isNew); } Tcl_SetHashValue(entryPtr, mePtr); mePtr->entryPtr = entryPtr; -- cgit v0.12