menubar.itk

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

	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 ...