Tk Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact 4d595d36553b654ffd412992d5dc06f8fa96b6a9:

Attachment "tip286.patch" to ticket [1152376f] added by sbron 2006-10-21 23:00:14.
--- generic/tkMenu.c.old	2006-10-17 21:18:31.000000000 +0200
+++ generic/tkMenu.c	2006-10-17 21:41:22.000000000 +0200
@@ -313,13 +313,13 @@
 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
 };
 
 /*
@@ -343,6 +343,8 @@
 static void		DestroyMenuEntry(char *memPtr);
 static int		GetIndexFromCoords(Tcl_Interp *interp, TkMenu *menuPtr,
 			    char *string, int *indexPtr);
+static int		MenuDoXPosition(Tcl_Interp *interp,
+			    TkMenu *menuPtr, Tcl_Obj *objPtr);
 static int		MenuDoYPosition(Tcl_Interp *interp,
 			    TkMenu *menuPtr, Tcl_Obj *objPtr);
 static int		MenuAddOrInsert(Tcl_Interp *interp,
@@ -974,6 +976,13 @@
 	Tk_UnmapWindow(menuPtr->tkwin);
 	result = TkPostSubmenu(interp, menuPtr, NULL);
 	break;
+    case MENU_XPOSITION:
+        if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "xposition index");
+	    goto error;
+	}
+	result = MenuDoXPosition(interp, menuPtr, objv[2]);
+	break;
     case MENU_YPOSITION:
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 1, objv, "yposition index");
@@ -2813,6 +2822,47 @@
 /*
  *----------------------------------------------------------------------
  *
+ * 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) {
+	goto 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;
+
+  error:
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * MenuDoYPosition --
  *
  *	Given arguments from an option command line, returns the Y position.
--- tests/menu.test.old	2006-10-17 21:08:59.000000000 +0200
+++ tests/menu.test	2006-10-21 17:46:16.000000000 +0200
@@ -897,7 +897,7 @@
     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,16 @@
     destroy $t;
     set l;
 } {1 1}
+test menu-3.69 {MenuWidgetCmd procedure, "xposition" option} {
+    catch {destroy .m1}
+    menu .m1
+    list [catch {.m1 xposition} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 xposition index"} {}}
+test menu-3.70 {MenuWidgetCmd procedure, "xposition" option} {
+    catch {destroy .m1}
+    menu .m1
+    list [catch {.m1 xposition 1}] [destroy .m1]
+} {0 {}}
 
 test menu-4.1 {TkInvokeMenu: disabled} {
     catch {destroy .m1}
--- doc/menu.n.old	2005-04-06 23:11:54.000000000 +0200
+++ doc/menu.n	2006-10-17 21:46:46.000000000 +0200
@@ -637,6 +637,10 @@
 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
+Returns a decimal string giving the x-coordinate within the menu
+window of the leftmost pixel in the entry specified by \fIindex\fR.
+.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.