menubar.itk

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

# 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 ?<mode>? <pattern>
#
# 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?> <pattern>\""
    }

    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"
	}