diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-05-05 16:27:53 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-05-05 16:27:53 (GMT) |
commit | 24ea39ac53ca868aec6e2e78f48f4e60138884fe (patch) | |
tree | 65ecb3ddccea5ae2b02c8ddb56ac280b7adffdee /library | |
parent | 83dd76da7170a8bb9c59b60508c5df606204709c (diff) | |
parent | 302dfe1be6830add9d1bd8b57b4bc6c00fc609b3 (diff) | |
download | tk-24ea39ac53ca868aec6e2e78f48f4e60138884fe.zip tk-24ea39ac53ca868aec6e2e78f48f4e60138884fe.tar.gz tk-24ea39ac53ca868aec6e2e78f48f4e60138884fe.tar.bz2 |
merge trunk
Diffstat (limited to 'library')
-rw-r--r-- | library/menu.tcl | 129 |
1 files changed, 62 insertions, 67 deletions
diff --git a/library/menu.tcl b/library/menu.tcl index e00dad9..5fb96fa 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". @@ -282,81 +282,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] && $entry ne ""} { + } + 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] && $entry ne ""} { + } + } + 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 @@ -365,7 +365,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 @@ -425,8 +425,7 @@ proc ::tk::MenuUnpost menu { } elseif {$Priv(popup) ne ""} { $Priv(popup) unpost set Priv(popup) {} - } elseif {[$menu cget -type] ne "menubar" \ - && [$menu cget -type] ne "tearoff"} { + } elseif {[$menu cget -type] ne "menubar" && [$menu cget -type] ne "tearoff"} { # We're in a cascaded sub-menu from a torn-off menu or popup. # Unpost all the menus up to the toplevel one (but not # including the top-level torn-off one) and deactivate the @@ -434,8 +433,7 @@ proc ::tk::MenuUnpost menu { while {1} { set parent [winfo parent $menu] - if {[winfo class $parent] ne "Menu" \ - || ![winfo ismapped $parent]} { + if {[winfo class $parent] ne "Menu" || ![winfo ismapped $parent]} { break } $parent activate none @@ -454,8 +452,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 ""} { @@ -702,7 +700,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 } { @@ -1030,11 +1028,10 @@ proc ::tk::TraverseToMenu {w char} { return } while {[winfo class $w] eq "Menu"} { - if {[$w cget -type] ne "menubar" && $Priv(postedMb) eq ""} { - return - } if {[$w cget -type] eq "menubar"} { break + } elseif {$Priv(postedMb) eq ""} { + return } set w [winfo parent $w] } @@ -1153,8 +1150,7 @@ proc ::tk::MenuFirstEntry menu { # 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 @@ -1211,7 +1207,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] \ @@ -1235,21 +1231,20 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { # 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. - # NOTE: this issue appears to have been resolved in the Window - # manager provided with Vista and Windows 7. + # 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 < 0} { + - $y - [winfo reqheight $menu] - 10}] + if {$yoffset < [winfo vrooty $menu]} { # The bottom of the menu is offscreen, so adjust upwards - incr y $yoffset - if {$y < 0} { set y 0 } + 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 < 0} { - set y 0 + if {$y < [winfo vrooty $menu]} { + set y [winfo vrooty $menu] } } } @@ -1284,7 +1279,7 @@ 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 { @@ -1305,7 +1300,7 @@ proc ::tk_menuSetFocus {menu} { } focus $menu } - + proc ::tk::GenerateMenuSelect {menu} { variable ::tk::Priv |