summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2006-12-04 15:16:30 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2006-12-04 15:16:30 (GMT)
commit4071ac2f935c627c6490a0f0251e3b8e7b4d6071 (patch)
tree5144e30c83ad2812b2e9007dd08f384bed9578aa
parent96dd14f8a93c3f9dbccdc44cfaac782b612a6eed (diff)
downloadtk-4071ac2f935c627c6490a0f0251e3b8e7b4d6071.zip
tk-4071ac2f935c627c6490a0f0251e3b8e7b4d6071.tar.gz
tk-4071ac2f935c627c6490a0f0251e3b8e7b4d6071.tar.bz2
TIP#286 implementation. [Patch 1152376]
-rw-r--r--ChangeLog9
-rw-r--r--doc/menu.n39
-rw-r--r--generic/tkMenu.c83
-rw-r--r--tests/menu.test21
4 files changed, 109 insertions, 43 deletions
diff --git a/ChangeLog b/ChangeLog
index 6cd7250..79ab9f1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
diff --git a/doc/menu.n b/doc/menu.n
index 96095e9..ea6ecb0 100644
--- a/doc/menu.n
+++ b/doc/menu.n
@@ -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}