# menu.tcl --
#
# This file defines the default bindings for Tk menus and menubuttons.
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
# RCS: @(#) $Id: menu.tcl,v 1.2 2004/10/28 21:58:54 cgregg Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tk::Priv that are used in this file:
#
# cursor -      Saves the -cursor option for the posted menubutton.
# focus -       Saves the focus during a menu selection operation.
#           Focus gets restored here when the menu is unposted.
# grabGlobal -      Used in conjunction with tk::Priv(oldGrab):  if
#           tk::Priv(oldGrab) is non-empty, then tk::Priv(grabGlobal)
#           contains either an empty string or "-global" to
#           indicate whether the old grab was a local one or
#           a global one.
# inMenubutton -    The name of the menubutton widget containing
#           the mouse, or an empty string if the mouse is
#           not over any menubutton.
# menuBar -     The name of the menubar that is the root
#           of the cascade hierarchy which is currently
#           posted. This is null when there is no menu currently
#           being pulled down from a menu bar.
# oldGrab -     Window that had the grab before a menu was posted.
#           Used to restore the grab state after the menu
#           is unposted.  Empty string means there was no
#           grab previously set.
# popup -       If a menu has been popped up via tk_popup, this
#           gives the name of the menu.  Otherwise this
#           value is empty.
# postedMb -        Name of the menubutton whose menu is currently
#           posted, or an empty string if nothing is posted
#           A grab is set on this widget.
# relief -      Used to save the original relief of the current
#           menubutton.
# window -      When the mouse is over a menu, this holds the
#           name of the menu;  it's cleared when the mouse
#           leaves the menu.
# tearoff -     Whether the last menu posted was a tearoff or not.
#           This is true always for unix, for tearoffs for Mac
#           and Windows.
# activeMenu -      This is the last active menu for use
#           with the <<MenuSelect>> virtual event.
# activeItem -      This is the last active menu item for
#           use with the <<MenuSelect>> virtual event.
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# Overall note:
# 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 
#    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".
# 3. As an option menu, triggered from an option menubutton.  In this
#    style tk::Priv(postedMb) identifies the posted menubutton.
# 4. As a popup menu.  In this style tk::Priv(postedMb) is empty and
#    the top-level menu's type is "normal".
# 5. As a pulldown from a menubar. The variable tk::Priv(menubar) has
#    the owning menubar, and the menu itself is of type "normal".
#
# The various binding procedures use the  state described above to
# distinguish the various cases and take different actions in each
# case.
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# The code below creates the default class bindings for menus
# and menubuttons.
#-------------------------------------------------------------------------

bind Menubutton <FocusIn> {}
bind Menubutton <Enter> {
    tk::MbEnter %W
}
bind Menubutton <Leave> {
    tk::MbLeave %W
}
bind Menubutton <1> {
    if {$tk::Priv(inMenubutton) ne ""} {
    tk::MbPost $tk::Priv(inMenubutton) %X %Y
    }
}
bind Menubutton <Motion> {
    tk::MbMotion %W up %X %Y
}
bind Menubutton <B1-Motion> {
    tk::MbMotion %W down %X %Y
}
bind Menubutton <ButtonRelease-1> {
    tk::MbButtonUp %W
}
bind Menubutton <space> {
    tk::MbPost %W
    tk::MenuFirstEntry [%W cget -menu]
}

# Must set focus when mouse enters a menu, in order to allow
# mixed-mode processing using both the mouse and the keyboard.
# Don't set the focus if the event comes from a grab release,
# though:  such an event can happen after as part of unposting
# a cascaded chain of menus, after the focus has already been
# restored to wherever it was before menu selection started.

bind Menu <FocusIn> {}

bind Menu <Enter> {
    set tk::Priv(window) %W
    if {[%W cget -type] eq "tearoff"} {
    if {"%m" ne "NotifyUngrab"} {
        if {[tk windowingsystem] eq "x11"} {
        tk_menuSetFocus %W
        }
    }
    }
    tk::MenuMotion %W %x %y %s
}

bind Menu <Leave> {
    tk::MenuLeave %W %X %Y %s
}
bind Menu <Motion> {
    tk::MenuMotion %W %x %y %s
}
bind Menu <ButtonPress> {
    tk::MenuButtonDown %W
}
bind Menu <ButtonRelease> {
   tk::MenuInvoke %W 1
}
bind Menu <space> {
    tk::MenuInvoke %W 0
}
bind Menu <Return> {
    tk::MenuInvoke %W 0
}
bind Menu <Escape> {
    tk::MenuEscape %W
}
bind Menu <Left> {
    tk::MenuLeftArrow %W
}
bind Menu <Right> {
    tk::MenuRightArrow %W
}
bind Menu <Up> {
    tk::MenuUpArrow %W
}
bind Menu <Down> {
    tk::MenuDownArrow %W
}
bind Menu <KeyPress> {
    tk::TraverseWithinMenu %W %A
}

# The following bindings apply to all windows, and are used to
# implement keyboard menu traversal.

if {[string equal [tk windowingsystem] "x11"]} {
    bind all <Alt-KeyPress> {
    tk::TraverseToMenu %W %A
    }

    bind all <F10> {
    tk::FirstMenu %W
    }
} else {
    bind Menubutton <Alt-KeyPress> {
    tk::TraverseToMenu %W %A
    }

    bind Menubutton <F10> {
    tk::FirstMenu %W
    }
}

# ::tk::MbEnter --
# This procedure is invoked when the mouse enters a menubutton
# widget.  It activates the widget unless it is disabled.  Note:
# this procedure is only invoked when mouse button 1 is *not* down.
# The procedure ::tk::MbB1Enter is invoked if the button is down.
#
# Arguments:
# w -           The  name of the widget.

proc ::tk::MbEnter w {
    variable ::tk::Priv

    if {[string compare $Priv(inMenubutton) ""]} {
    MbLeave $Priv(inMenubutton)
    }
    set Priv(inMenubutton) $w
    if {[string compare [$w cget -state] "disabled"]} {
    $w configure -state active
    }
}

# ::tk::MbLeave --
# This procedure is invoked when the mouse leaves a menubutton widget.
# It de-activates the widget, if the widget still exists.
#
# Arguments:
# w -           The  name of the widget.

proc ::tk::MbLeave w {
    variable ::tk::Priv

    set Priv(inMenubutton) {}
    if {![winfo exists $w]} {
    return
    }
    if {[string equal [$w cget -state] "active"]} {
    $w configure -state normal
    }
}

# ::tk::MbPost --
# Given a menubutton, this procedure does all the work of posting
# its associated menu and unposting any other menu that is currently
# posted.
#
# Arguments:
# w -           The name of the menubutton widget whose menu
#           is to be posted.
# x, y -        Root coordinates of cursor, used for positioning
#           option menus.  If not specified, then the center
#           of the menubutton is used for an option menu.

proc ::tk::MbPost {w {x {}} {y {}}} {
    global errorInfo
    variable ::tk::Priv
    global tcl_platform

    if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} {
    return
    }
    set menu [$w cget -menu]
    if {[string equal $menu ""]} {
    return
    }
    set tearoff [expr {[tk windowingsystem] eq "x11" \
        || [$menu cget -type] eq "tearoff"}]
    if {[string first $w $menu] != 0} {
    error "can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
    }
    set cur $Priv(postedMb)
    if {[string compare $cur ""]} {
    MenuUnpost {}
    }
    set Priv(cursor) [$w cget -cursor]
    set Priv(relief) [$w cget -relief]
    $w configure -cursor arrow
    $w configure -relief raised

    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 [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]}]
        }
        PostOverPoint $menu $x $y
            }
            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}]
        }
        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]} {
            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}]
            }
                }
        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 {[$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}]
            }
                }
        PostOverPoint $menu $x $y
        if {$entry ne "" \
            && [$menu entrycget $entry -state] ne "disabled"} {
                    $menu activate $entry
            GenerateMenuSelect $menu
                }
            }
            default {
                if {[$w cget -indicatoron]} {
            if {[string equal $y {}]} {
            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

    }

    set Priv(tearoff) $tearoff
    if {$tearoff != 0} {
        focus $menu
    if {[winfo viewable $w]} {
        SaveGrabInfo $w
        grab -global $w
    }
    }
}

# ::tk::MenuUnpost --
# This procedure unposts a given menu, plus all of its ancestors up
# to (and including) a menubutton, if any.  It also restores various
# values to what they were before the menu was posted, and releases
# a grab if there's a menubutton involved.  Special notes:
# 1. It's important to unpost all menus before releasing the grab, so
#    that any Enter-Leave events (e.g. from menu back to main
#    application) have mode NotifyGrab.
# 2. Be sure to enclose various groups of commands in "catch" so that
#    the procedure will complete even if the menubutton or the menu
#    or the grab window has been deleted.
#
# Arguments:
# menu -        Name of a menu to unpost.  Ignored if there
#           is a posted menubutton.

proc ::tk::MenuUnpost menu {
    global tcl_platform
    variable ::tk::Priv
    set mb $Priv(postedMb)

    # Restore focus right away (otherwise X will take focus away when
    # the menu is unmapped and under some window managers (e.g. olvwm)
    # we'll lose the focus completely).

    catch {focus $Priv(focus)}
    set Priv(focus) ""

    # Unpost menu(s) and restore some stuff that's dependent on
    # what was posted.

    catch {
    if {[string compare $mb ""]} {
        set menu [$mb cget -menu]
        $menu unpost
        set Priv(postedMb) {}
        $mb configure -cursor $Priv(cursor)
        $mb configure -relief $Priv(relief)
    } elseif {[string compare $Priv(popup) ""]} {
        $Priv(popup) unpost
        set Priv(popup) {}
    } elseif {[string compare [$menu cget -type] "menubar"] \
        && [string compare [$menu cget -type] "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
        # top-level torn off menu if there is one.

        while {1} {
        set parent [winfo parent $menu]
        if {[string compare [winfo class $parent] "Menu"] \
            || ![winfo ismapped $parent]} {
            break
        }
        $parent activate none
        $parent postcascade none
        GenerateMenuSelect $parent
        set type [$parent cget -type]
        if {[string equal $type "menubar"] || \
            [string equal $type "tearoff"]} {
            break
        }
        set menu $parent
        }
        if {[string compare [$menu cget -type] "menubar"]} {
        $menu unpost
        }
    }
    }

    if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
        # Release grab, if any, and restore the previous grab, if there
        # was one.
    if {[string compare $menu ""]} {
        set grab [grab current $menu]
        if {[string compare $grab ""]} {
        grab release $grab
        }
    }
    RestoreOldGrab
    if {$Priv(menuBar) ne ""} {
        $Priv(menuBar) configure -cursor $Priv(cursor)
        set Priv(menuBar) {}
    }
    if {[tk windowingsystem] ne "x11"} {
        set Priv(tearoff) 0
    }
    }
}

# ::tk::MbMotion --
# This procedure handles mouse motion events inside menubuttons, and
# also outside menubuttons when a menubutton has a grab (e.g. when a
# menu selection operation is in progress).
#
# Arguments:
# w -           The name of the menubutton widget.
# upDown -      "down" means button 1 is pressed, "up" means
#           it isn't.
# rootx, rooty -    Coordinates of mouse, in (virtual?) root window.

proc ::tk::MbMotion {w upDown rootx rooty} {
    variable ::tk::Priv

    if {[string equal $Priv(inMenubutton) $w]} {
    return
    }
    set new [winfo containing $rootx $rooty]
    if {[string compare $new $Priv(inMenubutton)] \
        && ([string equal $new ""] \
        || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
    if {[string compare $Priv(inMenubutton) ""]} {
        MbLeave $Priv(inMenubutton)
    }
    if {[string compare $new ""] \
        && [string equal [winfo class $new] "Menubutton"] \
        && ([$new cget -indicatoron] == 0) \
        && ([$w cget -indicatoron] == 0)} {
        if {[string equal $upDown "down"]} {
        MbPost $new $rootx $rooty
        } else {
        MbEnter $new
        }
    }
    }
}

# ::tk::MbButtonUp --
# This procedure is invoked to handle button 1 releases for menubuttons.
# If the release happens inside the menubutton then leave its menu
# posted with element 0 activated.  Otherwise, unpost the menu.
#
# Arguments:
# w -           The name of the menubutton widget.

proc ::tk::MbButtonUp w {
    variable ::tk::Priv
    global tcl_platform

    set menu [$w cget -menu]
    set tearoff [expr {[tk windowingsystem] eq "x11" || \
        ($menu ne "" && [$menu cget -type] eq "tearoff")}]
    if {($tearoff != 0) && $Priv(postedMb) eq $w \
        && $Priv(inMenubutton) eq $w} {
    MenuFirstEntry [$Priv(postedMb) cget -menu]
    } else {
    MenuUnpost {}
    }
}

# ::tk::MenuMotion --
# This procedure is called to handle mouse motion events for menus.
# It does two things.  First, it resets the active element in the
# menu, if the mouse is over the menu.  Second, if a mouse button
# is down, it posts and unposts cascade entries to match the mouse
# position.
#
# Arguments:
# menu -        The menu window.
# x -           The x position of the mouse.
# y -           The y position of the mouse.
# state -       Modifier state (tells whether buttons are down).

proc ::tk::MenuMotion {menu x y state} {
    variable ::tk::Priv
    if {[string equal $menu $Priv(window)]} {
    if {[string equal [$menu cget -type] "menubar"]} {
        if {[info exists Priv(focus)] && \
            [string compare $menu $Priv(focus)]} {
        $menu activate @$x,$y
        GenerateMenuSelect $menu
        }
    } else {
        $menu activate @$x,$y
        GenerateMenuSelect $menu
    }
    }
    if {($state & 0x1f00) != 0} {
    $menu postcascade active
    }
}

# ::tk::MenuButtonDown --
# Handles button presses in menus.  There are a couple of tricky things
# here:
# 1. Change the posted cascade entry (if any) to match the mouse position.
# 2. If there is a posted menubutton, must grab to the menubutton;  this
#    overrrides the implicit grab on button press, so that the menu
#    button can track mouse motions over other menubuttons and change
#    the posted menu.
# 3. If there's no posted menubutton (e.g. because we're a torn-off menu
#    or one of its descendants) must grab to the top-level menu so that
#    we can track mouse motions across the entire menu hierarchy.
#
# Arguments:
# menu -        The menu window.

proc ::tk::MenuButtonDown menu {
    variable ::tk::Priv
    global tcl_platform

    if {![winfo viewable $menu]} {
        return
    }
    $menu postcascade active
    if {[string compare $Priv(postedMb) ""] && \
        [winfo viewable $Priv(postedMb)]} {
    grab -global $Priv(postedMb)
    } else {
    while {[string equal [$menu cget -type] "normal"] \
        && [string equal [winfo class [winfo parent $menu]] "Menu"] \
        && [winfo ismapped [winfo parent $menu]]} {
        set menu [winfo parent $menu]
    }

    if {[string equal $Priv(menuBar) {}]} {
        set Priv(menuBar) $menu
        set Priv(cursor) [$menu cget -cursor]
        $menu configure -cursor arrow
        }

    # Don't update grab information if the grab window isn't changing.
    # Otherwise, we'll get an error when we unpost the menus and
    # restore the grab, since the old grab window will not be viewable
    # anymore.

    if {[string compare $menu [grab current $menu]]} {
        SaveGrabInfo $menu
    }

    # Must re-grab even if the grab window hasn't changed, in order
    # to release the implicit grab from the button press.

    if {[string equal [tk windowingsystem] "x11"]} {
        grab -global $menu
    }
    }
}

# ::tk::MenuLeave --
# This procedure is invoked to handle Leave events for a menu.  It
# deactivates everything unless the active element is a cascade element
# and the mouse is now over the submenu.
#
# Arguments:
# menu -        The menu window.
# rootx, rooty -    Root coordinates of mouse.
# state -       Modifier state.

proc ::tk::MenuLeave {menu rootx rooty state} {
    variable ::tk::Priv
    set Priv(window) {}
    if {[string equal [$menu index active] "none"]} {
    return
    }
    if {[string equal [$menu type active] "cascade"]
          && [string equal [winfo containing $rootx $rooty] \
                  [$menu entrycget active -menu]]} {
    return
    }
    $menu activate none
    GenerateMenuSelect $menu
}

# ::tk::MenuInvoke --
# This procedure is invoked when button 1 is released over a menu.
# It invokes the appropriate menu action and unposts the menu if
# it came from a menubutton.
#
# Arguments:
# w -           Name of the menu widget.
# buttonRelease -   1 means this procedure is called because of
#           a button release;  0 means because of keystroke.

proc ::tk::MenuInvoke {w buttonRelease} {
    variable ::tk::Priv

    if {$buttonRelease && [string equal $Priv(window) {}]} {
    # Mouse was pressed over a menu without a menu button, then
    # dragged off the menu (possibly with a cascade posted) and
    # released.  Unpost everything and quit.

    $w postcascade none
    $w activate none
    event generate $w <<MenuSelect>>
    MenuUnpost $w
    return
    }
    if {[string equal [$w type active] "cascade"]} {
    $w postcascade active
    set menu [$w entrycget active -menu]
    MenuFirstEntry $menu
    } elseif {[string equal [$w type active] "tearoff"]} {
    ::tk::TearOffMenu $w
    MenuUnpost $w
    } elseif {[string equal [$w cget -type] "menubar"]} {
    $w postcascade none
    set active [$w index active]
    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 
    # checkbuttons/commands/etc. on menubars

    if { $isCascade } {
        $w activate none
        event generate $w <<MenuSelect>>
    }

    MenuUnpost $w

    # If the active item is not a cascade, invoke it.  This enables
    # the use of checkbuttons/commands/etc. on menubars (which is legal,
    # but not recommended)

    if { !$isCascade } {
        uplevel #0 [list $w invoke $active]
    }
    } else {
    MenuUnpost $w
    uplevel #0 [list $w invoke active]
    }
}

# ::tk::MenuEscape --
# This procedure is invoked for the Cancel (or Escape) key.  It unposts
# the given menu and, if it is the top-level menu for a menu button,
# unposts the menu button as well.
#
# Arguments:
# menu -        Name of the menu window.

proc ::tk::MenuEscape menu {
    set parent [winfo parent $menu]
    if {[string compare [winfo class $parent] "Menu"]} {
    MenuUnpost $menu
    } elseif {[string equal [$parent cget -type] "menubar"]} {
    MenuUnpost $menu
    RestoreOldGrab
    } else {
    MenuNextMenu $menu left
    }
}

# The following routines handle arrow keys. Arrow keys behave
# differently depending on whether the menu is a menu bar or not.

proc ::tk::MenuUpArrow {menu} {
    if {[string equal [$menu cget -type] "menubar"]} {
    MenuNextMenu $menu left
    } else {
    MenuNextEntry $menu -1
    }
}

proc ::tk::MenuDownArrow {menu} {
    if {[string equal [$menu cget -type] "menubar"]} {
    MenuNextMenu $menu right
    } else {
    MenuNextEntry $menu 1
    }
}

proc ::tk::MenuLeftArrow {menu} {
    if {[string equal [$menu cget -type] "menubar"]} {
    MenuNextEntry $menu -1
    } else {
    MenuNextMenu $menu left
    }
}

proc ::tk::MenuRightArrow {menu} {
    if {[string equal [$menu cget -type] "menubar"]} {
    MenuNextEntry $menu 1
    } else {
    MenuNextMenu $menu right
    }
}

# ::tk::MenuNextMenu --
# This procedure is invoked to handle "left" and "right" traversal
# motions in menus.  It traverses to the next menu in a menu bar,
# or into or out of a cascaded menu.
#
# Arguments:
# menu -        The menu that received the keyboard
#           event.
# direction -       Direction in which to move: "left" or "right"

proc ::tk::MenuNextMenu {menu direction} {
    variable ::tk::Priv

    # First handle traversals into and out of cascaded menus.

    if {[string equal $direction "right"]} {
    set count 1
    set parent [winfo parent $menu]
    set class [winfo class $parent]
    if {[string equal [$menu type active] "cascade"]} {
        $menu postcascade active
        set m2 [$menu entrycget active -menu]
        if {[string compare $m2 ""]} {
        MenuFirstEntry $m2
        }
        return
    } else {
        set parent [winfo parent $menu]
        while {[string compare $parent "."]} {
        if {[string equal [winfo class $parent] "Menu"] \
            && [string equal [$parent cget -type] "menubar"]} {
            tk_menuSetFocus $parent
            MenuNextEntry $parent 1
            return
        }
        set parent [winfo parent $parent]
        }
    }
    } else {
    set count -1
    set m2 [winfo parent $menu]
    if {[string equal [winfo class $m2] "Menu"]} {
        $menu activate none
        GenerateMenuSelect $menu
        tk_menuSetFocus $m2

        $m2 postcascade none

        if {[string compare [$m2 cget -type] "menubar"]} {
        return
        }
    }
    }

    # 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 {[string equal [winfo class $m2] "Menu"]} {
    if {[string equal [$m2 cget -type] "menubar"]} {
        tk_menuSetFocus $m2
        MenuNextEntry $m2 -1
        return
    }
    }

    set w $Priv(postedMb)
    if {[string equal $w ""]} {
    return
    }
    set buttons [winfo children [winfo parent $w]]
    set length [llength $buttons]
    set i [expr {[lsearch -exact $buttons $w] + $count}]
    while {1} {
    while {$i < 0} {
        incr i $length
    }
    while {$i >= $length} {
        incr i -$length
    }
    set mb [lindex $buttons $i]
    if {[string equal [winfo class $mb] "Menubutton"] \
        && [string compare [$mb cget -state] "disabled"] \
        && [string compare [$mb cget -menu] ""] \
        && [string compare [[$mb cget -menu] index last] "none"]} {
        break
    }
    if {[string equal $mb $w]} {
        return
    }
    incr i $count
    }
    MbPost $mb
    MenuFirstEntry [$mb cget -menu]
}

# ::tk::MenuNextEntry --
# Activate the next higher or lower entry in the posted menu,
# wrapping around at the ends.  Disabled entries are skipped.
#
# Arguments:
# menu -            Menu window that received the keystroke.
# count -           1 means go to the next lower entry,
#               -1 means go to the next higher entry.

proc ::tk::MenuNextEntry {menu count} {

    if {[string equal [$menu index last] "none"]} {
    return
    }
    set length [expr {[$menu index last]+1}]
    set quitAfter $length
    set active [$menu index active]
    if {[string equal $active "none"]} {
    set i 0
    } else {
    set i [expr {$active + $count}]
    }
    while {1} {
    if {$quitAfter <= 0} {
        # We've tried every entry in the menu.  Either there are
        # none, or they're all disabled.  Just give up.

        return
    }
    while {$i < 0} {
        incr i $length
    }
    while {$i >= $length} {
        incr i -$length
    }
    if {[catch {$menu entrycget $i -state} state] == 0} {
        if {$state ne "disabled" && \
            ($i!=0 || [$menu cget -type] ne "tearoff" \
            || [$menu type 0] ne "tearoff")} {
        break
        }
    }
    if {$i == $active} {
        return
    }
    incr i $count
    incr quitAfter -1
    }
    $menu activate $i
    GenerateMenuSelect $menu

    if {[string equal [$menu type $i] "cascade"] \
        && [string equal [$menu cget -type] "menubar"]} {
    set cascade [$menu entrycget $i -menu]
    if {[string compare $cascade ""]} {
        # Here we auto-post a cascade.  This is necessary when
        # we traverse left/right in the menubar, but undesirable when
        # we traverse up/down in a menu.
        $menu postcascade $i
        MenuFirstEntry $cascade
    }
    }
}

# ::tk::MenuFind --
# This procedure searches the entire window hierarchy under w for
# a menubutton that isn't disabled and whose underlined character
# is "char" or an entry in a menubar that isn't disabled and whose
# underlined character is "char".
# It returns the name of that window, if found, or an
# empty string if no matching window was found.  If "char" is an
# empty string then the procedure returns the name of the first
# menubutton found that isn't disabled.
#
# Arguments:
# w -               Name of window where key was typed.
# char -            Underlined character to search for;
#               may be either upper or lower case, and
#               will match either upper or lower case.

proc ::tk::MenuFind {w char} {
    set char [string tolower $char]
    set windowlist [winfo child $w]

    foreach child $windowlist {
    # Don't descend into other toplevels.
        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
        continue
    }
    if {[string equal [winfo class $child] "Menu"] && \
        [string equal [$child cget -type] "menubar"]} {
        if {[string equal $char ""]} {
        return $child
        }
        set last [$child index last]
        for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
        if {[string equal [$child type $i] "separator"]} {
            continue
        }
        set char2 [string index [$child entrycget $i -label] \
            [$child entrycget $i -underline]]
        if {[string equal $char [string tolower $char2]] \
            || [string equal $char ""]} {
            if {[string compare [$child entrycget $i -state] "disabled"]} {
            return $child
            }
        }
        }
    }
    }

    foreach child $windowlist {
    # Don't descend into other toplevels.
        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
        continue
    }
    switch [winfo class $child] {
        Menubutton {
        set char2 [string index [$child cget -text] \
            [$child cget -underline]]
        if {[string equal $char [string tolower $char2]] \
            || [string equal $char ""]} {
            if {[string compare [$child cget -state] "disabled"]} {
            return $child
            }
        }
        }

        default {
        set match [MenuFind $child $char]
        if {[string compare $match ""]} {
            return $match
        }
        }
    }
    }
    return {}
}

# ::tk::TraverseToMenu --
# This procedure implements keyboard traversal of menus.  Given an
# ASCII character "char", it looks for a menubutton with that character
# underlined.  If one is found, it posts the menubutton's menu
#
# Arguments:
# w -               Window in which the key was typed (selects
#               a toplevel window).
# char -            Character that selects a menu.  The case
#               is ignored.  If an empty string, nothing
#               happens.

proc ::tk::TraverseToMenu {w char} {
    variable ::tk::Priv
    if {[string equal $char ""]} {
    return
    }
    while {[string equal [winfo class $w] "Menu"]} {
    if {[string compare [$w cget -type] "menubar"] \
        && [string equal $Priv(postedMb) ""]} {
        return
    }
    if {[string equal [$w cget -type] "menubar"]} {
        break
    }
    set w [winfo parent $w]
    }
    set w [MenuFind [winfo toplevel $w] $char]
    if {[string compare $w ""]} {
    if {[string equal [winfo class $w] "Menu"]} {
        tk_menuSetFocus $w
        set Priv(window) $w
        SaveGrabInfo $w
        grab -global $w
        TraverseWithinMenu $w $char
    } else {
        MbPost $w
        MenuFirstEntry [$w cget -menu]
    }
    }
}

# ::tk::FirstMenu --
# This procedure traverses to the first menubutton in the toplevel
# for a given window, and posts that menubutton's menu.
#
# Arguments:
# w -               Name of a window.  Selects which toplevel
#               to search for menubuttons.

proc ::tk::FirstMenu w {
    variable ::tk::Priv
    set w [MenuFind [winfo toplevel $w] ""]
    if {[string compare $w ""]} {
    if {[string equal [winfo class $w] "Menu"]} {
        tk_menuSetFocus $w
        set Priv(window) $w
        SaveGrabInfo $w
        grab -global $w
        MenuFirstEntry $w
    } else {
        MbPost $w
        MenuFirstEntry [$w cget -menu]
    }
    }
}

# ::tk::TraverseWithinMenu
# This procedure implements keyboard traversal within a menu.  It
# searches for an entry in the menu that has "char" underlined.  If
# such an entry is found, it is invoked and the menu is unposted.
#
# Arguments:
# w -               The name of the menu widget.
# char -            The character to look for;  case is
#               ignored.  If the string is empty then
#               nothing happens.

proc ::tk::TraverseWithinMenu {w char} {
    if {[string equal $char ""]} {
    return
    }
    set char [string tolower $char]
    set last [$w index last]
    if {[string equal $last "none"]} {
    return
    }
    for {set i 0} {$i <= $last} {incr i} {
    if {[catch {set char2 [string index \
        [$w entrycget $i -label] [$w entrycget $i -underline]]}]} {
        continue
    }
    if {[string equal $char [string tolower $char2]]} {
        if {[string equal [$w type $i] "cascade"]} {
        $w activate $i
        $w postcascade active
        event generate $w <<MenuSelect>>
        set m2 [$w entrycget $i -menu]
        if {[string compare $m2 ""]} {
            MenuFirstEntry $m2
        }
        } else {
        MenuUnpost $w
        uplevel #0 [list $w invoke $i]
        }
        return
    }
    }
}

# ::tk::MenuFirstEntry --
# Given a menu, this procedure finds the first entry that isn't
# disabled or a tear-off or separator, and activates that entry.
# However, if there is already an active entry in the menu (e.g.,
# because of a previous call to tk::PostOverPoint) then the active
# entry isn't changed.  This procedure also sets the input focus
# to the menu.
#
# Arguments:
# menu -        Name of the menu window (possibly empty).

proc ::tk::MenuFirstEntry menu {
    if {[string equal $menu ""]} {
    return
    }
    tk_menuSetFocus $menu
    if {[string compare [$menu index active] "none"]} {
    return
    }
    set last [$menu index last]
    if {[string equal $last "none"]} {
    return
    }
    for {set i 0} {$i <= $last} {incr i} {
    if {([catch {set state [$menu entrycget $i -state]}] == 0) \
        && [string compare $state "disabled"] \
        && [string compare [$menu type $i] "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 {[string equal [$menu type $i] "cascade"] && \
        [string equal [$menu cget -type] "menubar"]} {
        set cascade [$menu entrycget $i -menu]
        if {[string compare $cascade ""]} {
            $menu postcascade $i
            MenuFirstEntry $cascade
        }
        }
        return
    }
    }
}

# ::tk::MenuFindName --
# Given a menu and a text string, return the index of the menu entry
# that displays the string as its label.  If there is no such entry,
# return an empty string.  This procedure is tricky because some names
# like "active" have a special meaning in menu commands, so we can't
# always use the "index" widget command.
#
# Arguments:
# menu -        Name of the menu widget.
# s -           String to look for.

proc ::tk::MenuFindName {menu s} {
    set i ""
    if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
    catch {set i [$menu index $s]}
    return $i
    }
    set last [$menu index last]
    if {[string equal $last "none"]} {
    return
    }
    for {set i 0} {$i <= $last} {incr i} {
    if {![catch {$menu entrycget $i -label} label]} {
        if {[string equal $label $s]} {
        return $i
        }
    }
    }
    return ""
}

# ::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.
#
# Arguments:
# menu -        Menu to post.
# x, y -        Root coordinates of point.
# entry -       Index of entry within menu to center over (x,y).
#           If omitted or specified as {}, then the menu's
#           upper-left corner goes at (x,y).

proc ::tk::PostOverPoint {menu x y {entry {}}}  {
    global tcl_platform
    
    if {[string compare $entry {}]} {
    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 [expr {-[winfo reqwidth $menu]/2}]
    }
    if {$tcl_platform(platform) == "windows"} {
    # We need to fix some problems with menu posting on Windows.
    set yoffset [expr {[winfo screenheight $menu] \
        - $y - [winfo reqheight $menu]}]
    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
    }
    }
    $menu post $x $y
    if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
    $menu activate $entry
    GenerateMenuSelect $menu
    }
}

# ::tk::SaveGrabInfo --
# Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record
# the state of any existing grab on the w's display.
#
# Arguments:
# w -           Name of a window;  used to select the display
#           whose grab information is to be recorded.

proc tk::SaveGrabInfo w {
    variable ::tk::Priv
    set Priv(oldGrab) [grab current $w]
    if {$Priv(oldGrab) ne ""} {
    set Priv(grabStatus) [grab status $Priv(oldGrab)]
    }
}

# ::tk::RestoreOldGrab --
# Restores the grab to what it was before TkSaveGrabInfo was called.
#

proc ::tk::RestoreOldGrab {} {
    variable ::tk::Priv

    if {$Priv(oldGrab) ne ""} {
        # Be careful restoring the old grab, since it's window may not
    # be visible anymore.

    catch {
          if {[string equal $Priv(grabStatus) "global"]} {
        grab set -global $Priv(oldGrab)
        } else {
        grab set $Priv(oldGrab)
        }
    }
    set Priv(oldGrab) ""
    }
}

proc ::tk_menuSetFocus {menu} {
    variable ::tk::Priv
    if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
    set Priv(focus) [focus]
    }
    focus $menu
}
    
proc ::tk::GenerateMenuSelect {menu} {
    variable ::tk::Priv

    if {[string equal $Priv(activeMenu) $menu] \
          && [string equal $Priv(activeItem) [$menu index active]]} {
    return
    }

    set Priv(activeMenu) $menu
    set Priv(activeItem) [$menu index active]
    event generate $menu <<MenuSelect>>
}

# ::tk_popup --
# This procedure pops up a menu and sets things up for traversing
# the menu and its submenus.
#
# Arguments:
# menu -        Name of the menu to be popped up.
# x, y -        Root coordinates at which to pop up the
#           menu.
# entry -       Index of a menu entry to center over (x,y).
#           If omitted or specified as {}, then menu's
#           upper-left corner goes at (x,y).

proc ::tk_popup {menu x y {entry {}}} {
    variable ::tk::Priv
    global tcl_platform
    if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
    tk::MenuUnpost {}
    }
    tk::PostOverPoint $menu $x $y $entry
    if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
        tk::SaveGrabInfo $menu
    grab -global $menu
    set Priv(popup) $menu
    tk_menuSetFocus $menu
    }
}
