URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk
Subversion Repositories or1k_old

[/] [or1k_old/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [menubar.itk] - Blame information for rev 1782

Details | Compare with Previous | View Log

#
# Menubar widget
# ----------------------------------------------------------------------
# The Menubar command creates a new window (given by the pathName
# argument) and makes it into a Pull down menu widget. Additional
# options, described above may be specified on the command line or
# in the option database to configure aspects of the Menubar such
# as its colors and font. The Menubar command returns its pathName
# argument. At the time this command is invoked, there must not exist
# a window named pathName, but pathName's parent must exist.
#
# A Menubar is a widget that simplifies the task of creating
# menu hierarchies. It encapsulates a frame widget, as well
# as menubuttons, menus, and menu entries. The Menubar allows
# menus to be specified and refer enced in a more consistent
# manner than using Tk to build menus directly. First, Menubar
# allows a menu tree to be expressed in a hierachical "language".
# The Menubar accepts a menuButtons option that allows a list of
# menubuttons to be added to the Menubar. In turn, each menubutton
# accepts a menu option that spec ifies a list of menu entries
# to be added to the menubutton's menu (as well as an option
# set for the menu).   Cascade entries in turn, accept a menu
# option that specifies a list of menu entries to be added to
# the cascade's menu (as well as an option set for the menu). In
# this manner, a complete menu grammar can be expressed to the
# Menubar. Additionally, the Menubar allows each component of
# the Menubar system to be referenced by a simple componentPathName
# syntax. Finally, the Menubar extends the option set of menu
# entries to include the helpStr option used to implement status
# bar help.
#
# WISH LIST:
#   This section lists possible future enhancements.
#
# ----------------------------------------------------------------------
#  AUTHOR: Bill W. Scott                 EMAIL: bscott@spd.dsccc.com
#
#  @(#) $Id: menubar.itk,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1995 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================
 
 
#
# Usual options.
#
itk::usual Menubar {
    keep -activebackground -activeborderwidth -activeforeground \
            -anchor -background -borderwidth -cursor -disabledforeground \
            -font -foreground -highlightbackground -highlightthickness \
            -highlightcolor -justify -padx -pady -wraplength
}
 
class iwidgets::Menubar {
    inherit itk::Widget
 
    constructor { args } {}
 
    itk_option define -foreground foreground Foreground Black
    itk_option define -activebackground activeBackground Foreground "#ececec"
    itk_option define -activeborderwidth activeBorderWidth BorderWidth 2
    itk_option define -activeforeground activeForeground Background black
    itk_option define -anchor anchor Anchor center
    itk_option define -borderwidth borderWidth BorderWidth 2
    itk_option define \
            -disabledforeground disabledForeground DisabledForeground #a3a3a3
    itk_option define \
            -font font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"
    itk_option define \
            -highlightbackground highlightBackground HighlightBackground #d9d9d9
    itk_option define -highlightcolor highlightColor HighlightColor Black
    itk_option define \
            -highlightthickness highlightThickness HighlightThickness 0
    itk_option define -justify justify Justify center
    itk_option define -padx padX Pad 4p
    itk_option define -pady padY Pad 3p
    itk_option define -wraplength wrapLength WrapLength 0
    itk_option define -menubuttons menuButtons MenuButtons {}
    itk_option define -helpvariable helpVariable HelpVariable {}
 
    public {
        method add { type path args } { }
        method delete { args } { }
        method index { path } { }
        method insert { beforeComponent type name args }
        method invoke { entryPath } { }
        method menucget { args } { }
        method menuconfigure { path args } { }
        method path { args } { }
        method type { path } { }
        method yposition { entryPath } { }
 
        method _helpHandler { menuPath } { }
    }
 
    private {
        method menubutton { menuName args } { }
        method options { args } { }
        method command { cmdName args } { }
        method checkbutton { chkName args } { }
        method radiobutton { radName args } { }
        method separator { sepName args } { }
        method cascade { casName args } { }
        method _addMenuButton { buttonName args} { }
        method _insertMenuButton { beforeMenuPath buttonName args} { }
        method _makeMenuButton {buttonName args} { }
        method _makeMenu \
            { componentName widgetName menuPath menuEvalStr } { }
        method _substEvalStr { evalStr } { }
        method _deleteMenu { menuPath {menuPath2 {}} } { }
        method _deleteAMenu { path } { }
        method _addEntry { type path args } { }
        method _addCascade { tkMenuPath path args } { }
        method _insertEntry { beforeEntryPath type name args } { }
        method _insertCascade { bfIndex tkMenuPath path args } { }
        method _deleteEntry { entryPath {entryPath2 {}} } { }
        method _configureMenu { path tkPath {option {}} args } { }
        method _configureMenuOption { type path args } { }
        method _configureMenuEntry { path index {option {}} args } { }
        method _unsetPaths { parent } { }
        method _entryPathToTkMenuPath {entryPath} { }
        method _getTkIndex { tkMenuPath tkIndex} { }
        method _getPdIndex { tkMenuPath tkIndex } { }
        method _getMenuList { } { }
        method _getEntryList { menu } { }
        method _parsePath { path } { }
        method _getSymbolicPath { parent segment } { }
        method _getCallerLevel { }
 
        variable _parseLevel 0        ;# The parse level depth
        variable _callerLevel #0      ;# abs level of caller
        variable _pathMap             ;# Array indexed by Menubar's path
                                      ;# naming, yields tk menu path
        variable _entryIndex -1       ;# current entry help is displayed
                                      ;# for during help  events
 
        variable _tkMenuPath          ;# last tk menu being added to
        variable _ourMenuPath         ;# our last valid path constructed.
 
        variable _menuOption          ;# The -menu option
        variable _helpString          ;# The -helpstr optio
    }
}
 
#
# Use option database to override default resources.
#
option add *Menubar*Menu*tearOff         false        widgetDefault
option add *Menubar*Menubutton*relief    flat         widgetDefault
option add *Menubar*Menu*relief          raised       widgetDefault
 
#
# Provide a lowercase access method for the menubar class
#
proc ::iwidgets::menubar { args } {
    uplevel ::iwidgets::Menubar $args
}
 
# ------------------------------------------------------------------
#                           CONSTRUCTOR
# ------------------------------------------------------------------
body iwidgets::Menubar::constructor { args } {
    component hull configure -borderwidth 0
 
    #
    # Create the Menubar Frame that will hold the menus.
    #
    # might want to make -relief and -bd options with defaults
    itk_component add menubar {
        frame $itk_interior.menubar -relief raised -bd 2
    } {
        keep -cursor -background -width -height
    }
    pack $itk_component(menubar) -fill both -expand yes
 
    # Map our pathname to class to the actual menubar frame
    set _pathMap(.) $itk_component(menubar)
 
    eval itk_initialize $args
 
    #
    # HACK HACK HACK
    # Tk expects some variables to be defined and due to some
    # unknown reason we confuse its normal ordering. So, if
    # the user creates a menubutton with no menu it will fail
    # when clicked on with a "Error: can't read $tkPriv(oldGrab):
    # no such element in array". So by setting it to null we
    # avoid this error.
    uplevel #0 "set tkPriv(oldGrab) {}"
 
}
 
# ------------------------------------------------------------------
#                           OPTIONS
# ------------------------------------------------------------------
# This first set of options are for configuring menus and/or menubuttons
# at the menu level.
#
# ------------------------------------------------------------------
# OPTION -foreground
#
# menu
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::foreground {
}
 
# ------------------------------------------------------------------
# OPTION -activebackground
#
# menu
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::activebackground {
}
 
# ------------------------------------------------------------------
# OPTION -activeborderwidth
#
# menu
# ------------------------------------------------------------------
configbody iwidgets::Menubar::activeborderwidth {
}
 
# ------------------------------------------------------------------
# OPTION -activeforeground
#
# menu
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::activeforeground {
}
 
# ------------------------------------------------------------------
# OPTION -anchor
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::anchor {
}
 
# ------------------------------------------------------------------
# OPTION -borderwidth
#
# menu
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::borderwidth {
}
 
# ------------------------------------------------------------------
# OPTION -disabledforeground
#
# menu
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::disabledforeground {
}
 
# ------------------------------------------------------------------
# OPTION -font
#
# menu
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::font {
}
 
# ------------------------------------------------------------------
# OPTION -highlightbackground
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::highlightbackground {
}
 
# ------------------------------------------------------------------
# OPTION -highlightcolor
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::highlightcolor {
}
 
# ------------------------------------------------------------------
# OPTION -highlightthickness
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::highlightthickness {
}
 
# ------------------------------------------------------------------
# OPTION -justify
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::justify {
}
 
# ------------------------------------------------------------------
# OPTION -padx
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::padx {
}
 
# ------------------------------------------------------------------
# OPTION -pady
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::pady {
}
 
# ------------------------------------------------------------------
# OPTION -wraplength
#
# menubutton
# ------------------------------------------------------------------
configbody iwidgets::Menubar::wraplength {
}
 
# ------------------------------------------------------------------
# OPTION -menubuttons
#
# The menuButton option is a string which specifies the arrangement
# of menubuttons on the Menubar frame. Each menubutton entry is
# delimited by the newline character. Each entry is treated as
# an add command to the Menubar.
#
# ------------------------------------------------------------------
configbody iwidgets::Menubar::menubuttons {
    if { $itk_option(-menubuttons) != {} } {
 
        # IF one exists already, delete the old one and create
        # a new one
        if { ! [catch {_parsePath .0}] } {
            delete .0 .last
        }
 
        #
        # Determine the context level to evaluate the option string at
        #
        set _callerLevel [_getCallerLevel]
 
        #
        # Parse the option string in their scope, then execute it in
        # our scope.
        #
        incr _parseLevel
        _substEvalStr itk_option(-menubuttons)
        eval $itk_option(-menubuttons)
 
        # reset so that we know we aren't parsing in a scope currently.
        incr _parseLevel -1
    }
}
 
# ------------------------------------------------------------------
# OPTION -helpvariable
#
# Specifies the global variable to update whenever the mouse is in
# motion over a menu entry. This global variable is updated with the
# current value of the active menu entry's helpStr. Other widgets
# can "watch" this variable with the trace command, or as is the
# case with entry or label widgets, they can set their textVariable
# to the same global variable. This allows for a simple implementation
# of a help status bar. Whenever the mouse leaves a menu entry,
# the helpVariable is set to the empty string {}.
# ------------------------------------------------------------------
configbody iwidgets::Menubar::helpvariable {
    if {"" != $itk_option(-helpvariable) &&
        ![string match ::* $itk_option(-helpvariable)] &&
        ![string match @itcl* $itk_option(-helpvariable)]} {
        set itk_option(-helpvariable) "::$itk_option(-helpvariable)"
    }
}
 
 
# -------------------------------------------------------------
#
# METHOD: add type path args
#
# Adds either a menu to the menu bar or a menu entry to a
# menu pane.
#
# If the type is one of  cascade,  checkbutton,  command,
# radiobutton,  or separator it adds a new entry to the bottom
# of the menu denoted by the menuPath prefix of componentPath-
# Name.  The  new entry's type is given by type. If additional
# arguments are present, they  specify  options  available  to
# component  type  Entry. See the man pages for menu(n) in the
# section on Entries. In addition all entries accept an  added
# option, helpStr:
#
#     -helpstr value
#
# Specifes the string to associate with  the  entry.
# When the mouse moves over the associated entry, the variable
# denoted by helpVariable is set. Another widget can  bind  to
# the helpVariable and thus display status help.
#
# If the type is menubutton, it adds a new  menubut-
# ton  to  the  menu bar. If additional arguments are present,
# they specify options available to component type MenuButton.
#
# If the type is menubutton  or  cascade,  the  menu
# option  is  available  in  addition to normal Tk options for
# these to types.
#
#      -menu menuSpec
#
# This is only valid for componentPathNames of  type
# menubutton  or  cascade. Specifes an option set and/or a set
# of entries to place on a menu and associate with  the  menu-
# button or cascade. The option keyword allows the menu widget
# to be configured. Each item in the menuSpec  is  treated  as
# add  commands  (each  with  the  possibility of having other
# -menu options). In this way a menu can be recursively built.
#
# The last segment of  componentPathName  cannot  be
# one  of  the  keywords last, menu, end. Additionally, it may
# not be a number. However the componentPathName may be refer-
# enced  in  this  manner  (see  discussion  of Component Path
# Names).
#
# -------------------------------------------------------------
body iwidgets::Menubar::add { type path args } {
    if ![regexp \
            {^(menubutton|command|cascade|separator|radiobutton|checkbutton)$} \
            $type] {
        error "bad type \"$type\": must be one of the following:\
            \"command\", \"checkbutton\", \"radiobutton\",\
            \"separator\", \"cascade\", or \"menubutton\""
    }
    regexp {[^.]+$} $path segName
    if [regexp {^(menu|last|end|[0-9]+)$} $segName] {
        error "bad name \"$segName\": user created component \
                path names may not end with \
                \"end\", \"last\", \"menu\", \
                or be an integer"
    }
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # OK, either add a menu
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { $type == "menubutton" } {
        # grab the last component name (the menu name)
        eval _addMenuButton $segName $args
        # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
        # Or add an entry
        # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    } else {
        eval _addEntry $type $path $args
    }
}
 
 
# -------------------------------------------------------------
#
# METHOD: delete entryPath ?entryPath2?
#
# If componentPathName is of component type MenuButton or
# Menu,  delete  operates  on menus. If componentPathName is of
# component type Entry, delete operates on menu entries.
#
# This  command  deletes  all  components  between   com-
# ponentPathName  and  componentPathName2  inclusive.  If com-
# ponentPathName2  is  omitted  then  it  defaults   to   com-
# ponentPathName. Returns an empty string.
#
# If componentPathName is of type Menubar, then all menus
# and  the menu bar frame will be destroyed. In this case com-
# ponentPathName2 is ignored.
#
# -------------------------------------------------------------
body iwidgets::Menubar::delete { args } {
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Handle out of bounds in arg lengths
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { [llength $args] > 0 && [llength $args] <=2 } {
 
        # Path Conversions
        # '''''''''''''''''''''''''''''''''''''''''''''''''''''
        set path [_parsePath [lindex $args 0]]
 
        set pathOrIndex $_pathMap($path)
 
        # Menu Entry
        # '''''''''''''''''''''''''''''''''''''''''''''''''''''
        if { [regexp {^[0-9]+$} $pathOrIndex] } {
            eval "_deleteEntry $args"
 
            # Menu
            # '''''''''''''''''''''''''''''''''''''''''''''''''''''
        } else {
            eval "_deleteMenu $args"
        }
    } else {
        error "wrong # args: should be \
                \"$itk_component(hull) delete pathName ?pathName2?\""
    }
    return ""
}
 
# -------------------------------------------------------------
#
# METHOD: index path
#
# If componentPathName is of type menubutton or menu,  it
# returns  the  position of the menu/menubutton on the Menubar
# frame.
#
# If componentPathName is  of  type  command,  separator,
# radiobutton,  checkbutton,  or  cascade, it returns the menu
# widget's numerical index for the entry corresponding to com-
# ponentPathName. If path is not found or the Menubar frame is
# passed in, -1 is returned.
#
# -------------------------------------------------------------
body iwidgets::Menubar::index { path } {
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Path conversions
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { [catch {set fullPath [_parsePath $path]} ] } {
        return -1
    }
    if { [catch {set tkPathOrIndex $_pathMap($fullPath)} ] } {
        return -1
    }
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # If integer, return the value, otherwise look up the menu position
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { [regexp {^[0-9]+$} $tkPathOrIndex] } {
        set index $tkPathOrIndex
    } else {
        set index [lsearch [_getMenuList] $fullPath]
    }
 
    return $index
}
 
# -------------------------------------------------------------
#
# METHOD: insert beforeComponent type name ?option value?
#
# Insert a new component named name before the  component
# specified by componentPathName.
#
# If componentPathName is of type MenuButton or Menu, the
# new  component  inserted  is of type Menu and given the name
# name. In this  case  valid  option  value  pairs  are  those
# accepted by menubuttons.
#
# If componentPathName is of type  Entry,  the  new  com-
# ponent inserted is of type Entry and given the name name. In
# this case valid option value pairs  are  those  accepted  by
# menu entries.
#
# name cannot be one of the  keywords  last,  menu,  end.
# dditionally,  it  may  not  be  a  number. However the com-
# ponentPathName may be referenced in this manner (see discus-
# sion of Component Path Names).
#
# Returns -1 if the menubar frame is passed in.
#
# -------------------------------------------------------------
body iwidgets::Menubar::insert { beforeComponent type name args } {
     if ![regexp \
            {^(menubutton|command|cascade|separator|radiobutton|checkbutton)$} \
            $type] {
        error "bad type \"$type\": must be one of the following:\
                \"command\", \"checkbutton\", \"radiobutton\",\
                \"separator\", \"cascade\", or \"menubutton\""
    }
    regexp {[^.]+$} $name segName
    if [regexp {^(menu|last|end|[0-9]+)$} $segName] {
        error "bad name \"$name\": user created component \
                path names may not end with \
                \"end\", \"last\", \"menu\", \
                or be an integer"
    }
 
    set beforeComponent [_parsePath $beforeComponent]
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Choose menu insertion or entry insertion
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { $type == "menubutton" } {
        eval _insertMenuButton $beforeComponent $name $args
    } else {
        eval _insertEntry $beforeComponent $type $name $args
    }
}
 
 
# -------------------------------------------------------------
#
# METHOD: invoke entryPath
#
# Invoke  the  action  of  the  menu  entry  denoted   by
# entryComponentPathName.  See  the sections on the individual
# entries in the menu(n) man pages. If the menu entry is  dis-
# abled  then  nothing  happens.  If  the  entry has a command
# associated with it  then  the  result  of  that  command  is
# returned  as the result of the invoke widget command. Other-
# wise the result is an empty string.
#
# If componentPathName is not a menu entry, an  error  is
# issued.
#
# -------------------------------------------------------------
body iwidgets::Menubar::invoke { entryPath } {
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Path Conversions
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    set entryPath [_parsePath $entryPath]
    set index $_pathMap($entryPath)
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Error Processing
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    # first verify that beforeEntryPath is actually a path to
    # an entry and not to menu, menubutton, etc.
    if { ! [regexp {^[0-9]+$} $index] } {
        error "bad entry path: beforeEntryPath is not an entry"
    }
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Call invoke command
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    # get the tk menu path to call
    set tkMenuPath [_entryPathToTkMenuPath $entryPath]
 
    # call the menu's invoke command, adjusting index based on tearoff
    $tkMenuPath invoke [_getTkIndex $tkMenuPath $index]
}
 
# -------------------------------------------------------------
#
# METHOD: menucget componentPath option
#
# Returns the current value of the  configuration  option
# given  by  option.  The  component type of componentPathName
# determines the valid available options.
#
# -------------------------------------------------------------
body iwidgets::Menubar::menucget { path opt } {
    return [lindex [menuconfigure $path $opt] 4]
}
 
# -------------------------------------------------------------
#
# METHOD: menuconfigure componentPath ?option? ?value option value...?
#
# Query or modify the configuration options of  the  sub-
# component  of the Menubar specified by componentPathName. If
# no option is specified, returns a list describing all of the
# available     options     for     componentPathName     (see
# Tk_ConfigureInfo for  information  on  the  format  of  this
# list).  If  option is specified with no value, then the com-
# mand returns a list describing the one  named  option  (this
# list  will  be identical to the corresponding sublist of the
# value returned if no option is specified). If  one  or  more
# option-value  pairs are specified, then the command modifies
# the given widget option(s) to have the  given  value(s);  in
# this case the command returns an empty string. The component
# type of componentPathName  determines  the  valid  available
# options.
#
# -------------------------------------------------------------
body iwidgets::Menubar::menuconfigure { path args } {
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Path Conversions
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    set path [_parsePath $path]
    set tkPathOrIndex $_pathMap($path)
 
    # Case: Menu entry being configured
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { [regexp {^[0-9]+$} $tkPathOrIndex] } {
        eval "_configureMenuEntry $path $tkPathOrIndex $args"
 
        # Case: Menu (button and pane) being configured.
        # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    } else {
        eval _configureMenu $path $tkPathOrIndex $args
    }
}
 
# -------------------------------------------------------------
#
# METHOD: path
#
# SYNOPIS: path ?? 
#
# Returns a fully formed component path that matches pat-
# tern.  If no match is found it returns -1. The mode argument
# indicates how the search is to be  matched  against  pattern
# and it must have one of the following values:
#
#     -glob     Pattern is a glob-style pattern which is
#       matched  against each component path using the same rules as
#       the string match command.
#
#     -regexp   Pattern is treated as a regular  expression
#       and matched against each component path using the same
#       rules as the regexp command.
#
# The default mode is -glob.
#
# -------------------------------------------------------------
body iwidgets::Menubar::path { args } {
 
    set len [llength $args]
    if { $len < 1 || $len > 2 } {
        error "wrong # args: should be \
                \"$itk_component(hull) path ?mode?> \""
    }
 
    set pathList [array names _pathMap]
 
    set len [llength $args]
    switch -- $len {
        1 {
            # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            # Case: no search modes given
            # '''''''''''''''''''''''''''''''''''''''''''''''''''''
            set pattern [lindex $args 0]
            set found [lindex $pathList [lsearch -glob $pathList $pattern]]
        }
        2 {
            # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            # Case: search modes present (-glob, -regexp)
            # '''''''''''''''''''''''''''''''''''''''''''''''''''''
            set options [lindex $args 0]
            set pattern [lindex $args 1]
            set found \
                    [lindex $pathList [lsearch $options $pathList $pattern]]
        }
        default {
            # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
            # Case: wrong # arguments
            # '''''''''''''''''''''''''''''''''''''''''''''''''''''
            error "wrong # args: \
                    should be \"$itk_component(hull) path ?-glob? ?-regexp? pattern\""
        }
    }
 
    return $found
}
 
# -------------------------------------------------------------
#
# METHOD: type path
#
# Returns the type of the component  given  by  entryCom-
# ponentPathName.  For menu entries, this is the type argument
# passed to the add/insert widget command when the  entry  was
# created, such as command or separator. Othewise it is either
# a menubutton or a menu.
#
# -------------------------------------------------------------
body iwidgets::Menubar::type { path } {
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Path Conversions
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    set path [_parsePath $path]
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Error Handling: does the path exist?
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { [catch {set index $_pathMap($path)} ] } {
        error "bad path \"$path\""
    }
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # ENTRY, Ask TK for type
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    if { [regexp {^[0-9]+$} $index] } {
        # get the menu path from the entry path name
        set tkMenuPath [_entryPathToTkMenuPath $path]
 
        # call the menu's type command, adjusting index based on tearoff
        set type [$tkMenuPath type [_getTkIndex $tkMenuPath $index]]
        # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
        # MENUBUTTON, MENU, or FRAME
        # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    } else {
        # should not happen, but have a path that is not a valid window.
        if { [catch {set className [winfo class $_pathMap($path)]}] } {
            error "serious error: \"$path\" is not a valid window"
        }
        # get the classname, look it up, get index, us it to look up type
        set type [ lindex \
                {frame menubutton menu} \
                [lsearch { Frame Menubutton Menu } $className] \
                ]
    }
    return $type
}
 
# -------------------------------------------------------------
#
# METHOD: yposition entryPath
#
# Returns a decimal string giving the y-coordinate within
# the  menu window of the topmost pixel in the entry specified
# by componentPathName. If the  componentPathName  is  not  an
# entry, an error is issued.
#
# -------------------------------------------------------------
body iwidgets::Menubar::yposition { entryPath } {
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Path Conversions
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    set entryPath [_parsePath $entryPath]
    set index $_pathMap($entryPath)
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Error Handling
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    # first verify that entryPath is actually a path to
    # an entry and not to menu, menubutton, etc.
    if { ! [regexp {^[0-9]+$} $index] } {
        error "bad value: entryPath is not an entry"
    }
 
    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Call yposition command
    # '''''''''''''''''''''''''''''''''''''''''''''''''''''
    # get the menu path from the entry path name
    set tkMenuPath [_entryPathToTkMenuPath $entryPath]
 
    # call the menu's yposition command, adjusting index based on tearoff
    return [$tkMenuPath yposition [_getTkIndex $tkMenuPath $index]]
 
}
 
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# PARSING METHODS
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
#
# PARSING METHOD: menubutton
#
# This method is invoked via an evaluation of the -menubuttons
# option for the Menubar.
#
# It adds a new menubutton and processes any -menu options
# for creating entries on the menu pane associated with the
# menubutton
# -------------------------------------------------------------
body iwidgets::Menubar::menubutton { menuName args } {
    eval "add menubutton .$menuName $args"
}
 
# -------------------------------------------------------------
#
# PARSING METHOD: options
#
# This method is invoked via an evaluation of the -menu
# option for menubutton commands.
#
# It configures the current menu ($_ourMenuPath) with the options
# that follow (args)
#
# -------------------------------------------------------------
body iwidgets::Menubar::options { args } {
    eval "$_tkMenuPath configure $args"
}
 
 
# -------------------------------------------------------------
#
# PARSING METHOD: command
#
# This method is invoked via an evaluation of the -menu
# option for menubutton commands.
#
# It adds a new command entry to the current menu, $_ourMenuPath
# naming it $cmdName. Since this is the most common case when
# creating menus, streamline it by duplicating some code from
# the add{} method.
#
# -------------------------------------------------------------
body iwidgets::Menubar::command { cmdName args } {
    set path $_ourMenuPath.$cmdName
 
    # error checking
    regsub {.*[.]} $path "" segName
    if [regexp {^(menu|last|end|[0-9]+)$} $segName] {
        error "bad name \"$segName\": user created component \
                path names may not end with \
                \"end\", \"last\", \"menu\", \
                or be an integer"
    }
 
    eval _addEntry command $path $args
}
 
# -------------------------------------------------------------
#
# PARSING METHOD: checkbutton
#
# This method is invoked via an evaluation of the -menu
# option for menubutton/cascade commands.
#
# It adds a new checkbutton entry to the current menu, $_ourMenuPath
# naming it $chkName.
#
# -------------------------------------------------------------
body iwidgets::Menubar::checkbutton { chkName args } {
    eval "add checkbutton $_ourMenuPath.$chkName $args"
}
 
# -------------------------------------------------------------
#
# PARSING METHOD: radiobutton
#
# This method is invoked via an evaluation of the -menu
# option for menubutton/cascade commands.
#
# It adds a new radiobutton entry to the current menu, $_ourMenuPath
# naming it $radName.
#
# -------------------------------------------------------------
body iwidgets::Menubar::radiobutton { radName args } {
    eval "add radiobutton $_ourMenuPath.$radName $args"
}
 
# -------------------------------------------------------------
#
# PARSING METHOD: separator
#
# This method is invoked via an evaluation of the -menu
# option for menubutton/cascade commands.
#
# It adds a new separator entry to the current menu, $_ourMenuPath
# naming it $sepName.
#
# -------------------------------------------------------------
body iwidgets::Menubar::separator { sepName args } {
    eval $_tkMenuPath add separator
    set _pathMap($_ourMenuPath.$sepName) [_getPdIndex $_tkMenuPath end]
}
 
# -------------------------------------------------------------
#
# PARSING METHOD: cascade
#
# This method is invoked via an evaluation of the -menu
# option for menubutton/cascade commands.
#
# It adds a new cascade entry to the current menu, $_ourMenuPath
# naming it $casName. It processes the -menu option if present,
# adding a new menu pane and its associated entries found.
#
# -------------------------------------------------------------
body iwidgets::Menubar::cascade { casName args } {
 
    # Save the current menu we are adding to, cascade can change
    # the current menu through -menu options.
    set saveOMP $_ourMenuPath
    set saveTKP $_tkMenuPath
 
    eval "add cascade $_ourMenuPath.$casName $args"
 
    # Restore the saved menu states so that the next entries of
    # the -menu/-menubuttons we are processing will be at correct level.
    set _ourMenuPath $saveOMP
    set _tkMenuPath $saveTKP
}
 
# ... A P I   S U P P O R T   M E T H O D S...
 
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# MENU ADD, INSERT, DELETE
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
#
# PRIVATE METHOD: _addMenuButton
#
# Makes a new menubutton & associated -menu, pack appended
#
# -------------------------------------------------------------
body iwidgets::Menubar::_addMenuButton { buttonName args} {
 
    eval "_makeMenuButton $buttonName $args"
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Pack at end, adjust for help buttonName
    # ''''''''''''''''''''''''''''''''''
    if { $buttonName == "help" } {
        pack $itk_component($buttonName) -side right
    } else {
        pack $itk_component($buttonName) -side left
    }
 
    return $itk_component($buttonName)
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _insertMenuButton
#
# inserts a menubutton named $buttonName on a menu bar before
# another menubutton specified by $beforeMenuPath
#
# -------------------------------------------------------------
body iwidgets::Menubar::_insertMenuButton { beforeMenuPath buttonName args} {
 
    eval "_makeMenuButton $buttonName $args"
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Pack before the $beforeMenuPath
    # ''''''''''''''''''''''''''''''''
    set beforeTkMenu $_pathMap($beforeMenuPath)
    regsub {[.]menu$} $beforeTkMenu "" beforeTkMenu
    pack $itk_component(menubar).$buttonName \
            -side left \
            -before $beforeTkMenu
 
    return $itk_component($buttonName)
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _makeMenuButton
#
# creates a menubutton named buttonName on the menubar with args.
# The -menu option if present will trigger attaching a menu pane.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_makeMenuButton {buttonName args} {
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Capture the -menu option if present
    # '''''''''''''''''''''''''''''''''''
    array set temp $args
    if { [::info exists temp(-menu)] } {
        # We only keep this in case of menuconfigure or menucget
        set _menuOption(.$buttonName) $temp(-menu)
        set menuEvalStr $temp(-menu)
    } else {
        set menuEvalStr {}
    }
 
    # attach the actual menu widget to the menubutton's arg list
    set temp(-menu) $itk_component(menubar).$buttonName.menu
    set args [array get temp]
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Create menubutton component
    # ''''''''''''''''''''''''''''''''
    itk_component add $buttonName {
        eval ::menubutton \
                $itk_component(menubar).$buttonName \
                $args
    } {
        keep \
                -activebackground \
                -activeforeground \
                -anchor \
                -background \
                -borderwidth \
                -cursor \
                -disabledforeground \
                -font \
                -foreground \
                -highlightbackground \
                -highlightcolor \
                -highlightthickness \
                -justify \
                -padx \
                -pady \
                -wraplength
    }
 
    set _pathMap(.$buttonName) $itk_component($buttonName)
 
    _makeMenu \
            $buttonName-menu \
            $itk_component($buttonName).menu \
            .$buttonName \
            $menuEvalStr
 
    return $itk_component($buttonName)
 
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _makeMenu
#
# Creates a menu.
# It then evaluates the $menuEvalStr to create entries on the menu.
#
# Assumes the existence of $itk_component($buttonName)
#
# -------------------------------------------------------------
body iwidgets::Menubar::_makeMenu \
        { componentName widgetName menuPath menuEvalStr } {
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Create menu component
    # ''''''''''''''''''''''''''''''''
    itk_component add $componentName {
        ::menu $widgetName
    } {
        keep \
                -activebackground \
                -activeborderwidth \
                -activeforeground \
                -background \
                -borderwidth \
                -cursor \
                -disabledforeground \
                -font \
                -foreground
    }
 
    set _pathMap($menuPath.menu) $itk_component($componentName)
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Attach help handler to this menu
    # ''''''''''''''''''''''''''''''''
    bind $itk_component($componentName) <> \
            [code $this _helpHandler $menuPath.menu]
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Handle -menu
    #'''''''''''''''''''''''''''''''''
    set _ourMenuPath $menuPath
    set _tkMenuPath $itk_component($componentName)
 
    #
    # A zero parseLevel says we are at the top of the parse tree,
    # so get the context scope level and do a subst for the menuEvalStr.
    #
    if { $_parseLevel == 0 } {
        set _callerLevel [_getCallerLevel]
    }
 
    #
    # bump up the parse level, so if we get called via the 'eval $menuEvalStr'
    # we know to skip the above steps...
    #
    incr _parseLevel
    eval $menuEvalStr
 
    #
    # leaving, so done with this parse level, so bump it back down
    #
    incr _parseLevel -1
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _substEvalStr
#
# This performs the substitution and evaluation of $ [], \ found
# in the -menubutton/-menus options
#
# -------------------------------------------------------------
body iwidgets::Menubar::_substEvalStr { evalStr } {
    upvar $evalStr evalStrRef
    set evalStrRef [uplevel $_callerLevel [list subst $evalStrRef]]
}
 
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _deleteMenu
#
# _deleteMenu menuPath ?menuPath2?
#
# deletes menuPath or from menuPath to menuPath2
#
# Menu paths may be formed in one of two ways
#       .MENUBAR.menuName  where menuName is the name of the menu
#       .MENUBAR.menuName.menu  where menuName is the name of the menu
#
# The basic rule is '.menu' is not needed.
# -------------------------------------------------------------
body iwidgets::Menubar::_deleteMenu { menuPath {menuPath2 {}} } {
 
    if { $menuPath2 == "" } {
        # get a corrected path (subst for number, last, end)
        set path [_parsePath $menuPath]
 
        _deleteAMenu $path
 
    } else {
        # gets the list of menus in interface order
        set menuList [_getMenuList]
 
        # ... get the start menu and the last menu ...
 
        # get a corrected path (subst for number, last, end)
        set menuStartPath [_parsePath $menuPath]
 
        regsub {[.]menu$} $menuStartPath "" menuStartPath
 
        set menuEndPath [_parsePath $menuPath2]
 
        regsub {[.]menu$} $menuEndPath "" menuEndPath
 
        # get the menu position (0 based) of the start and end menus.
        set start [lsearch -exact $menuList $menuStartPath]
        if { $start == -1 } {
            error "bad menu path \"$menuStartPath\": \
                    should be one of $menuList"
        }
        set end [lsearch -exact $menuList $menuEndPath]
        if { $end == -1 } {
            error "bad menu path \"$menuEndPath\": \
                    should be one of $menuList"
        }
 
        # now create the list from this range of menus
        set delList [lrange $menuList $start $end]
 
        # walk thru them deleting each menu.
        # this list has no .menu on the end.
        foreach m $delList {
            _deleteAMenu $m.menu
        }
    }
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _deleteAMenu
#
# _deleteMenu menuPath
#
# deletes a single Menu (menubutton and menu pane with entries)
#
# -------------------------------------------------------------
body iwidgets::Menubar::_deleteAMenu { path } {
 
    # We will normalize the path to not include the '.menu' if
    # it is on the path already.
 
    regsub {[.]menu$} $path "" menuButtonPath
    regsub {.*[.]} $menuButtonPath "" buttonName
 
    # Loop through and destroy any cascades, etc on menu.
    set entryList [_getEntryList $menuButtonPath]
    foreach entry $entryList {
        _deleteEntry $entry
    }
 
    # Delete the menubutton and menu components...
    destroy $itk_component($buttonName-menu)
    destroy $itk_component($buttonName)
 
    # This is because of some itcl bug that doesn't delete
    # the component on the destroy in some cases...
    catch {itk_component delete $buttonName-menu}
    catch {itk_component delete $buttonName}
 
    # unset our paths
    _unsetPaths $menuButtonPath
 
}
 
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ENTRY ADD, INSERT, DELETE
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _addEntry
#
# Adds an entry to menu.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_addEntry { type path args } {
 
    # Error Checking
    # ''''''''''''''
    # the path should not end with '.menu'
    # Not needed -- already checked by add{}
    # if { [regexp {[.]menu$} $path] } {
    #  error "bad entry path: \"$path\". \
    #           The name \"menu\" is reserved for menu panes"
    # }
 
    # get the tkMenuPath
    set tkMenuPath [_entryPathToTkMenuPath $path]
    if { $tkMenuPath == "" } {
        error "bad entry path: \"$path\". The menu path prefix is not valid"
    }
 
    # get the -helpstr option if present
    array set temp $args
    if { [::info exists temp(-helpstr)] } {
        set helpStr $temp(-helpstr)
        unset temp(-helpstr)
    } else {
        set helpStr {}
    }
    set args [array get temp]
 
    # Handle CASCADE
    # ''''''''''''''
    # if this is a cascade go ahead and add in the menu...
    if { $type == "cascade" } {
        eval [list _addCascade $tkMenuPath $path] $args
        # Handle Non-CASCADE
        # ''''''''''''''''''
    } else {
        # add the entry
        eval [list $tkMenuPath add $type] $args
        set _pathMap($path) [_getPdIndex $tkMenuPath end]
    }
 
    # Remember the help string
    set _helpString($path) $helpStr
 
    return $_pathMap($path)
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _addCascade
#
# Creates a cascade button.  Handles the -menu option
#
# -------------------------------------------------------------
body iwidgets::Menubar::_addCascade { tkMenuPath path args } {
 
    # get the cascade name from our path
    regsub {.*[.]} $path "" cascadeName
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Capture the -menu option if present
    # '''''''''''''''''''''''''''''''''''
    array set temp $args
    if { [::info exists temp(-menu)] } {
        set menuEvalStr $temp(-menu)
    } else {
        set menuEvalStr {}
    }
 
    # attach the menu pane
    set temp(-menu) $tkMenuPath.$cascadeName
    set args [array get temp]
 
    # Create the cascade entry
    eval $tkMenuPath add cascade $args
 
    # Keep the -menu string in case of menuconfigure or menucget
    if { $menuEvalStr != "" } {
        set _menuOption($path) $menuEvalStr
    }
 
    # update our pathmap
    set _pathMap($path) [_getPdIndex $tkMenuPath end]
 
    _makeMenu \
            $cascadeName-menu \
            $tkMenuPath.$cascadeName \
            $path \
            $menuEvalStr
 
    #return $itk_component($cascadeName)
 
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _insertEntry
#
# inserts an entry on a menu before entry given by beforeEntryPath.
# The added entry is of type TYPE and its name is NAME. ARGS are
# passed for customization of the entry.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_insertEntry { beforeEntryPath type name args } {
 
    # convert entryPath to an index value
    set bfIndex $_pathMap($beforeEntryPath)
 
    # first verify that beforeEntryPath is actually a path to
    # an entry and not to menu, menubutton, etc.
    if { ! [regexp {^[0-9]+$} $bfIndex] } {
        error "bad entry path: beforeEntryPath is not an entry"
    }
 
    # get the menu path from the entry path name
    regsub {[.][^.]*$} $beforeEntryPath "" menuPathPrefix
    set tkMenuPath $_pathMap($menuPathPrefix.menu)
 
    # INDEX is zero based at this point.
 
    # ENTRIES is a zero based list...
    set entries [_getEntryList $menuPathPrefix]
 
    #
    # Adjust the entries after the inserted item, to have
    # the correct index numbers. Note, we stay zero based
    # even though tk flips back and forth depending on tearoffs.
    #
    for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
        # path==entry path in numerical order
        set path [lindex $entries $i]
 
        # add one to each entry after the inserted one.
        set _pathMap($path) [expr $i + 1]
    }
 
    # get the -helpstr option if present
    array set temp $args
    if { [::info exists temp(-helpstr)] } {
        set helpStr $temp(-helpstr)
        unset temp(-helpstr)
    } else {
        set helpStr {}
    }
    set args [array get temp]
 
    set path $menuPathPrefix.$name
 
    # Handle CASCADE
    # ''''''''''''''
    # if this is a cascade go ahead and add in the menu...
    if { [string match cascade $type] } {
 
        if { [ catch {eval "_insertCascade \
                $bfIndex $tkMenuPath $path $args"} errMsg ]} {
            for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
                # path==entry path in numerical order
                set path [lindex $entries $i]
 
                # sub the one we added earlier.
                set _pathMap($path) [expr $_pathMap($path) - 1]
                # @@ delete $hs
            }
            error $errMsg
        }
 
        # Handle Entry
        # ''''''''''''''
    } else {
 
        # give us a zero or 1-based index based on tear-off menu status
        # invoke the menu's insert command
        if { [catch {eval "$tkMenuPath insert \
                [_getTkIndex $tkMenuPath $bfIndex] $type $args"} errMsg]} {
            for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
                # path==entry path in numerical order
                set path [lindex $entries $i]
 
                # sub the one we added earlier.
                set _pathMap($path) [expr $_pathMap($path) - 1]
                # @@ delete $hs
            }
            error $errMsg
        }
 
 
        # add the helpstr option to our options list (attach to entry)
        set _helpString($path) $helpStr
 
        # Insert the new entry path into pathmap giving it an index value
        set _pathMap($menuPathPrefix.$name) $bfIndex
 
    }
 
    return [_getTkIndex $tkMenuPath $bfIndex]
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _insertCascade
#
# Creates a cascade button.  Handles the -menu option
#
# -------------------------------------------------------------
body iwidgets::Menubar::_insertCascade { bfIndex tkMenuPath path args } {
 
    # get the cascade name from our path
    regsub {.*[.]} $path "" cascadeName
 
    #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    # Capture the -menu option if present
    # '''''''''''''''''''''''''''''''''''
    array set temp $args
    if { [::info exists temp(-menu)] } {
        # Keep the -menu string in case of menuconfigure or menucget
        set _menuOption($path) $temp(-menu)
        set menuEvalStr $temp(-menu)
    } else {
        set menuEvalStr {}
    }
 
    # attach the menu pane
    set temp(-menu) $tkMenuPath.$cascadeName
    set args [array get temp]
 
    # give us a zero or 1-based index based on tear-off menu status
    # invoke the menu's insert command
    eval "$tkMenuPath insert \
            [_getTkIndex $tkMenuPath $bfIndex] cascade $args"
 
    # Insert the new entry path into pathmap giving it an index value
    set _pathMap($path) $bfIndex
    _makeMenu \
            $cascadeName-menu \
            $tkMenuPath.$cascadeName \
            $path \
            $menuEvalStr
 
    #return $itk_component($cascadeName)
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _deleteEntry
#
# _deleteEntry entryPath ?entryPath2?
#
#   either
# deletes the entry entryPath
#   or
# deletes the entries from entryPath to entryPath2
#
# -------------------------------------------------------------
body iwidgets::Menubar::_deleteEntry { entryPath {entryPath2 {}} } {
 
    if { $entryPath2 == "" } {
        # get a corrected path (subst for number, last, end)
        set path [_parsePath $entryPath]
 
        set entryIndex $_pathMap($path)
        if { $entryIndex == -1 } {
            error "bad value for pathName: \
                    $entryPath in call to delet"
        }
 
        # get the type, if cascade, we will want to delete menu
        set type [type $path]
 
        # ... munge up the menu name ...
 
        # the tkMenuPath is looked up with the .menu added to lookup
        # strip off the entry component
        regsub {[.][^.]*$} $path "" menuPath
        set tkMenuPath $_pathMap($menuPath.menu)
 
        # get the ordered entry list
        set entries [_getEntryList $menuPath]
 
        # ... Fix up path entry indices ...
 
        # delete the path from the map
        unset _pathMap([lindex $entries $entryIndex])
 
        # Subtract off 1 for each entry below the deleted one.
        for {set i [expr $entryIndex + 1]} \
                {$i < [llength $entries]} \
                {incr i} {
            set epath [lindex $entries $i]
            incr _pathMap($epath) -1
        }
 
        # ... Delete the menu entry widget ...
 
        # delete the menu entry, ajusting index for TK
        $tkMenuPath delete [_getTkIndex $tkMenuPath $entryIndex]
 
        if { $type == "cascade" } {
            regsub {.*[.]} $path "" cascadeName
            destroy $itk_component($cascadeName-menu)
 
            # This is because of some itcl bug that doesn't delete
            # the component on the destroy in some cases...
            catch {itk_component delete $cascadeName-menu}
 
            _unsetPaths $path
        }
 
    } else {
        # get a corrected path (subst for number, last, end)
        set path1 [_parsePath $entryPath]
        set path2 [_parsePath $entryPath2]
 
        set fromEntryIndex $_pathMap($path1)
        if { $fromEntryIndex == -1 } {
            error "bad value for entryPath1: \
                    $entryPath in call to delet"
        }
        set toEntryIndex $_pathMap($path2)
        if { $toEntryIndex == -1 } {
            error "bad value for entryPath2: \
                    $entryPath2 in call to delet"
        }
        # ... munge up the menu name ...
 
        # the tkMenuPath is looked up with the .menu added to lookup
        # strip off the entry component
        regsub {[.][^.]*$} $path1 "" menuPath
        set tkMenuPath $_pathMap($menuPath.menu)
 
        # get the ordered entry list
        set entries [_getEntryList $menuPath]
 
        # ... Fix up path entry indices ...
 
        # delete the range from the pathMap list
        for {set i $fromEntryIndex} {$i <= $toEntryIndex} {incr i} {
            unset _pathMap([lindex $entries $i])
        }
 
        # Subtract off 1 for each entry below the deleted range.
        # Loop from one below the bottom delete entry to end list
        for {set i [expr $toEntryIndex + 1]} \
                {$i < [llength $entries]} \
                {incr i} {
            # take this path and sets its index back by size of
            # deleted range.
            set path [lindex $entries $i]
            set _pathMap($path) \
                    [expr $_pathMap($path) - \
                    (($toEntryIndex - $fromEntryIndex) + 1)]
        }
 
        # ... Delete the menu entry widget ...
 
        # delete the menu entry, ajusting index for TK
        $tkMenuPath delete \
                [_getTkIndex $tkMenuPath $fromEntryIndex] \
                [_getTkIndex $tkMenuPath $toEntryIndex]
 
    }
}
 
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# CONFIGURATION SUPPORT
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# -------------------------------------------------------------
#
# PRIVATE METHOD: _configureMenu
#
# This configures a menu. A menu is a true tk widget, thus we
# pass the tkPath variable. This path may point to either a
# menu button (does not end with the name 'menu', or a menu
# which ends with the name 'menu'
#
# path : our Menubar path name to this menu button or menu pane.
#        if we end with the name '.menu' then it is a menu pane.
# tkPath : the path to the corresponding Tk menubutton or menu.
# args   : the args for configuration
#
# -------------------------------------------------------------
body iwidgets::Menubar::_configureMenu { path tkPath {option {}} args } {
 
    set class [winfo class $tkPath]
 
    if { $option == "" } {
        # No arguments: return all options
        set configList [$tkPath configure]
 
        if { [info exists _menuOption($path)] } {
            lappend configList [list -menu menu Menu {} $_menuOption($path)]
        } else {
            lappend configList [list -menu menu Menu {} {}]
        }
        if { [info exists _helpString($path)] } {
            lappend configList [list -helpstr helpStr HelpStr {} \
                    $_helpString($path)]
        } else {
            lappend configList [list -helpstr helpStr HelpStr {} {}]
        }
        return $configList
 
    } elseif {$args == "" } {
        if { $option == "-menu" } {
            if { [info exists _menuOption($path)] } {
                return [list -menu menu Menu {} $_menuOption($path)]
            } else {
                return [list -menu menu Menu {} {}]
            }
        } elseif { $option == "-helpstr" } {
            if { [info exists _helpString($path)] } {
                return [list -helpstr helpStr HelpStr {} $_helpString($path)]
            } else {
                return [list -helpstr helpStr HelpStr {} {}]
            }
        } else {
            # ... OTHERWISE, let Tk get it.
            return [$tkPath configure $option]
        }
    } else {
        set args [concat $option $args]
 
        # If this is a menubutton, and has -menu option, process it
        if { $class == "Menubutton" && [regexp -- {-menu} $args] } {
            eval _configureMenuOption menubutton $path $args
        } else {
            eval $tkPath configure $args
        }
        return ""
    }
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _configureMenuOption
#
# Allows for configuration of the -menu option on
# menubuttons and cascades
#
# find out if we are the last menu, or are before one.
# delete the old menu.
# if we are the last, then add us back at the end
# if we are before another menu, get the beforePath
#
# -------------------------------------------------------------
body iwidgets::Menubar::_configureMenuOption { type path args } {
 
    regsub {[.][^.]*$} $path "" pathPrefix
 
    if { $type == "menubutton" } {
        set menuList [_getMenuList]
        set pos [lsearch $menuList $path]
        if { $pos == [expr [llength $menuList] - 1] } {
            set insert false
        } else {
            set insert true
        }
    } elseif { $type == "cascade" } {
        set lastEntryPath [_parsePath $pathPrefix.last]
        if { $lastEntryPath == $path } {
            set insert false
        } else {
            set insert true
        }
        set pos [index $path]
 
    }
 
 
    eval "delete $pathPrefix.$pos"
    if { $insert } {
        # get name from path...
        regsub {.*[.]} $path "" name
 
        eval insert $pathPrefix.$pos $type \
                $name $args
    } else {
        eval add $type $path $args
    }
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _configureMenuEntry
#
# This configures a menu entry. A menu entry is either a command,
# radiobutton, separator, checkbutton, or a cascade. These have
# a corresponding Tk index value for the corresponding tk menu
# path.
#
# path   : our Menubar path name to this menu entry.
# index  : the t
# args   : the args for configuration
#
# -------------------------------------------------------------
body iwidgets::Menubar::_configureMenuEntry { path index {option {}} args } {
 
    set type [type $path]
 
    # set len [llength $args]
 
    # get the menu path from the entry path name
    set tkMenuPath [_entryPathToTkMenuPath $path]
 
    if { $option == "" } {
        set configList [$tkMenuPath entryconfigure \
                [_getTkIndex $tkMenuPath $index]]
 
        if { $type == "cascade" } {
            if { [info exists _menuOption($path)] } {
                lappend configList [list -menu menu Menu {} \
                        $_menuOption($path)]
            } else {
                lappend configList [list -menu menu Menu {} {}]
            }
        }
        if { [info exists _helpString($path)] } {
            lappend configList [list -helpstr helpStr HelpStr {} \
                    $_helpString($path)]
        } else {
            lappend configList [list -helpstr helpStr HelpStr {} {}]
        }
        return $configList
 
    } elseif { $args == "" } {
        if { $option == "-menu" } {
            if { [info exists _menuOption($path)] } {
                return [list -menu menu Menu {} $_menuOption($path)]
            } else {
                return [list -menu menu Menu {} {}]
            }
        } elseif { $option == "-helpstr" } {
            if { [info exists _helpString($path)] } {
                return [list -helpstr helpStr HelpStr {} \
                        $_helpString($path)]
            } else {
                return [list -helpstr helpStr HelpStr {} {}]
            }
        } else {
            # ... OTHERWISE, let Tk get it.
            return [$tkMenuPath entryconfigure \
                    [_getTkIndex $tkMenuPath $index] $option]
        }
    } else {
        array set temp [concat $option $args]
 
        # ... Store -helpstr val,strip out -helpstr val from args
        if { [::info exists temp(-helpstr)] } {
            set _helpString($path) $temp(-helpstr)
            unset temp(-helpstr)
        }
 
        set args [array get temp]
        if { $type == "cascade" && [::info exists temp(-menu)] } {
            eval "_configureMenuOption cascade $path $args"
        } else {
            # invoke the menu's entryconfigure command
            # being careful to ajust the INDEX to be 0 or 1 based
            # depending on the tearoff status
            # if the stripping process brought us down to no options
            # to set, then forget the configure of widget.
            if { [llength $args] != 0 } {
                eval $tkMenuPath entryconfigure \
                        [_getTkIndex $tkMenuPath $index] $args
            }
        }
        return ""
    }
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _unsetPaths
#
# comment
#
# -------------------------------------------------------------
body iwidgets::Menubar::_unsetPaths { parent } {
 
    # first get the complete list of all menu paths
    set pathList [array names _pathMap]
 
    # for each path that matches parent prefix, unset it.
    foreach path $pathList {
        if { [regexp [subst -nocommands {^$parent}] $path] } {
            unset _pathMap($path)
        }
    }
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _entryPathToTkMenuPath
#
# Takes an entry path like .mbar.file.new and changes it to
# .mbar.file.menu and performs a lookup in the pathMap to
# get the corresponding menu widget name for tk
#
# -------------------------------------------------------------
body iwidgets::Menubar::_entryPathToTkMenuPath {entryPath} {
 
    # get the menu path from the entry path name
    # by stripping off the entry component of the path
    regsub {[.][^.]*$} $entryPath "" menuPath
 
    # the tkMenuPath is looked up with the .menu added to lookup
    if { [catch {set tkMenuPath $_pathMap($menuPath.menu)}] } {
        return ""
    } else {
        return $_pathMap($menuPath.menu)
    }
}
 
 
# -------------------------------------------------------------
#
# These two methods address the issue of menu entry indices being
# zero-based when the menu is not a tearoff menu and 1-based when
# it is a tearoff menu. Our strategy is to hide this difference.
#
# _getTkIndex returns the index as tk likes it: 0 based for non-tearoff
# and 1 based for tearoff menus.
#
# _getPdIndex (get pulldown index) always returns it as 0 based.
#
# -------------------------------------------------------------
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _getTkIndex
#
# give us a zero or 1-based answer depending on the tearoff
# status of the menu. If the menu denoted by tkMenuPath is a
# tearoff menu it returns a 1-based result, otherwise a
# zero-based result.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_getTkIndex { tkMenuPath tkIndex} {
 
    # if there is a tear off make it 1-based index
    if { [$tkMenuPath cget -tearoff] } {
        incr tkIndex
    }
 
    return $tkIndex
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _getPdIndex
#
# Take a tk index and give me a zero based numerical index
#
# Ask the menu widget for the index of the entry denoted by
# 'tkIndex'. Then if the menu is a tearoff adjust the value
# to be zero based.
#
# This method returns the index as if tearoffs did not exist.
# Always returns a zero-based index.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_getPdIndex { tkMenuPath tkIndex } {
 
    # get the index from the tk menu
    # this 0 based for non-tearoff and 1-based for tearoffs
    set pdIndex [$tkMenuPath index $tkIndex]
 
    # if there is a tear off make it 0-based index
    if { [$tkMenuPath cget -tearoff] } {
        incr pdIndex -1
    }
 
    return $pdIndex
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _getMenuList
#
# Returns the list of menus in the order they are on the interface
# returned list is a list of our menu paths
#
# -------------------------------------------------------------
body iwidgets::Menubar::_getMenuList { } {
    # get the menus that are packed
    set tkPathList [pack slaves $itk_component(menubar)]
 
    regsub -- {[.]} $itk_component(hull) "" mbName
    regsub -all -- "\[.\]$mbName\[.\]menubar\[.\]" $tkPathList "." menuPathList
 
    return $menuPathList
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _getEntryList
#
#
# This method looks at a menupath and gets all the entries and
# returns a list of all the entry path names in numerical order
# based on their index values.
#
# MENU is the path to a menu, like .mbar.file.menu or .mbar.file
# we will calculate a menuPath from this: .mbar.file
# then we will build a list of entries in this menu excluding the
# path .mbar.file.menu
#
# -------------------------------------------------------------
body iwidgets::Menubar::_getEntryList { menu } {
 
    # if it ends with menu, clip it off
    regsub {[.]menu$} $menu "" menuPath
 
    # first get the complete list of all menu paths
    set pathList [array names _pathMap]
 
    set numEntries 0
    # iterate over the pathList and put on menuPathList those
    # that match the menuPattern
    foreach path $pathList {
        # if this path is on the menuPath's branch
        if { [regexp [subst -nocommands {$menuPath[.][^.]*$}] $path] } {
            # if not a menu itself
            if { ! [regexp {[.]menu$} $path] } {
                set orderedList($_pathMap($path)) $path
                incr numEntries
            }
        }
    }
    set entryList {}
 
    for {set i 0} {$i < $numEntries} {incr i} {
        lappend entryList $orderedList($i)
    }
 
    return $entryList
 
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _parsePath
#
# given path, PATH, _parsePath splits the path name into its
# component segments. It then puts the name back together one
# segment at a time and calls _getSymbolicPath to replace the
# keywords 'last' and 'end' as well as numeric digits.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_parsePath { path } {
    set segments [split [string trimleft $path .] .]
 
    set concatPath ""
    foreach seg $segments {
 
        set concatPath [_getSymbolicPath $concatPath $seg]
 
        if { [catch {set _pathMap($concatPath)} ] } {
            error "bad path: \"$path\" does not exist. \"$seg\" not valid"
        }
    }
    return $concatPath
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _getSymbolicPath
#
# Given a PATH, _getSymbolicPath looks for the last segment of
# PATH to contain: a number, the keywords last or end. If one
# of these it figures out how to get us the actual pathname
# to the searched widget
#
# Implementor's notes:
#       Surely there is a shorter way to do this. The only diff
#       for non-numeric is getting the llength of the correct list
#       It is hard to know this upfront so it seems harder to generalize.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_getSymbolicPath { parent segment } {
 
    # if the segment is a number, then look it up positionally
    # MATCH numeric index
    if { [regexp {^[0-9]+$} $segment] } {
 
        # if we have no parent, then we area menubutton
        if { $parent == {} } {
            set returnPath [lindex [_getMenuList] $segment]
        } else {
            set returnPath [lindex [_getEntryList $parent.menu] $segment]
        }
 
        # MATCH 'end' or 'last' keywords.
    } elseif { $segment == "end" || $segment == "last" } {
 
        # if we have no parent, then we are a menubutton
        if { $parent == {} } {
            set returnPath [lindex [_getMenuList] end]
        } else {
            set returnPath [lindex [_getEntryList $parent.menu] end]
        }
    } else {
        set returnPath $parent.$segment
    }
 
    return $returnPath
}
 
# -------------------------------------------------------------
#
# PROTECTED METHOD: _helpHandler
#
# Bound to the  event on a menu pane. This puts the
# help string associated with the menu entry into the
# status widget help area. If no help exists for the current
# entry, the status widget is cleared.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_helpHandler { menuPath } {
 
    if { $itk_option(-helpvariable) == {} } {
        return
    }
 
    set tkMenuWidget $_pathMap($menuPath)
 
    set entryIndex [$tkMenuWidget index active]
 
    # already on this item?
    if { $entryIndex == $_entryIndex } {
        return
    }
 
    set _entryIndex $entryIndex
 
    if {"none" != $entryIndex} {
        set entries [_getEntryList $menuPath]
 
        set menuEntryHit \
            [lindex $entries [_getPdIndex $tkMenuWidget $entryIndex]]
 
        # blank out the old one
        set $itk_option(-helpvariable) {}
 
        # if there is a help string for this entry
        if { [::info exists _helpString($menuEntryHit)] } {
            set $itk_option(-helpvariable) $_helpString($menuEntryHit)
        }
    } else {
        set $itk_option(-helpvariable) {}
        set _entryIndex -1
    }
}
 
# -------------------------------------------------------------
#
# PRIVATE METHOD: _getCallerLevel
#
# Starts at stack frame #0 and works down till we either hit
# a ::Menubar stack frame or an ::itk::Archetype stack frame
# (the latter happens when a configure is called via the 'component'
# method
#
# Returns the level of the actual caller of the menubar command
# in the form of #num where num is the level number caller stack frame.
#
# -------------------------------------------------------------
body iwidgets::Menubar::_getCallerLevel { } {
 
    set levelName {}
    set levelsAreValid true
    set level 0
    set callerLevel #$level
 
    while { $levelsAreValid } {
        # Hit the end of the stack frame
        if [catch {uplevel #$level {namespace current}}] {
            set levelsAreValid false
            set callerLevel #[expr $level - 1]
            # still going
        } else {
            set newLevelName [uplevel #$level {namespace current}]
            # See if we have run into the first ::Menubar level
            if { $newLevelName == "::itk::Archetype" || \
                    $newLevelName == "::iwidgets::Menubar" } {
                # If so, we are done-- set the callerLevel
                set levelsAreValid false
                set callerLevel #[expr $level - 1]
            } else {
                set levelName $newLevelName
            }
        }
        incr level
    }
    return $callerLevel
}
 
 
#
# The default tkMenuFind proc in menu.tcl only looks for menubuttons
# in frames.  Since our menubuttons are within the Menubar class, the
# default proc won't find them during menu traversal.  This proc
# redefines the default proc to remedy the problem.
#
proc tkMenuFind {w char} {
    global tkPriv
    set char [string tolower $char]
 
    foreach child [winfo child $w] {
        switch [winfo class $child] {
            Menubutton {
                set qchild [winfo command $child]
                set char2 [string index [$qchild cget -text] \
                        [$qchild cget -underline]]
                if {([string compare $char [string tolower $char2]] == 0)
                || ($char == "")} {
                    if {[$qchild cget -state] != "disabled"} {
                        return $child
                    }
                }
            }
            Frame -
            Menubar {
                set match [tkMenuFind $child $char]
                if {$match != ""} {
                    return $match
                }
            }
        }
    }
    return {}
}
 
 
Browse

Tools

Subversion Repositories or1k_old

[/] [or1k_old/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [menubar.itk] - Blame information for rev 1782
