menubar.itk

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

	# 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