menubar.itk

linux 下的源代码分析阅读器 red hat公司新版

	# 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) <<MenuSelect>> \
	    [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]