diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | doc/menu.n | 39 | ||||
| -rw-r--r-- | generic/tkMenu.c | 83 | ||||
| -rw-r--r-- | tests/menu.test | 21 |
4 files changed, 109 insertions, 43 deletions
@@ -1,3 +1,12 @@ +2006-12-04 Donal K. Fellows <dkf@users.sf.net> + + TIP #286 IMPLEMENTATION + + * generic/tkMenu.c (MenuWidgetObjCmd, MenuDoXPosition): + * doc/menu.n, tests/menu.test: Added an [$menu xposition] subcommand + which is useful in menubars and when menus use multiple columns. Many + thanks to Schelte Bron for the implementation. + 2006-12-01 Kevin Kenny <kennykb@acm.org> TIP #300 IMPLEMENTATION @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: menu.n,v 1.12 2005/04/06 21:11:54 dkf Exp $ +'\" RCS: @(#) $Id: menu.n,v 1.13 2006/12/04 15:16:31 dkf Exp $ '\" .so man.macros .TH menu n 4.1 Tk "Tk Built-In Commands" @@ -118,21 +118,19 @@ Whenever a menu's active entry is changed, a <<MenuSelect>> virtual event is send to the menu. The active item can then be queried from the menu, and an action can be taken, such as setting context-sensitive help text for the entry. - -.SH "COMMAND ENTRIES" +.SH "TYPES OF ENTRIES" +.SS "COMMAND ENTRIES" .PP The most common kind of menu entry is a command entry, which behaves much like a button widget. When a command entry is invoked, a Tcl command is executed. The Tcl command is specified with the \fB\-command\fR option. - -.SH "SEPARATOR ENTRIES" +.SS "SEPARATOR ENTRIES" .PP A separator is an entry that is displayed as a horizontal dividing line. A separator may not be activated or invoked, and it has no behavior other than its display appearance. - -.SH "CHECKBUTTON ENTRIES" +.SS "CHECKBUTTON ENTRIES" .PP A checkbutton menu entry behaves much like a checkbutton widget. When it is invoked it toggles back and forth between the selected @@ -149,8 +147,7 @@ the menu. If a \fB\-command\fR option is specified for a checkbutton entry, then its value is evaluated as a Tcl command each time the entry is invoked; this happens after toggling the entry's selected state. - -.SH "RADIOBUTTON ENTRIES" +.SS "RADIOBUTTON ENTRIES" .PP A radiobutton menu entry behaves much like a radiobutton widget. Radiobutton entries are organized in groups of which only one @@ -173,8 +170,7 @@ otherwise the indicator's center is displayed in the background color for the menu. If a \fB\-command\fR option is specified for a radiobutton entry, then its value is evaluated as a Tcl command each time the entry is invoked; this happens after selecting the entry. - -.SH "CASCADE ENTRIES" +.SS "CASCADE ENTRIES" .PP A cascade entry is one with an associated menu (determined by the \fB\-menu\fR option). Cascade entries allow the construction @@ -205,8 +201,7 @@ menu. If a \fB\-command\fR option is specified for a cascade entry then it is evaluated as a Tcl command whenever the entry is invoked. This is not supported on Windows. - -.SH "TEAR-OFF ENTRIES" +.SS "TEAR-OFF ENTRIES" .PP A tear-off entry appears at the top of the menu if enabled with the \fBtearOff\fR option. It is not like other menu entries in that @@ -216,7 +211,6 @@ When a tear-off entry is created it appears as a dashed line at the top of the menu. Under the default bindings, invoking the tear-off entry causes a torn-off copy to be made of the menu and all of its submenus. - .SH "MENUBARS" .PP Any menu can be set as a menubar for a toplevel window (see @@ -233,8 +227,7 @@ example of this concerns the handling of checkbuttons and radiobuttons within the menu. While it is permitted to put these menu elements on menubars, they may not be drawn with indicators on some platforms, due to system restrictions. - -.SH "SPECIAL MENUS IN MENUBARS" +.SS "SPECIAL MENUS IN MENUBARS" .PP Certain menus in a menubar will be treated specially. On the Macintosh, access to the special Apple and Help menus is provided. On Windows, @@ -274,7 +267,6 @@ system menu. .PP When Tk see a Help menu on X Windows, the menu is moved to be last in the menubar and is right justified. - .SH "CLONES" .PP When a menu is set as a menubar for a toplevel window, or when a menu @@ -285,7 +277,6 @@ clone. Additionally, any cascades that are pointed to are also cloned so that menu traversal will work right. Clones are destroyed when either the tearoff or menubar goes away, or when the original menu is destroyed. - .SH "WIDGET COMMAND" .PP The \fBmenu\fR command creates a new Tcl command whose @@ -637,10 +628,15 @@ lower-level cascaded menu is posted, unpost that menu. Returns an empty string. This subcommand does not work on Windows and the Macintosh, as those platforms have their own way of unposting menus. .TP +\fIpathName \fBxposition \fIindex\fR +.VS 8.5 +Returns a decimal string giving the x-coordinate within the menu +window of the leftmost pixel in the entry specified by \fIindex\fR. +.VE 8.5 +.TP \fIpathName \fByposition \fIindex\fR Returns a decimal string giving the y-coordinate within the menu window of the topmost pixel in the entry specified by \fIindex\fR. - .SH "MENU CONFIGURATIONS" .PP The default bindings support four different ways of using menus: @@ -683,7 +679,6 @@ the top of an existing menu. The default bindings will create a new menu that is a copy of the original menu and leave it permanently posted as a top-level window. The torn-off menu behaves just the same as the original menu. - .SH "DEFAULT BINDINGS" .PP Tk automatically creates class bindings for menus that give them @@ -744,12 +739,12 @@ argument, which is a menu widget. .PP The behavior of menus can be changed by defining new bindings for individual widgets or by redefining the class bindings. - .SH BUGS .PP At present it isn't possible to use the option database to specify values for the options to individual entries. - .SH KEYWORDS menu, widget +.SH "SEE ALSO" +bind(n), menubutton(n), toplevel(n) diff --git a/generic/tkMenu.c b/generic/tkMenu.c index e87b072..6dd2fc2 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMenu.c,v 1.36 2006/05/25 23:50:16 hobbs Exp $ + * RCS: @(#) $Id: tkMenu.c,v 1.37 2006/12/04 15:16:30 dkf Exp $ */ /* @@ -313,13 +313,13 @@ static Tk_OptionSpec tkMenuConfigSpecs[] = { static CONST char *menuOptions[] = { "activate", "add", "cget", "clone", "configure", "delete", "entrycget", "entryconfigure", "index", "insert", "invoke", "post", "postcascade", - "type", "unpost", "yposition", NULL + "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_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE, - MENU_UNPOST, MENU_YPOSITION + MENU_UNPOST, MENU_XPOSITION, MENU_YPOSITION }; /* @@ -345,6 +345,8 @@ static int GetIndexFromCoords(Tcl_Interp *interp, TkMenu *menuPtr, char *string, int *indexPtr); static int MenuDoYPosition(Tcl_Interp *interp, TkMenu *menuPtr, Tcl_Obj *objPtr); +static int MenuDoXPosition(Tcl_Interp *interp, + TkMenu *menuPtr, Tcl_Obj *objPtr); static int MenuAddOrInsert(Tcl_Interp *interp, TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc, Tcl_Obj *CONST objv[]); @@ -683,7 +685,7 @@ MenuWidgetObjCmd( int index; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "activate index"); + Tcl_WrongNumArgs(interp, 2, objv, "index"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -701,7 +703,7 @@ MenuWidgetObjCmd( } case MENU_ADD: if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "type ?options?"); goto error; } @@ -713,7 +715,7 @@ MenuWidgetObjCmd( Tcl_Obj *resultPtr; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + Tcl_WrongNumArgs(interp, 2, objv, "option"); goto error; } resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr, @@ -727,7 +729,7 @@ MenuWidgetObjCmd( } case MENU_CLONE: if ((objc < 3) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "clone newMenuName ?menuType?"); + Tcl_WrongNumArgs(interp, 2, objv, "newMenuName ?menuType?"); goto error; } result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]); @@ -767,7 +769,7 @@ MenuWidgetObjCmd( int first, last; if ((objc != 3) && (objc != 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?"); + Tcl_WrongNumArgs(interp, 2, objv, "first ?last?"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first) != TCL_OK) { @@ -798,7 +800,7 @@ MenuWidgetObjCmd( Tcl_Obj *resultPtr; if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option"); + Tcl_WrongNumArgs(interp, 2, objv, "index option"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -823,8 +825,7 @@ MenuWidgetObjCmd( Tcl_Obj *resultPtr; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, - "entryconfigure index ?option value ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "index ?option value ...?"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -864,7 +865,7 @@ MenuWidgetObjCmd( int index; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "index string"); + Tcl_WrongNumArgs(interp, 2, objv, "string"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -879,7 +880,7 @@ MenuWidgetObjCmd( } case MENU_INSERT: if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, "insert index type ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "index type ?options?"); goto error; } if (MenuAddOrInsert(interp,menuPtr,objv[2],objc-3,objv+3) != TCL_OK) { @@ -890,7 +891,7 @@ MenuWidgetObjCmd( int index; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "invoke index"); + Tcl_WrongNumArgs(interp, 2, objv, "index"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -906,7 +907,7 @@ MenuWidgetObjCmd( int x, y; if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "post x y"); + Tcl_WrongNumArgs(interp, 2, objv, "x y"); goto error; } if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) @@ -931,7 +932,7 @@ MenuWidgetObjCmd( int index; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "postcascade index"); + Tcl_WrongNumArgs(interp, 2, objv, "index"); goto error; } @@ -949,7 +950,7 @@ MenuWidgetObjCmd( int index; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "type index"); + Tcl_WrongNumArgs(interp, 2, objv, "index"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -968,15 +969,22 @@ MenuWidgetObjCmd( } case MENU_UNPOST: if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "unpost"); + Tcl_WrongNumArgs(interp, 2, objv, NULL); goto error; } Tk_UnmapWindow(menuPtr->tkwin); result = TkPostSubmenu(interp, menuPtr, NULL); break; + case MENU_XPOSITION: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); + goto error; + } + result = MenuDoXPosition(interp, menuPtr, objv[2]); + break; case MENU_YPOSITION: if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "yposition index"); + Tcl_WrongNumArgs(interp, 2, objv, "index"); goto error; } result = MenuDoYPosition(interp, menuPtr, objv[2]); @@ -2813,6 +2821,43 @@ CloneMenu( /* *---------------------------------------------------------------------- * + * MenuDoXPosition -- + * + * Given arguments from an option command line, returns the X position. + * + * Results: + * Returns TCL_OK or TCL_Error + * + * Side effects: + * xPosition is set to the X-position of the menu entry. + * + *---------------------------------------------------------------------- + */ + +static int +MenuDoXPosition( + Tcl_Interp *interp, + TkMenu *menuPtr, + Tcl_Obj *objPtr) +{ + int index; + + TkRecomputeMenu(menuPtr); + if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); + if (index < 0) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->x)); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * MenuDoYPosition -- * * Given arguments from an option command line, returns the Y position. diff --git a/tests/menu.test b/tests/menu.test index 24e57cc..f67fcbe 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menu.test,v 1.19 2006/11/24 18:11:32 hobbs Exp $ +# RCS: @(#) $Id: menu.test,v 1.20 2006/12/04 15:16:31 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -897,7 +897,7 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} { catch {destroy .m1} menu .m1 list [catch {.m1 foo} msg] $msg [destroy .m1] -} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}} +} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition} {}} test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} { set t .t set m1 .t.m1 @@ -917,6 +917,23 @@ test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} { destroy $t; set l; } {1 1} +test menu-3.69 {MenuWidgetCmd procedure, "xposition" option} -setup { + catch {destroy .m1} + menu .m1 +} -body { + .m1 xposition +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 xposition index"} +test menu-3.70 {MenuWidgetCmd procedure, "xposition" option} -setup { + catch {destroy .m1} + menu .m1 +} -body { + .m1 xposition 1 + subst {} ;# just checking that the xposition does not produce an error... +} -cleanup { + destroy .m1 +} -result {} test menu-4.1 {TkInvokeMenu: disabled} { catch {destroy .m1} |