hierarchy.itk

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

    lappend _markers "$node:end" [$itk_component(list) index insert]
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _contents uid
#
# Used internally to get the contents of a particular node.  If this
# is the first time the node has been seen or the -alwaysquery
# option is set, the -querycommand code is executed to query the node 
# list, and the list is stored until the next time it is needed.
#
# The querycommand may return not only the list of subnodes for the 
# node but additional information on the tags and icons to be used.  
# The return value must be parsed based on the number of elements in 
# the list where the format is a list of lists:
#
# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_contents {uid} {
    if {! $itk_option(-alwaysquery) && [info exists _nodes($uid)]} {
        return $_nodes($uid)
    }

    # 
    # Substitute any %n's for the node name whose children we're
    # interested in obtaining.
    #
    set cmd $itk_option(-querycommand)
    regsub -all {%n} $cmd [list $uid] cmd

    set nodeinfolist [uplevel \#0 $cmd]

    #
    # Cycle through the node information returned by the query
    # command determining if additional information such as text,
    # user tags, or user icons have been provided.  For text,
    # break it into a list at any newline characters.
    #
    set _nodes($uid) {}

    foreach nodeinfo $nodeinfolist {
	set subnodeuid [lindex $nodeinfo 0]
	lappend _nodes($uid) $subnodeuid

	set llen [llength $nodeinfo] 

	if {$llen == 0 || $llen > 4} {
	    error "invalid number of elements returned by query\
                       command for node: \"$uid\",\
                       should be uid \[text \[tags \[icons\]\]\]"
	}

	if {$llen == 1} {
	    set _text($subnodeuid) [split $subnodeuid \n]
	} 
	if {$llen > 1} {
	    set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]
	}
	if {$llen > 2} {
	    set _tags($subnodeuid) [lindex $nodeinfo 2]
	} else {
	    set _tags($subnodeuid) unknown
	}
	if {$llen > 3} {
	    set _icons($subnodeuid) [lindex $nodeinfo 3]
	}
    }
		  
    #
    # Return the list of nodes.
    #
    return $_nodes($uid)
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _post x y
#
# Used internally to post the popup menu at the coordinate (x,y)
# relative to the widget.  If (x,y) is on an item, then the itemMenu
# component is posted.  Otherwise, the bgMenu is posted.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_post {x y} {
    set rx [expr [winfo rootx $itk_component(list)]+$x]
    set ry [expr [winfo rooty $itk_component(list)]+$y]

    set index [$itk_component(list) index @$x,$y]

    #
    # The posted variable will hold the list of tags which exist at
    # this x,y position that will be passed back to the user.  They
    # don't need to know about our internal tags, info, hilite, and
    # lowlite, so remove them from the list.
    # 
    set _posted {}

    foreach tag [$itk_component(list) tag names $index] {
        if {![_isInternalTag $tag]} {
            lappend _posted $tag
        }
    }

    #
    # If we have tags then do the popup at this position.
    #
    if {$_posted != {}} {
	# DRH - here is where the user's function for dynamic popup
	# menu loading is done, if the user has specified to do so with the
	# "-textmenuloadcommand"
	if {$itk_option(-textmenuloadcommand) != {}} {
	    eval $itk_option(-textmenuloadcommand)
	}
	tk_popup $itk_component(itemMenu) $rx $ry
    } else {
	tk_popup $itk_component(bgMenu) $rx $ry
    }
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _imagePost node image type x y
#
# Used internally to post the popup menu at the coordinate (x,y)
# relative to the widget.  If (x,y) is on an image, then the itemMenu
# component is posted.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_imagePost {node image type x y} {
    set rx [expr [winfo rootx $image]+$x]
    set ry [expr [winfo rooty $image]+$y]

    #
    # The posted variable will hold the list of tags which exist at
    # this x,y position that will be passed back to the user.  They
    # don't need to know about our internal tags, info, hilite, and
    # lowlite, so remove them from the list.
    # 
    set _posted {}

    lappend _posted $node $type

    #
    # If we have tags then do the popup at this position.
    #
    if {$itk_option(-imagemenuloadcommand) != {}} {
	eval $itk_option(-imagemenuloadcommand)
    }
    tk_popup $itk_component(itemMenu) $rx $ry
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _select x y
#
# Used internally to select an item at the coordinate (x,y) relative 
# to the widget.  The command associated with the -selectcommand
# option is execute following % character substitutions.  If %n
# appears in the command, the selected node is substituted.  If %s
# appears, a boolean value representing the current selection state
# will be substituted.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_select {x y} {
    if {$itk_option(-selectcommand) != {}} {
	if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
	    foreach tag $seltags {
		if {![_isInternalTag $tag]} {
		    lappend node $tag
		}
	    }

	    if {[lsearch $seltags "hilite"] == -1} {
		set selectstatus 0
	    } else {
		set selectstatus 1
	    }

	    set cmd $itk_option(-selectcommand)
	    regsub -all {%n} $cmd [list $node] cmd
	    regsub -all {%s} $cmd [list $selectstatus] cmd

	    uplevel #0 $cmd
	}
    }

    return
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _double x y
#
# Used internally to double click an item at the coordinate (x,y) relative 
# to the widget.  The command associated with the -dblclickcommand
# option is execute following % character substitutions.  If %n
# appears in the command, the selected node is substituted.  If %s
# appears, a boolean value representing the current selection state
# will be substituted.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_double {x y} {
    if {$itk_option(-dblclickcommand) != {}} {
	if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
	    foreach tag $seltags {
		if {![_isInternalTag $tag]} {
		    lappend node $tag
		}
	    }

	    if {[lsearch $seltags "hilite"] == -1} {
		set selectstatus 0
	    } else {
		set selectstatus 1
	    }

	    set cmd $itk_option(-dblclickcommand)
	    regsub -all {%n} $cmd [list $node] cmd
	    regsub -all {%s} $cmd [list $selectstatus] cmd

	    uplevel #0 $cmd
	}
    }

    return
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _iconSelect node icon
#
# Used internally to upon selection of user icons.  The -iconcommand
# is executed after substitution of the node for %n and icon for %i.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_iconSelect {node icon} {
    set cmd $itk_option(-iconcommand)
    regsub -all {%n} $cmd [list $node] cmd
    regsub -all {%i} $cmd [list $icon] cmd

    uplevel \#0 $cmd

    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _iconDblSelect node icon
#
# Used internally to upon double selection of user icons.  The 
# -icondblcommand is executed after substitution of the node for %n and 
# icon for %i.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_iconDblSelect {node icon} {
    if {$itk_option(-icondblcommand) != {}} {
	set cmd $itk_option(-icondblcommand)
	regsub -all {%n} $cmd [list $node] cmd
	regsub -all {%i} $cmd [list $icon] cmd
	
	uplevel \#0 $cmd
    }
    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _imageSelect node icon
#
# Used internally to upon selection of user icons.  The -imagecommand
# is executed after substitution of the node for %n.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_imageSelect {node} {
    if {$itk_option(-imagecommand) != {}} {
	set cmd $itk_option(-imagecommand)
	regsub -all {%n} $cmd [list $node] cmd
	
	uplevel \#0 $cmd
    }
    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _imageDblClick node
#
# Used internally to upon double selection of images.  The 
# -imagedblcommand is executed.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_imageDblClick {node} {
    if {$itk_option(-imagedblcommand) != {}} {
	set cmd $itk_option(-imagedblcommand)
	regsub -all {%n} $cmd [list $node] cmd
	
	uplevel \#0 $cmd
    }
    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _deselectSubNodes uid
#
# Used internally to recursively deselect all the nodes beneath a 
# particular node.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_deselectSubNodes {uid} {
    foreach node $_nodes($uid) {
	if {[array names _selected $node] != {}} {
	    unset _selected($node)
	}
	
	if {[array names _nodes $node] != {}} {
	    _deselectSubNodes $node
	}
    }
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _deleteNodeInfo uid
#
# Used internally to recursively delete all the information about a
# node and its decendents.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_deleteNodeInfo {uid} {
    #
    # Recursively call ourseleves as we go down the hierarchy beneath
    # this node.
    #
    if {[info exists _nodes($uid)]} {
	foreach node $_nodes($uid) {
	    if {[array names _nodes $node] != {}} {
		_deleteNodeInfo $node
	    }
	}
    }

    #
    # Unset any entries in our arrays for the node.
    #
    catch {unset _nodes($uid)}
    catch {unset _text($uid)}
    catch {unset _tags($uid)}
    catch {unset _icons($uid)}
    catch {unset _states($uid)}
    catch {unset _images($uid)}
    catch {unset _indents($uid)}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _getParent uid
#
# Used internally to determine the parent for a node.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_getParent {uid} {
    foreach node [array names _nodes] {
	if {[set index [lsearch $_nodes($node) $uid]] != -1} {
	    return $node
	}
    }
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _getHeritage uid
#
# Used internally to determine the list of parents for a node.
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_getHeritage {uid} {
    set parents {}

    if {[set parent [_getParent $uid]] != {}} {
	lappend parents $parent
    }

    return $parents
}

# ----------------------------------------------------------------------
# PROTECTED METHOD (could be proc?): _isInternalTag tag
#
# Used internally to tags not to used for user callback commands
# ----------------------------------------------------------------------
body iwidgets::Hierarchy::_isInternalTag {tag} {
   set ii [expr [lsearch -exact {info hilite lowlite unknown} $tag] != -1];
   return $ii;
}