merge core-8-4-branch

1 files changed, 89 insertions, 78 deletions

diff --git a/library/menu.tcl b/library/menu.tcl
index ed8182e..782a726 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -60,7 +60,7 @@
 # This file is tricky because there are five different ways that menus
 # can be used:
 #
-# 1. As a pulldown from a menubutton. In this style, the variable 
+# 1. As a pulldown from a menubutton. In this style, the variable
 #    tk::Priv(postedMb) identifies the posted menubutton.
 # 2. As a torn-off menu copied from some other menu.  In this style
 #    tk::Priv(postedMb) is empty, and menu's type is "tearoff".
@@ -280,81 +280,81 @@ proc ::tk::MbPost {w {x {}} {y {}}} {
     update idletasks
     if {[catch {
 	switch [$w cget -direction] {
-    	    above {
-    	    	set x [winfo rootx $w]
-    	    	set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
+	    above {
+		set x [winfo rootx $w]
+		set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
 		# if we go offscreen to the top, show as 'below'
-		if {$y < 0} {
-		    set y [expr {[winfo rooty $w] + [winfo height $w]}]
+		if {$y < [winfo vrooty $w]} {
+		    set y [expr {[winfo vrooty $w] + [winfo rooty $w] + [winfo reqheight $w]}]
 		}
 		PostOverPoint $menu $x $y
-    	    }
-    	    below {
-    	    	set x [winfo rootx $w]
-    	    	set y [expr {[winfo rooty $w] + [winfo height $w]}]
+	    }
+	    below {
+		set x [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 screenheight $w]} {
-		    set y [expr {[winfo rooty $w] - $mh}]
+		if {($y + $mh) > ([winfo vrooty $w] + [winfo vrootheight $w])} {
+		    set y [expr {[winfo vrooty $w] + [winfo vrootheight $w] + [winfo rooty $w] - $mh}]
 		}
 		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 {[$w cget -indicatoron]} {
+	    }
+	    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 {[$w cget -indicatoron]} {
 		    if {$entry == [$menu index last]} {
-		    	incr y [expr {-([$menu yposition $entry] \
-			    	+ [winfo reqheight $menu])/2}]
+			incr y [expr {-([$menu yposition $entry] \
+				+ [winfo reqheight $menu])/2}]
 		    } else {
-		    	incr y [expr {-([$menu yposition $entry] \
+			incr y [expr {-([$menu yposition $entry] \
 			        + [$menu yposition [expr {$entry+1}]])/2}]
 		    }
-    	    	}
+		}
 		PostOverPoint $menu $x $y
 		if {$entry ne "" \
 			&& [$menu entrycget $entry -state] ne "disabled"} {
-    	    	    $menu activate $entry
+		    $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 {[$w cget -indicatoron]} {
+		}
+	}
+	    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 {[$w cget -indicatoron]} {
 		    if {$entry == [$menu index last]} {
-		    	incr y [expr {-([$menu yposition $entry] \
-			    	+ [winfo reqheight $menu])/2}]
+			incr y [expr {-([$menu yposition $entry] \
+				+ [winfo reqheight $menu])/2}]
 		    } else {
-		    	incr y [expr {-([$menu yposition $entry] \
+			incr y [expr {-([$menu yposition $entry] \
 			        + [$menu yposition [expr {$entry+1}]])/2}]
 		    }
-    	    	}
+		}
 		PostOverPoint $menu $x $y
 		if {$entry ne "" \
 			&& [$menu entrycget $entry -state] ne "disabled"} {
-    	    	    $menu activate $entry
+		    $menu activate $entry
 		    GenerateMenuSelect $menu
-    	    	}
-    	    }
-    	    default {
-    	    	if {[$w cget -indicatoron]} {
+		}
+	    }
+	    default {
+		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]} {
 	# Error posting menu (e.g. bogus -postcommand). Unpost it and
 	# reflect the error.
-	
+
 	set savedInfo $errorInfo
 	MenuUnpost {}
 	error $msg $savedInfo
@@ -363,7 +363,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} {
 
     set Priv(tearoff) $tearoff
     if {$tearoff != 0} {
-    	focus $menu
+	focus $menu
 	if {[winfo viewable $w]} {
 	    SaveGrabInfo $w
 	    grab -global $w
@@ -443,8 +443,8 @@ proc ::tk::MenuUnpost menu {
     }
 
     if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
-    	# Release grab, if any, and restore the previous grab, if there
-    	# was one.
+	# Release grab, if any, and restore the previous grab, if there
+	# was one.
 	if {$menu ne ""} {
 	    set grab [grab current $menu]
 	    if {$grab ne ""} {
@@ -584,7 +584,7 @@ proc ::tk::MenuButtonDown menu {
 	    set menu [winfo parent $menu]
 	}
 
-	if {$Priv(menuBar) eq ""} {
+	if {$Priv(menuBar) eq {}} {
 	    set Priv(menuBar) $menu
 	    set Priv(cursor) [$menu cget -cursor]
 	    $menu configure -cursor arrow
@@ -625,7 +625,8 @@ proc ::tk::MenuLeave {menu rootx rooty state} {
 	return
     }
     if {[$menu type active] eq "cascade" \
-	    && [winfo containing $rootx $rooty] eq [$menu entrycget active -menu]} {
+	    && [winfo containing $rootx $rooty] eq \
+		[$menu entrycget active -menu]} {
 	return
     }
     $menu activate none
@@ -669,7 +670,7 @@ proc ::tk::MenuInvoke {w buttonRelease} {
 	set isCascade [string equal [$w type $active] "cascade"]
 
 	# Only de-activate the active item if it's a cascade; this prevents
-	# the annoying "activation flicker" you otherwise get with 
+	# the annoying "activation flicker" you otherwise get with
 	# checkbuttons/commands/etc. on menubars
 
 	if { $isCascade } {
@@ -779,7 +780,8 @@ proc ::tk::MenuNextMenu {menu direction} {
 	} else {
 	    set parent [winfo parent $menu]
 	    while {$parent ne "."} {
-		if {[winfo class $parent] eq "Menu" && [$parent cget -type] eq "menubar"} {
+		if {[winfo class $parent] eq "Menu" \
+			&& [$parent cget -type] eq "menubar"} {
 		    tk_menuSetFocus $parent
 		    MenuNextEntry $parent 1
 		    return
@@ -803,16 +805,14 @@ proc ::tk::MenuNextMenu {menu direction} {
 	}
     }
 
-    # Can't traverse into or out of a cascaded menu.  Go to the next
+    # Can't traverse into or out of a cascaded menu. Go to the next
     # or previous menubutton, if that makes sense.
 
     set m2 [winfo parent $menu]
-    if {[winfo class $m2] eq "Menu"} {
-	if {[$m2 cget -type] eq "menubar"} {
-	    tk_menuSetFocus $m2
-	    MenuNextEntry $m2 -1
-	    return
-	}
+    if {[winfo class $m2] eq "Menu" && [$m2 cget -type] eq "menubar"} {
+	tk_menuSetFocus $m2
+	MenuNextEntry $m2 -1
+	return
     }
 
     set w $Priv(postedMb)
@@ -932,7 +932,8 @@ proc ::tk::MenuFind {w char} {
         if {[winfo toplevel $w] ne [winfo toplevel $child]} {
 	    continue
 	}
-	if {[winfo class $child] eq "Menu" && [$child cget -type] eq "menubar"} {
+	if {[winfo class $child] eq "Menu" && \
+		[$child cget -type] eq "menubar"} {
 	    if {$char eq ""} {
 		return $child
 	    }
@@ -957,7 +958,7 @@ proc ::tk::MenuFind {w char} {
         if {[winfo toplevel $w] ne [winfo toplevel $child]} {
 	    continue
 	}
-	switch [winfo class $child] {
+	switch -- [winfo class $child] {
 	    Menubutton {
 		set char2 [string index [$child cget -text] \
 			[$child cget -underline]]
@@ -1112,15 +1113,14 @@ proc ::tk::MenuFirstEntry menu {
     }
     for {set i 0} {$i <= $last} {incr i} {
 	if {([catch {set state [$menu entrycget $i -state]}] == 0) \
-		&& $state ne "disabled" \
-		&& [$menu type $i] ne "tearoff"} {
+		&& $state ne "disabled" && [$menu type $i] ne "tearoff"} {
 	    $menu activate $i
 	    GenerateMenuSelect $menu
 	    # Only post the cascade if the current menu is a menubar;
 	    # otherwise, if the first entry of the cascade is a cascade,
 	    # we can get an annoying cascading effect resulting in a bunch of
 	    # menus getting posted (bug 676)
-	    if {[$menu type $i] eq "cascade" &&	[$menu cget -type] eq "menubar"} {
+	    if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} {
 		set cascade [$menu entrycget $i -menu]
 		if {$cascade ne ""} {
 		    $menu postcascade $i
@@ -1177,7 +1177,7 @@ proc ::tk::MenuFindName {menu s} {
 
 proc ::tk::PostOverPoint {menu x y {entry {}}}  {
     global tcl_platform
-    
+
     if {$entry ne ""} {
 	if {$entry == [$menu index last]} {
 	    incr y [expr {-([$menu yposition $entry] \
@@ -1188,24 +1188,34 @@ proc ::tk::PostOverPoint {menu x y {entry {}}}  {
 	}
 	incr x [expr {-[winfo reqwidth $menu]/2}]
     }
+
     if {$tcl_platform(platform) eq "windows"} {
+	# osVersion is not available in safe interps
+	set ver 5
+	if {[info exists tcl_platform(osVersion)]} {
+	    scan $tcl_platform(osVersion) %d ver
+	}
+
 	# We need to fix some problems with menu posting on Windows,
 	# where, if the menu would overlap top or bottom of screen,
 	# Windows puts it in the wrong place for us.  We must also
 	# subtract an extra amount for half the height of the current
 	# entry.  To be safe we subtract an extra 10.
-	set yoffset [expr {[winfo screenheight $menu] \
-		- $y - [winfo reqheight $menu] - 10}]
-	if {$yoffset < 0} {
-	    # The bottom of the menu is offscreen, so adjust upwards
-	    incr y $yoffset
-	    if {$y < 0} { set y 0 }
-	}
-	# If we're off the top of the screen (either because we were
-	# originally or because we just adjusted too far upwards),
-	# then make the menu popup on the top edge.
-	if {$y < 0} {
-	    set y 0
+	# NOTE: this issue appears to have been resolved in the Window
+	# manager provided with Vista and Windows 7.
+	if {$ver < 6} {
+	    set yoffset [expr {[winfo screenheight $menu] \
+		    - $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]}]
+	    }
+	    # If we're off the top of the screen (either because we were
+	    # originally or because we just adjusted too far upwards),
+	    # then make the menu popup on the top edge.
+	    if {$y < [winfo vrooty $menu]} {
+		set y [winfo vrooty $menu]
+	    }
 	}
     }
     $menu post $x $y
@@ -1239,11 +1249,11 @@ proc ::tk::RestoreOldGrab {} {
     variable ::tk::Priv
 
     if {$Priv(oldGrab) ne ""} {
-    	# Be careful restoring the old grab, since it's window may not
+	# Be careful restoring the old grab, since it's window may not
 	# be visible anymore.
 
 	catch {
-          if {$Priv(grabStatus) eq "global"} {
+	    if {$Priv(grabStatus) eq "global"} {
 		grab set -global $Priv(oldGrab)
 	    } else {
 		grab set $Priv(oldGrab)
@@ -1264,7 +1274,8 @@ proc ::tk_menuSetFocus {menu} {
 proc ::tk::GenerateMenuSelect {menu} {
     variable ::tk::Priv
 
-    if {$Priv(activeMenu) eq $menu && $Priv(activeItem) eq [$menu index active]} {
+    if {$Priv(activeMenu) eq $menu \
+	    && $Priv(activeItem) eq [$menu index active]} {
 	return
     }