Fix [9286526144]: adjust position of ttk::menubutton menus and streamline code.

1 files changed, 107 insertions, 33 deletions

diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl
index 2be064c..43b3cd8 100644
--- a/library/ttk/menubutton.tcl
+++ b/library/ttk/menubutton.tcl
@@ -61,43 +61,112 @@ if {[tk windowingsystem] eq "x11"} {
 }
 
 # PostPosition --
-#	Returns the x and y coordinates where the menu 
-#	should be posted, based on the menubutton and menu size
-#	and -direction option.
+#	Returns x and y coordinates and a menu item index.
+#       If the index is not an empty string the menu should
+#       be posted so that the upper left corner of the indexed
+#       menu item is located at the point (x, y).  Otherwise
+#       the top left corner of the menu itself should be located
+#       at that point.
 #
 # TODO: adjust menu width to be at least as wide as the button
 #	for -direction above, below.
 #
-proc ttk::menubutton::PostPosition {mb menu} {
-    set x [winfo rootx $mb]
-    set y [winfo rooty $mb]
-    set dir [$mb cget -direction]
 
-    set bw [winfo width $mb]
-    set bh [winfo height $mb]
-    set mw [winfo reqwidth $menu]
-    set mh [winfo reqheight $menu]
-    set sw [expr {[winfo screenwidth  $menu] - $bw - $mw}]
-    set sh [expr {[winfo screenheight $menu] - $bh - $mh}]
-
-    switch -- $dir {
-	above { if {$y >= $mh} { incr y -$mh } { incr y  $bh } }
-	below { if {$y <= $sh} { incr y  $bh } { incr y -$mh } }
-	left  { if {$x >= $mw} { incr x -$mw } { incr x  $bw } }
-	right { if {$x <= $sw} { incr x  $bw } { incr x -$mw } }
-	flush { 
-	    # post menu atop menubutton.
-	    # If there's a menu entry whose label matches the
-	    # menubutton -text, assume this is an optionmenu
-	    # and place that entry over the menubutton.
-	    set index [FindMenuEntry $menu [$mb cget -text]]
-	    if {$index ne ""} {
-		incr y -[$menu yposition $index]
+if {[tk windowingsystem] eq "aqua"} {
+    proc ::ttk::menubutton::PostPosition {mb menu} {
+	set menuPad 5
+	set buttonPad 1
+	set bevelPad 4
+	set mh [winfo reqheight $menu]
+	set bh [expr {[winfo height $mb]} + $buttonPad]
+	set bbh [expr {[winfo height $mb]} + $bevelPad]
+	set mw [winfo reqwidth $menu]
+	set bw [winfo width $mb]
+	set dF [expr {[winfo width $mb] - [winfo reqwidth $menu] - $menuPad}]
+	set entry ""
+	set entry [::tk::MenuFindName $menu [$mb cget -text]]
+	if {$entry eq ""} {
+	    set entry 0
+	}
+	set x [winfo rootx $mb]
+	set y [winfo rooty $mb]
+	switch [$mb cget -direction] {
+	    above {
+		set entry ""
+		incr y [expr {-$mh + 2 * $menuPad}]
+	    }
+	    below {
+		set entry ""
+		incr y $bh 
+	    }
+	    left {
+		incr y $menuPad
+		incr x -$mw
+	    }
+	    right {
+		incr y $menuPad
+		incr x $bw 
+	    }
+	    default {
+		incr y $bbh
 	    }
 	}
+	return [list $x $y $entry]
+    }
+} else {
+    proc ::ttk::menubutton::PostPosition {mb menu} {
+	set mh [expr {[winfo reqheight $menu]}]
+	set bh [expr {[winfo height $mb]}]
+	set mw [expr {[winfo reqwidth $menu]}]
+	set bw [expr {[winfo width $mb]}]
+	set dF [expr {[winfo width $mb] - [winfo reqwidth $menu]}]
+	if {[tk windowingsystem] eq "win32"} {
+	    incr mh 6
+	    incr mw 16
+	}
+	set entry {}
+	set entry [::tk::MenuFindName $menu [$mb cget -text]]
+	if {$entry eq {}} {
+	    set entry 0
+	}
+	set x [winfo rootx $mb]
+	set y [winfo rooty $mb]
+	switch [$mb cget -direction] {
+	    above {
+		set entry {}
+		incr y -$mh
+		# if we go offscreen to the top, show as 'below'
+		if {$y < [winfo vrooty $mb]} {
+		    set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\
+                           + [winfo reqheight $mb]}]
+		}
+	    }
+	    below {
+		set entry {}
+		incr y $bh
+		# if we go offscreen to the bottom, show as 'above'
+		if {($y + $mh) > ([winfo vrooty $mb] + [winfo vrootheight $mb])} {
+		    set y [expr {[winfo vrooty $mb] + [winfo vrootheight $mb] \
+			   + [winfo rooty $mb] - $mh}]
+		}
+	    }
+	    left {
+		incr x -$mw
+	    }
+	    right {
+		incr x $bw
+	    }
+	    default {
+		if {[$mb cget -style] eq ""} {
+		    incr x [expr {([winfo width $mb] - \
+				   [winfo reqwidth $menu])/ 2}]
+		} else {
+		    incr y $bh
+		}
+	    }
+	}
+	return [list $x $y $entry]
     }
-
-    return [list $x $y]
 }
 
 # Popdown --
@@ -107,8 +176,8 @@ proc ttk::menubutton::Popdown {mb} {
     if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
 	return
     }
-    foreach {x y} [PostPosition $mb $menu] { break }
-    tk_popup $menu $x $y
+    foreach {x y entry} [PostPosition $mb $menu] { break }
+    tk_popup $menu $x $y $entry
 }
 
 # Pulldown (X11 only) --
@@ -121,13 +190,17 @@ proc ttk::menubutton::Pulldown {mb} {
     if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
 	return
     }
-    foreach {x y} [PostPosition $mb $menu] { break }
     set State(pulldown) 1
     set State(oldcursor) [$mb cget -cursor]
 
     $mb state pressed
     $mb configure -cursor [$menu cget -cursor]
-    $menu post $x $y
+    foreach {x y entry} [PostPosition $mb $menu] { break }
+    if {$entry ne {}} {
+	$menu post $x $y $entry
+    } else {
+	$menu post $x $y
+    }
     tk_menuSetFocus $menu
 }
 
@@ -143,6 +216,7 @@ proc ttk::menubutton::TransferGrab {mb} {
 	set State(pulldown) 0
 
 	set menu [$mb cget -menu]
+	foreach {x y entry} [PostPosition $mb $menu] { break }
     	tk_popup $menu [winfo rootx $menu] [winfo rooty $menu]
     }
 }