diff options
| -rw-r--r-- | doc/menu.n | 21 | ||||
| -rw-r--r-- | generic/tkMenu.c | 32 | ||||
| -rw-r--r-- | generic/tkMenu.h | 2 | ||||
| -rw-r--r-- | library/menu.tcl | 257 | ||||
| -rw-r--r-- | macosx/tkMacOSXMenu.c | 73 | ||||
| -rw-r--r-- | tests/menu.test | 2 | ||||
| -rw-r--r-- | unix/tkUnixMenu.c | 14 | ||||
| -rw-r--r-- | win/tkWinMenu.c | 18 |
8 files changed, 231 insertions, 188 deletions
@@ -470,18 +470,19 @@ a menu entry does not automatically unpost the menu; the default bindings normally take care of this before invoking the \fBinvoke\fR widget command. .TP -\fIpathName \fBpost \fIx y\fR +\fIpathName \fBpost \fIx y\fR ?\fIindex\fR? . Arrange for the menu to be displayed on the screen at the root-window -coordinates given by \fIx\fR and \fIy\fR. These coordinates are -adjusted if necessary to guarantee that the entire menu is visible on -the screen. This command normally returns an empty string. -If the \fB\-postcommand\fR option has been specified, then its value is -executed as a Tcl script before posting the menu and the result of -that script is returned as the result of the \fBpost\fR widget -command. -If an error returns while executing the command, then the error is -returned without posting the menu. +coordinates given by \fIx\fR and \fIy\fR. If an index is specified +the menu will be located so that the entry with that index is +displayed at the point. These coordinates are adjusted if necessary to +guarantee that the entire menu is visible on the screen. This command +normally returns an empty string. If the \fB\-postcommand\fR option +has been specified, then its value is executed as a Tcl script before +posting the menu and the result of that script is returned as the +result of the \fBpost\fR widget command. If an error returns while +executing the command, then the error is returned without posting the +menu. .TP \fIpathName \fBpostcascade \fIindex\fR . diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 26ffc88..f1ea8ff 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -870,32 +870,46 @@ MenuWidgetObjCmd( break; } case MENU_POST: { - int x, y; + int x, y, entry = -1; - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "x y"); + if (objc != 4 && objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "x y ?entry?"); goto error; } if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } + if (objc == 5) { + if (menuPtr->menuType == TEAROFF_MENU) { + Tcl_AppendResult(interp, + "the index option is invalid for tearoff menus", NULL); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[4], &entry) != TCL_OK) { + goto error; + } + } /* - * Tearoff menus are posted differently on Mac and Windows than - * non-tearoffs. TkpPostMenu does not actually map the menu's window - * on those platforms, and popup menus have to be handled specially. - * Also, menubar menues are not intended to be posted (bug 1567681, - * 2160206). + * Tearoff menus are the same as ordinary menus on the Mac and are + * posted differently on Windows than non-tearoffs. TkpPostMenu + * does not actually map the menu's window on those platforms, and + * popup menus have to be handled specially. Also, menubar menus are + * not intended to be posted (bug 1567681, 2160206). */ if (menuPtr->menuType == MENUBAR) { Tcl_AppendResult(interp, "a menubar menu cannot be posted", NULL); return TCL_ERROR; } else if (menuPtr->menuType != TEAROFF_MENU) { - result = TkpPostMenu(interp, menuPtr, x, y); + result = TkpPostMenu(interp, menuPtr, x, y, entry); } else { +#ifdef TK_MAC_OSX + result = TkpPostMenu(interp, menuPtr, x, y, entry); +#else result = TkPostTearoffMenu(interp, menuPtr, x, y); +#endif } break; } diff --git a/generic/tkMenu.h b/generic/tkMenu.h index bac51aa..92bf8b2 100644 --- a/generic/tkMenu.h +++ b/generic/tkMenu.h @@ -543,7 +543,7 @@ MODULE_SCOPE void TkpMenuInit(void); MODULE_SCOPE int TkpMenuNewEntry(TkMenuEntry *mePtr); MODULE_SCOPE int TkpNewMenu(TkMenu *menuPtr); MODULE_SCOPE int TkpPostMenu(Tcl_Interp *interp, TkMenu *menuPtr, - int x, int y); + int x, int y, int entry); MODULE_SCOPE void TkpSetWindowMenuBar(Tk_Window tkwin, TkMenu *menuPtr); #endif /* _TKMENU */ diff --git a/library/menu.tcl b/library/menu.tcl index a406ae3..cdfcc13 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -234,6 +234,7 @@ proc ::tk::MbLeave w { } } + # ::tk::MbPost -- # Given a menubutton, this procedure does all the work of posting # its associated menu and unposting any other menu that is currently @@ -274,124 +275,25 @@ proc ::tk::MbPost {w {x {}} {y {}}} { if {[tk windowingsystem] ne "aqua"} { set Priv(relief) [$w cget -relief] $w configure -relief raised - set xoffset {0 0 0 0 0} - set yoffset {0 0 0 0 0} } else { $w configure -state active - # Compensate for offsets created by the macOS window manager. - set xoffset {9 9 18 9 0} - set yoffset {6 13 13 13 9} } set Priv(postedMb) $w set Priv(focus) [focus] $menu activate none GenerateMenuSelect $menu - - # If this looks like an option menubutton then post the menu so - # that the current entry is on top of the mouse. Otherwise post - # the menu just below the menubutton, as for a pull-down. - update idletasks - if {[catch { - switch [$w cget -direction] { - above { - set x [expr {[winfo rootx $w]}] - set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}] - # if we go offscreen to the top, show as 'below' - if {$y < [winfo vrooty $w]} { - set y [expr {[winfo vrooty $w] + [winfo rooty $w] + [winfo reqheight $w]}] - } - incr x [lindex $xoffset 0] - incr y [lindex $yoffset 0] - PostOverPoint $menu $x $y - } - below { - set x [expr {[winfo rootx $w]}] - set y [expr {[winfo rooty $w] + [winfo height $w]}] - # if we go offscreen to the bottom, show as 'above' - set mh [winfo reqheight $menu] - if {($y + $mh) > ([winfo vrooty $w] + [winfo vrootheight $w])} { - set y [expr {[winfo vrooty $w] + [winfo vrootheight $w] + [winfo rooty $w] - $mh}] - } - incr x [lindex $xoffset 1] - incr y [lindex $yoffset 1] - PostOverPoint $menu $x $y - } - left { - set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] - set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] - set entry [MenuFindName $menu [$w cget -text]] - if {$entry eq ""} { - set entry 0 - } - if {[$w cget -indicatoron]} { - if {$entry == [$menu index last]} { - incr y [expr {-([$menu yposition $entry] \ - + [winfo reqheight $menu])/2}] - } else { - incr y [expr {-([$menu yposition $entry] \ - + [$menu yposition [expr {$entry+1}]])/2}] - } - } - incr x [lindex $xoffset 2] - incr y [lindex $yoffset 2] - PostOverPoint $menu $x $y - if {$entry ne "" \ - && [$menu entrycget $entry -state] ne "disabled"} { - $menu activate $entry - GenerateMenuSelect $menu - } - } - right { - set x [expr {[winfo rootx $w] + [winfo width $w]}] - set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] - set entry [MenuFindName $menu [$w cget -text]] - if {$entry eq ""} { - set entry 0 - } - if {[$w cget -indicatoron]} { - if {$entry == [$menu index last]} { - incr y [expr {-([$menu yposition $entry] \ - + [winfo reqheight $menu])/2}] - } else { - incr y [expr {-([$menu yposition $entry] \ - + [$menu yposition [expr {$entry+1}]])/2}] - } - } - incr x [lindex $xoffset 3] - incr y [lindex $yoffset 3] - PostOverPoint $menu $x $y - if {$entry ne "" \ - && [$menu entrycget $entry -state] ne "disabled"} { - $menu activate $entry - GenerateMenuSelect $menu - } - } - default { - incr x [lindex $xoffset 4] - incr y [lindex $yoffset 4] - if {[$w cget -indicatoron]} { - if {$y eq ""} { - set x [expr {[winfo rootx $w] + [winfo width $w]/2}] - set y [expr {[winfo rooty $w] + [winfo height $w]/2}] - } - PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]] - } else { - PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}] - } - } - } - } msg opt]} { + + if {[catch {PostMenubuttonMenu $w $menu} msg opt]} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. - MenuUnpost {} return -options $opt $msg } set Priv(tearoff) $tearoff - if {$tearoff != 0} { + if {$tearoff != 0 && [tk windowingsystem] ne "aqua"} { focus $menu if {[winfo viewable $w]} { SaveGrabInfo $w @@ -1223,10 +1125,118 @@ proc ::tk::MenuFindName {menu s} { return "" } +# ::tk::PostMenubuttonMenu -- +# +# Given a menubutton and a menu, this procedure posts the menu at the +# appropriate location. If the menubutton looks like an option +# menubutton, meaning that the indicator is on and the direction is +# neither above nor below, then the menu is posted so that the current +# entry is vertically aligned with the menubutton. On the Mac this +# will expose a small amount of the blue indicator on the right hand +# side. On other platforms the entry is centered over the button. + +if {[tk windowingsystem] eq "aqua"} { + proc ::tk::PostMenubuttonMenu {button menu} { + set entry "" + if {[$button cget -indicatoron]} { + set entry [MenuFindName $menu [$button cget -text]] + if {$entry eq ""} { + set entry 0 + } + } + set x [winfo rootx $button] + set y [expr {2 + [winfo rooty $button]}] + switch [$button cget -direction] { + above { + set entry "" + incr y [expr {4 - [winfo reqheight $menu]}] + } + below { + set entry "" + incr y [expr {2 + [winfo height $button]}] + } + left { + incr x [expr {-[winfo reqwidth $menu]}] + } + right { + incr x [winfo width $button] + } + default { + incr x [expr {[winfo width $button] - [winfo reqwidth $menu] - 5}] + } + } + PostOverPoint $menu $x $y $entry + } +} else { + proc ::tk::PostMenubuttonMenu {button menu} { + set entry "" + if {[$button cget -indicatoron]} { + set entry [MenuFindName $menu [$button cget -text]] + if {$entry eq ""} { + set entry 0 + } + } + if {$entry ne ""} { + if {$entry == [$menu index last]} { + set entryHeight [expr {[winfo reqheight $menu] \ + - [$menu yposition $entry]}] + } else { + set entryHeight [expr {[$menu yposition [expr {$entry+1}]] \ + - [$menu yposition $entry]}] + } + } + set x [winfo rootx $button] + set y [winfo rooty $button] + switch [$button cget -direction] { + above { + incr y [expr {-[winfo reqheight $menu]}] + # if we go offscreen to the top, show as 'below' + if {$y < [winfo vrooty $button]} { + set y [expr {[winfo vrooty $button] + [winfo rooty $button]\ + + [winfo reqheight $button]}] + } + set entry {} + } + below { + incr y [winfo height $button] + # if we go offscreen to the bottom, show as 'above' + set mh [winfo reqheight $menu] + if {($y + $mh) > ([winfo vrooty $button] + [winfo vrootheight $button])} { + set y [expr {[winfo vrooty $button] + [winfo vrootheight $button] \ + + [winfo rooty $button] - $mh}] + } + set entry {} + } + left { + # It is not clear why this is needed. + if {[tk windowingsystem] eq "win32"} { + incr x [expr {-4 - [winfo reqwidth $button] / 2}] + } + incr x [expr {- [winfo reqwidth $menu]}] + } + right { + incr x [expr {[winfo width $button]}] + } + default { + if {[$button cget -indicatoron]} { + incr x [expr {([winfo width $button] - \ + [winfo reqwidth $menu])/ 2}] + } else { + incr y [winfo height $button] + } + } + } + PostOverPoint $menu $x $y $entry + } +} + # ::tk::PostOverPoint -- -# This procedure posts a given menu such that a given entry in the -# menu is centered over a given point in the root window. It also -# activates the given entry. +# +# This procedure posts a menu on the screen so that a given entry in +# the menu is positioned with its upper left corner at a given point +# in the root window. The procedure also activates that entry. If no +# entry is specified the upper left corner of the entire menu is +# placed at the point. # # Arguments: # menu - Menu to post. @@ -1235,19 +1245,24 @@ proc ::tk::MenuFindName {menu s} { # If omitted or specified as {}, then the menu's # upper-left corner goes at (x,y). -proc ::tk::PostOverPoint {menu x y {entry {}}} { - if {$entry ne ""} { - if {$entry == [$menu index last]} { - incr y [expr {-([$menu yposition $entry] \ - + [winfo reqheight $menu])/2}] +if {[tk windowingsystem] ne "win32"} { + proc ::tk::PostOverPoint {menu x y {entry {}}} { + if {$entry ne ""} { + $menu post $x $y $entry + if {[$menu entrycget $entry -state] ne "disabled"} { + $menu activate $entry + GenerateMenuSelect $menu + } } else { - incr y [expr {-([$menu yposition $entry] \ - + [$menu yposition [expr {$entry+1}]])/2}] + $menu post $x $y } - incr x [expr {-[winfo reqwidth $menu]/2}] + return } - - if {[tk windowingsystem] eq "win32"} { +} else { + proc ::tk::PostOverPoint {menu x y {entry {}}} { + if {$entry ne ""} { + incr y [expr {-[$menu yposition $entry]}] + } # osVersion is not available in safe interps set ver 5 if {[info exists ::tcl_platform(osVersion)]} { @@ -1263,7 +1278,7 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { # manager provided with Vista and Windows 7. if {$ver < 6} { set yoffset [expr {[winfo screenheight $menu] \ - - $y - [winfo reqheight $menu] - 10}] + - $y - [winfo reqheight $menu] - 10}] if {$yoffset < [winfo vrooty $menu]} { # The bottom of the menu is offscreen, so adjust upwards incr y [expr {$yoffset - [winfo vrooty $menu]}] @@ -1275,11 +1290,11 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { set y [winfo vrooty $menu] } } - } - $menu post $x $y - if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} { - $menu activate $entry - GenerateMenuSelect $menu + $menu post $x $y + if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} { + $menu activate $entry + GenerateMenuSelect $menu + } } } diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c index 6315638..c7610fc 100644 --- a/macosx/tkMacOSXMenu.c +++ b/macosx/tkMacOSXMenu.c @@ -755,7 +755,10 @@ TkpDestroyMenuEntry( * * TkpPostMenu -- * - * Posts a menu on the screen + * Posts a menu on the screen. If entry is < 0 then the menu is + * drawn so its top left corner is located at the point with + * screen coordinates (x, y). Otherwise the top left corner of + * the specified entry is located at that point. * * Results: * None. @@ -770,49 +773,47 @@ int TkpPostMenu( Tcl_Interp *interp, /* The interpreter this menu lives in */ TkMenu *menuPtr, /* The menu we are posting */ - int x, /* The global x-coordinate of the top, left- - * hand corner of where the menu is supposed - * to be posted. */ - int y) /* The global y-coordinate */ + int x, int y, /* The screen coordinates where the top left + * corner of the menu, or of the specified + * entry, will be located. */ + int entry) { - - /* Get the object that holds this Tk Window.*/ - Tk_Window root; - root = Tk_MainWindow(interp); + Tk_Window root = Tk_MainWindow(interp); + if (root == NULL) { return TCL_ERROR; } + if (menuPtr->menuType == TEAROFF_MENU) { + entry -= 1; + } Drawable d = Tk_WindowId(root); NSView *rootview = TkMacOSXGetRootControl(d); NSWindow *win = [rootview window]; - int result; + NSView *view = [win contentView]; + NSMenu *menu = (NSMenu *) menuPtr->platformData; + NSMenuItem *item = nil; + NSInteger index = entry; + NSPoint location = NSMakePoint(x, tkMacOSXZeroScreenHeight - y); + int result, oldMode; inPostMenu = 1; - result = TkPreprocessMenu(menuPtr); if (result != TCL_OK) { inPostMenu = 0; return result; } - - int oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); - NSView *view = [win contentView]; - NSRect frame = NSMakeRect(x, tkMacOSXZeroScreenHeight - y, 1, 1); - - frame.origin = [view convertPoint: - [win tkConvertPointFromScreen:frame.origin] fromView:nil]; - - NSMenu *menu = (NSMenu *) menuPtr->platformData; - NSPopUpButtonCell *popUpButtonCell = [[NSPopUpButtonCell alloc] - initTextCell:@"" pullsDown:NO]; - - [popUpButtonCell setAltersStateOfSelectedItem:NO]; - [popUpButtonCell setMenu:menu]; - [popUpButtonCell selectItem:nil]; - [popUpButtonCell performClickWithFrame:frame inView:view]; - [popUpButtonCell release]; + if (index >= [menu numberOfItems]) { + index = [menu numberOfItems] - 1; + } + if (index >= 0) { + item = [menu itemAtIndex:index]; + } + oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); + [menu popUpMenuPositioningItem:item + atLocation:[win tkConvertPointFromScreen:location] + inView:view]; Tcl_SetServiceMode(oldMode); inPostMenu = 0; return TCL_OK; @@ -1087,6 +1088,7 @@ void TkpComputeStandardMenuGeometry( TkMenu *menuPtr) /* Structure describing menu. */ { + NSSize menuSize = [(NSMenu *)menuPtr->platformData size]; Tk_Font tkfont, menuFont; Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr; int modifierCharWidth, menuModifierCharWidth; @@ -1130,7 +1132,7 @@ TkpComputeStandardMenuGeometry( break; } } - + for (i = 0; i < menuPtr->numEntries; i++) { mePtr = menuPtr->entries[i]; if (mePtr->type == TEAROFF_ENTRY) { @@ -1199,6 +1201,9 @@ TkpComputeStandardMenuGeometry( height = size.height; } } + else { + /* image only. */ + } labelWidth = width + menuItemExtraWidth; mePtr->height = height + menuItemExtraHeight; if (mePtr->type == CASCADE_ENTRY) { @@ -1237,18 +1242,12 @@ TkpComputeStandardMenuGeometry( mePtr->x = x; mePtr->y = y; y += menuPtr->entries[i]->height + borderWidth; - if (y > windowHeight) { - windowHeight = y; - } } - - windowWidth = x + maxIndicatorSpace + maxWidth - + 2 * activeBorderWidth + borderWidth; - windowHeight += borderWidth; - + windowWidth = menuSize.width; if (windowWidth <= 0) { windowWidth = 1; } + windowHeight = menuSize.height; if (windowHeight <= 0) { windowHeight = 1; } diff --git a/tests/menu.test b/tests/menu.test index 95699ff..dcc578f 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1606,7 +1606,7 @@ test menu-3.47 {MenuWidgetCmd procedure, "post" option} -setup { .m1 post } -cleanup { destroy .m1 -} -returnCodes error -result {wrong # args: should be ".m1 post x y"} +} -returnCodes error -result {wrong # args: should be ".m1 post x y ?entry?"} test menu-3.48 {MenuWidgetCmd procedure, "post" option} -setup { destroy .m1 } -body { diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index 38b6c58..f701819 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -889,7 +889,10 @@ DrawMenuUnderline( * * TkpPostMenu -- * - * Posts a menu on the screen + * Posts a menu on the screen so that the top left corner of the + * specified entry is located at the point (x, y) in screen coordinates. + * If the entry parameter is negative, the upper left corner of the + * menu itself is placed at the point. * * Results: * None. @@ -904,8 +907,14 @@ int TkpPostMenu( Tcl_Interp *interp, TkMenu *menuPtr, - int x, int y) + int x, int y, int entry) { + if (entry >= menuPtr->numEntries) { + entry = menuPtr->numEntries - 1; + } + if (entry >= 0) { + y -= menuPtr->entries[entry]->y; + } return TkPostTearoffMenu(interp, menuPtr, x, y); } @@ -1721,7 +1730,6 @@ TkpComputeStandardMenuGeometry( } windowWidth = x + indicatorSpace + labelWidth + accelWidth + 2 * activeBorderWidth + borderWidth; - windowHeight += borderWidth; /* diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index a409764..2957b0e 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -743,7 +743,10 @@ ReconfigureWindowsMenu( * * TkpPostMenu -- * - * Posts a menu on the screen + * Posts a menu on the screen so that the top left corner of the + * specified entry is located at the point (x, y) in screen coordinates. + * If the entry parameter is negative, the upper left corner of the + * menu itself is placed at the point. * * Results: * None. @@ -758,7 +761,7 @@ int TkpPostMenu( Tcl_Interp *interp, TkMenu *menuPtr, - int x, int y) + int x, int y, int entry) { HMENU winMenuHdl = (HMENU) menuPtr->platformData; int result, flags; @@ -770,7 +773,6 @@ TkpPostMenu( Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->inPostMenu++; - CallPendingReconfigureImmediately(menuPtr); result = TkPreprocessMenu(menuPtr); @@ -779,6 +781,13 @@ TkpPostMenu( return result; } + if (entry >= menuPtr->numEntries) { + entry = menuPtr->numEntries - 1; + } + if (entry >= 0) { + y -= menuPtr->entries[entry]->y; + } + /* * The post commands could have deleted the menu, which means * we are dead and should go away. @@ -2897,7 +2906,6 @@ TkpComputeStandardMenuGeometry( GetTearoffEntryGeometry(menuPtr, menuPtr->entries[i], tkfont, fmPtr, &width, &height); menuPtr->entries[i]->height = height; - } else { /* * For each entry, compute the height required by that particular @@ -2955,8 +2963,6 @@ TkpComputeStandardMenuGeometry( } windowWidth = x + indicatorSpace + labelWidth + accelWidth + 2 * activeBorderWidth + borderWidth; - - windowHeight += borderWidth; /* |