summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/menu.tcl129
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
generated by cgit v0.12 at 2024-11-01 06:20:42 (GMT)