# Hierarchy
# ----------------------------------------------------------------------
# Hierarchical data viewer.  Manages a list of nodes that can be
# expanded or collapsed.  Individual nodes can be highlighted.
# Clicking with the right mouse button on any item brings up a
# special item menu.  Clicking on the background area brings up
# a different popup menu.
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan
#            Bell Labs Innovations for Lucent Technologies
#            mmclennan@lucent.com
#
#            Mark L. Ulferts
#            DSC Communications
#            mulferts@austin.dsccc.com
#
#      RCS:  $Id: hierarchy.itk,v 1.9 2002/09/06 16:27:03 smithc Exp $
# ----------------------------------------------------------------------
#                Copyright (c) 1996  Lucent Technologies
# ======================================================================
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of Lucent Technologies
# any of their entities not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# Lucent Technologies disclaims all warranties with regard to this
# software, including all implied warranties of merchantability and
# fitness.  In no event shall Lucent Technologies be liable for any
# special, indirect or consequential damages or any damages whatsoever
# resulting from loss of use, data or profits, whether in an action of
# contract, negligence or other tortuous action, arising out of or in
# connection with the use or performance of this software.
#
# ----------------------------------------------------------------------
#            Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Hierarchy {
    keep -cursor -textfont -font
    keep -background -foreground -textbackground 
    keep -selectbackground -selectforeground 
}

# ------------------------------------------------------------------
#                            HIERARCHY
# ------------------------------------------------------------------
itcl::class iwidgets::Hierarchy {
    inherit iwidgets::Scrolledwidget

    constructor {args} {}

    destructor {}

    itk_option define -alwaysquery alwaysQuery AlwaysQuery 0
    itk_option define -closedicon closedIcon Icon {}
    itk_option define -dblclickcommand dblClickCommand Command {}
    itk_option define -expanded expanded Expanded 0 
    itk_option define -filter filter Filter 0 
    itk_option define -font font Font \
	-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 
    itk_option define -height height Height 0
    itk_option define -iconcommand iconCommand Command {}
    itk_option define -icondblcommand iconDblCommand Command {}
    itk_option define -imagecommand imageCommand Command {}
    itk_option define -imagedblcommand imageDblCommand Command {}
    itk_option define -imagemenuloadcommand imageMenuLoadCommand Command {}
    itk_option define -markbackground markBackground Foreground #a0a0a0 
    itk_option define -markforeground markForeground Background Black 
    itk_option define -nodeicon nodeIcon Icon {}
    itk_option define -openicon openIcon Icon {}
    itk_option define -querycommand queryCommand Command {}
    itk_option define -selectcommand selectCommand Command {}
    itk_option define -selectbackground selectBackground Foreground #c3c3c3 
    itk_option define -selectforeground selectForeground Background Black 
    itk_option define -textmenuloadcommand textMenuLoadCommand Command {}
    itk_option define -visibleitems visibleItems VisibleItems 80x24
    itk_option define -width width Width 0

    public {
	method clear {}
	method collapse {node}
	method current {}
	method draw {{when -now}}
	method expand {node}
	method expanded {node}
	method expState { }
	method mark {op args}
	method prune {node}
	method refresh {node}
	method selection {op args}
	method toggle {node}
	
	method bbox {index} 
	method compare {index1 op index2} 
	method debug {args} {eval $args}
	method delete {first {last {}}} 
	method dlineinfo {index} 
	method dump {args}
	method get {index1 {index2 {}}} 
	method index {index} 
	method insert {args} 
	method scan {option args} 
	method search {args} 
	method see {index} 
	method tag {op args} 
	method window {option args} 
	method xview {args}
	method yview {args}
    }

    protected {
	method _contents {uid}
	method _post {x y}
	method _drawLevel {node indent}
	method _select {x y}
	method _deselectSubNodes {uid}
	method _deleteNodeInfo {uid}
	method _getParent {uid}
	method _getHeritage {uid}
	method _isInternalTag {tag}
	method _iconSelect {node icon}
	method _iconDblSelect {node icon}
	method _imageSelect {node}
	method _imageDblClick {node}
	method _imagePost {node image type x y}
	method _double {x y}
    }
    
    private {
        method _configureTags {}

	variable _filterCode ""  ;# Compact view flag.
	variable _hcounter 0     ;# Counter for hierarchy icons
	variable _icons          ;# Array of user icons by uid
	variable _images         ;# Array of our icons by uid
	variable _indents        ;# Array of indentation by uid
	variable _marked         ;# Array of marked nodes by uid
	variable _markers ""     ;# List of markers for level being drawn
	variable _nodes          ;# Array of subnodes by uid
	variable _pending ""     ;# Pending draw flag
	variable _posted ""      ;# List of tags at posted menu position
	variable _selected       ;# Array of selected nodes by uid
	variable _tags           ;# Array of user tags by uid
	variable _text           ;# Array of displayed text by uid
	variable _states         ;# Array of selection state by uid
	variable _ucounter 0     ;# Counter for user icons
    }
}

#
# Provide a lowercased access method for the Hierarchy class.
# 
proc ::iwidgets::hierarchy {pathName args} {
    uplevel ::iwidgets::Hierarchy $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Hierarchy.menuCursor arrow widgetDefault
option add *Hierarchy.labelPos n widgetDefault
option add *Hierarchy.tabs 30 widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::constructor {args} {
    itk_option remove iwidgets::Labeledwidget::state

    #
    # Our -width and -height options are slightly different than
    # those implemented by our base class, so we're going to
    # remove them and redefine our own.
    #
    itk_option remove iwidgets::Scrolledwidget::width
    itk_option remove iwidgets::Scrolledwidget::height

    #
    # Create a clipping frame which will provide the border for
    # relief display.
    #
    itk_component add clipper {
	frame $itk_interior.clipper
    } {
	usual

	keep -borderwidth -relief -highlightthickness -highlightcolor
	rename -highlightbackground -background background Background
    }	
    grid $itk_component(clipper) -row 0 -column 0 -sticky nsew
    grid rowconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 0 -weight 1

    #
    # Create a text widget for displaying our hierarchy.
    #
    itk_component add list {
	text $itk_component(clipper).list -wrap none -cursor center_ptr \
                -state disabled -width 1 -height 1 \
	        -xscrollcommand \
		[itcl::code $this _scrollWidget $itk_interior.horizsb] \
		-yscrollcommand \
		[itcl::code $this _scrollWidget $itk_interior.vertsb] \
	        -borderwidth 0 -highlightthickness 0
    } {
	usual

	keep -spacing1 -spacing2 -spacing3 -tabs
	rename -font -textfont textFont Font
	rename -background -textbackground textBackground Background
	ignore -highlightthickness -highlightcolor
	ignore -insertbackground -insertborderwidth
	ignore -insertontime -insertofftime -insertwidth
	ignore -selectborderwidth
	ignore -borderwidth
    }
    grid $itk_component(list) -row 0 -column 0 -sticky nsew
    grid rowconfigure $itk_component(clipper) 0 -weight 1
    grid columnconfigure $itk_component(clipper) 0 -weight 1
    
    # 
    # Configure the command on the vertical scroll bar in the base class.
    #
    $itk_component(vertsb) configure \
	-command [itcl::code $itk_component(list) yview]

    #
    # Configure the command on the horizontal scroll bar in the base class.
    #
    $itk_component(horizsb) configure \
		-command [itcl::code $itk_component(list) xview]
    
    #
    # Configure our text component's tab settings for twenty levels.
    #
    set tabs ""
    for {set i 1} {$i < 20} {incr i} {
	lappend tabs [expr {$i*12+4}]
    }
    $itk_component(list) configure -tabs $tabs

    #
    # Add popup menus that can be configured by the user to add
    # new functionality.
    #
    itk_component add itemMenu {
	menu $itk_component(list).itemmenu -tearoff 0
    } {
	usual
	ignore -tearoff
	rename -cursor -menucursor menuCursor Cursor
    }

    itk_component add bgMenu {
	menu $itk_component(list).bgmenu -tearoff 0
    } {
	usual
	ignore -tearoff
	rename -cursor -menucursor menuCursor Cursor
    }

    #
    # Adjust the bind tags to remove the class bindings.  Also, add
    # bindings for mouse button 1 to do selection and button 3 to 
    # display a popup.
    #
    bindtags $itk_component(list) [list $itk_component(list) . all]
    
    bind $itk_component(list) <ButtonPress-1> \
            [itcl::code $this _select %x %y]

    bind $itk_component(list) <Double-1> \
            [itcl::code $this _double %x %y]

    bind $itk_component(list) <ButtonPress-3> \
            [itcl::code $this _post %x %y]
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::destructor {} {
    if {$_pending != ""} {
	after cancel $_pending
    }
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -font
#
# Font used for text in the list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::font {
    $itk_component(list) tag configure info \
            -font $itk_option(-font) -spacing1 6
}

# ------------------------------------------------------------------
# OPTION: -selectbackground
#
# Background color scheme for selected nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::selectbackground {
    $itk_component(list) tag configure hilite \
            -background $itk_option(-selectbackground)
}

# ------------------------------------------------------------------
# OPTION: -selectforeground
#
# Foreground color scheme for selected nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::selectforeground {
    $itk_component(list) tag configure hilite \
            -foreground $itk_option(-selectforeground)
}

# ------------------------------------------------------------------
# OPTION: -markbackground
#
# Background color scheme for marked nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::markbackground {
    $itk_component(list) tag configure lowlite \
            -background $itk_option(-markbackground)
}

# ------------------------------------------------------------------
# OPTION: -markforeground
#
# Foreground color scheme for marked nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::markforeground {
    $itk_component(list) tag configure lowlite \
            -foreground $itk_option(-markforeground)
}

# ------------------------------------------------------------------
# OPTION: -querycommand
#
# Command executed to query the contents of each node.  If this 
# command contains "%n", it is replaced with the name of the desired 
# node.  In its simpilest form it should return the children of the 
# given node as a list which will be depicted in the display.
#
# Since the names of the children are used as tags in the underlying 
# text widget, each child must be unique in the hierarchy.  Due to
# the unique requirement, the nodes shall be reffered to as uids 
# or uid in the singular sense.
# 
#   {uid [uid ...]}
#
#   where uid is a unique id and primary key for the hierarchy entry
#
# Should the unique requirement pose a problem, the list returned
# can take on another more extended form which enables the 
# association of text to be displayed with the uids.  The uid must
# still be unique, but the text does not have to obey the unique
# rule.  In addition, the format also allows the specification of
# additional tags to be used on the same entry in the hierarchy
# as the uid and additional icons to be displayed just before
# the node.  The tags and icons are considered to be the property of
# the user in that the hierarchy widget will not depend on any of 
# their values.
#
#   {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
#
#   where uid is a unique id and primary key for the hierarchy entry
#         text is the text to be displayed for this uid
#         tags is a list of user tags to be applied to the entry
#         icons is a list of icons to be displayed in front of the text
#
# The hierarchy widget does a look ahead from each node to determine
# if the node has a children.  This can be cost some performace with
# large hierarchies.  User's can avoid this by providing a hint in
# the user tags.  A tag of "leaf" or "branch" tells the hierarchy
# widget the information it needs to know thereby avoiding the look
# ahead operation.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::querycommand {
    clear
    draw -eventually

    # Added for SF ticket #596111
    _configureTags
}

# ------------------------------------------------------------------
# OPTION: -selectcommand
#
# Command executed to select an item in the list.  If this command
# contains "%n", it is replaced with the name of the selected node.  
# If it contains a "%s", it is replaced with a boolean indicator of 
# the node's current selection status, where a value of 1 denotes
# that the node is currently selected and 0 that it is not.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::selectcommand {
}

# ------------------------------------------------------------------
# OPTION: -dblclickcommand
#
# Command executed to double click an item in the list.  If this command
# contains "%n", it is replaced with the name of the selected node.  
# If it contains a "%s", it is replaced with a boolean indicator of 
# the node's current selection status, where a value of 1 denotes
# that the node is currently selected and 0 that it is not.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::dblclickcommand {
}

# ------------------------------------------------------------------
# OPTION: -iconcommand
#
# Command executed upon selection of user icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.  Should it contain "%i" then the icon name is 
# substituted.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::iconcommand {
}

# ------------------------------------------------------------------
# OPTION: -icondblcommand
#
# Command executed upon double selection of user icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.  Should it contain "%i" then the icon name is 
# substituted.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::icondblcommand {
}

# ------------------------------------------------------------------
# OPTION: -imagecommand
#
# Command executed upon selection of image icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.  Should it contain "%i" then the icon name is 
# substituted.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::imagecommand {
}

# ------------------------------------------------------------------
# OPTION: -imagedblcommand
#
# Command executed upon double selection of user icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::imagedblcommand {
}

# ------------------------------------------------------------------
# OPTION: -alwaysquery
#
# Boolean flag which tells the hierarchy widget weather or not
# each refresh of the display should be via a new query using
# the -querycommand option or use the values previous found the
# last time the query was made.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::alwaysquery {
    switch -- $itk_option(-alwaysquery) {
	    1 - true - yes - on {
	        ;# okay
	    }
	    0 - false - no - off {
	        ;# okay
	    }
	    default {
	        error "bad alwaysquery option \"$itk_option(-alwaysquery)\":\
                    should be boolean"
	    }
    }
}

# ------------------------------------------------------------------
# OPTION: -filter
#
# When true only the branch nodes and selected items are displayed.
# This gives a compact view of important items.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::filter {
    switch -- $itk_option(-filter) {
	    1 - true - yes - on {
	        set newCode {set display [info exists _selected($child)]}
	    }
	    0 - false - no - off {
	        set newCode {set display 1}
	    }
	    default {
	        error "bad filter option \"$itk_option(-filter)\":\
                   should be boolean"
	    }
    }
    if {$newCode != $_filterCode} {
	    set _filterCode $newCode
	    draw -eventually
    }
}

# ------------------------------------------------------------------
# OPTION: -expanded
#
# When true, the hierarchy will be completely expanded when it
# is first displayed.  A fresh display can be triggered by
# resetting the -querycommand option.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::expanded {
    switch -- $itk_option(-expanded) {
	    1 - true - yes - on {
	        ;# okay
	    }
	    0 - false - no - off {
	        ;# okay
	    }
	    default {
	        error "bad expanded option \"$itk_option(-expanded)\":\
                   should be boolean"
	    }
    }
}
    
# ------------------------------------------------------------------
# OPTION: -openicon
#
# Specifies the open icon image to be used in the hierarchy.  Should
# one not be provided, then one will be generated, pixmap if 
# possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::openicon {
    if {$itk_option(-openicon) == {}} {
	if {[lsearch [image names] openFolder] == -1} {
	    if {[lsearch [image types] pixmap] != -1} {
		image create pixmap openFolder -data {
		    /* XPM */
		    static char * dir_opened [] = {
			"16 16 4 1",
			/* colors */
			". c grey85 m white g4 grey90",
			"b c black  m black g4 black",
			"y c yellow m white g4 grey80",
			"g c grey70 m white g4 grey70",
			/* pixels */
			"................",
			"................",
			"................",
			"..bbbb..........",
			".bggggb.........",
			"bggggggbbbbbbb..",
			"bggggggggggggb..",
			"bgbbbbbbbbbbbbbb",
			"bgbyyyyyyyyyyybb",
			"bbyyyyyyyyyyyyb.",
			"bbyyyyyyyyyyybb.",
			"byyyyyyyyyyyyb..",
			"bbbbbbbbbbbbbb..",
			"................",
			"................",
			"................"};
		}
	    } else {
		image create bitmap openFolder -data {
		    #define open_width 16
		    #define open_height 16
		    static char open_bits[] = {
			0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00, 
			0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0, 
			0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,
			0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	    }
	}
	set itk_option(-openicon) openFolder
    } else {
	if {[lsearch [image names] $itk_option(-openicon)] == -1} {
	    error "bad openicon option \"$itk_option(-openicon)\":\
                   should be an existing image"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -closedicon
#
# Specifies the closed icon image to be used in the hierarchy.  
# Should one not be provided, then one will be generated, pixmap if 
# possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::closedicon {
    if {$itk_option(-closedicon) == {}} {
	if {[lsearch [image names] closedFolder] == -1} {
	    if {[lsearch [image types] pixmap] != -1} {
		image create pixmap closedFolder -data {
		    /* XPM */
		    static char *dir_closed[] = {
			"16 16 3 1",
			". c grey85 m white g4 grey90",
			"b c black  m black g4 black",
			"y c yellow m white g4 grey80",
			"................",
			"................",
			"................",
			"..bbbb..........",
			".byyyyb.........",
			"bbbbbbbbbbbbbb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"bbbbbbbbbbbbbb..",
			"................",
			"................",
			"................"};	
		}
	    } else {
		image create bitmap closedFolder -data {
		    #define closed_width 16
		    #define closed_height 16
		    static char closed_bits[] = {
			0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00, 
			0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 
			0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
			0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	    }
	}
	set itk_option(-closedicon) closedFolder
    } else {
	if {[lsearch [image names] $itk_option(-closedicon)] == -1} {
	    error "bad closedicon option \"$itk_option(-closedicon)\":\
                   should be an existing image"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -nodeicon
#
# Specifies the node icon image to be used in the hierarchy.  Should 
# one not be provided, then one will be generated, pixmap if 
# possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::nodeicon {
    if {$itk_option(-nodeicon) == {}} {
	if {[lsearch [image names] nodeFolder] == -1} {
	    if {[lsearch [image types] pixmap] != -1} {
		image create pixmap nodeFolder -data {
		    /* XPM */
		    static char *dir_node[] = {
			"16 16 3 1",
			". c grey85 m white g4 grey90",
			"b c black  m black g4 black",
			"y c yellow m white g4 grey80",
			"................",
			"................",
			"................",
			"...bbbbbbbbbbb..",
			"..bybyyyyyyyyb..",
			".byybyyyyyyyyb..",
			"byyybyyyyyyyyb..",
			"bbbbbyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"bbbbbbbbbbbbbb..",
			"................",
			"................",
			"................"};	
		}
	    } else {
		image create bitmap nodeFolder -data {
		    #define node_width 16
		    #define node_height 16
		    static char node_bits[] = {
			0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40, 
			0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40, 
			0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
			0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	    }
	}
	set itk_option(-nodeicon) nodeFolder
    } else {
	if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {
	    error "bad nodeicon option \"$itk_option(-nodeicon)\":\
                   should be an existing image"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -width
#
# Specifies the width of the hierarchy widget as an entire unit.
# The value may be specified in any of the forms acceptable to 
# Tk_GetPixels.  Any additional space needed to display the other
# components such as labels, margins, and scrollbars force the text
# to be compressed.  A value of zero along with the same value for 
# the height causes the value given for the visibleitems option 
# to be applied which administers geometry constraints in a different
# manner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::width {
    if {$itk_option(-width) != 0} {
	set shell [lindex [grid info $itk_component(clipper)] 1]

	#
	# Due to a bug in the tk4.2 grid, we have to check the 
	# propagation before setting it.  Setting it to the same
	# value it already is will cause it to toggle.
	#
	if {[grid propagate $shell]} {
	    grid propagate $shell no
	}
	
	$itk_component(list) configure -width 1
	$shell configure \
		-width [winfo pixels $shell $itk_option(-width)] 
    } else {
	configure -visibleitems $itk_option(-visibleitems)
    }
}

# ------------------------------------------------------------------
# OPTION: -height
#
# Specifies the height of the hierarchy widget as an entire unit.
# The value may be specified in any of the forms acceptable to 
# Tk_GetPixels.  Any additional space needed to display the other
# components such as labels, margins, and scrollbars force the text
# to be compressed.  A value of zero along with the same value for 
# the width causes the value given for the visibleitems option 
# to be applied which administers geometry constraints in a different
# manner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::height {
    if {$itk_option(-height) != 0} {
	set shell [lindex [grid info $itk_component(clipper)] 1]

	#
	# Due to a bug in the tk4.2 grid, we have to check the 
	# propagation before setting it.  Setting it to the same
	# value it already is will cause it to toggle.
	#
	if {[grid propagate $shell]} {
	    grid propagate $shell no
	}
	
	$itk_component(list) configure -height 1
	$shell configure \
		-height [winfo pixels $shell $itk_option(-height)] 
    } else {
	configure -visibleitems $itk_option(-visibleitems)
    }
}

# ------------------------------------------------------------------
# OPTION: -visibleitems
#
# Specified the widthxheight in characters and lines for the text.
# This option is only administered if the width and height options
# are both set to zero, otherwise they take precedence.  With the
# visibleitems option engaged, geometry constraints are maintained
# only on the text.  The size of the other components such as 
# labels, margins, and scroll bars, are additive and independent, 
# effecting the overall size of the scrolled text.  In contrast,
# should the width and height options have non zero values, they
# are applied to the scrolled text as a whole.  The text is 
# compressed or expanded to maintain the geometry constraints.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::visibleitems {
    if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
	if {($itk_option(-width) == 0) && \
		($itk_option(-height) == 0)} {
	    set chars [lindex [split $itk_option(-visibleitems) x] 0]
	    set lines [lindex [split $itk_option(-visibleitems) x] 1]
	    
	    set shell [lindex [grid info $itk_component(clipper)] 1]

	    #
	    # Due to a bug in the tk4.2 grid, we have to check the 
	    # propagation before setting it.  Setting it to the same
	    # value it already is will cause it to toggle.
	    #
	    if {! [grid propagate $shell]} {
		grid propagate $shell yes
	    }
	    
	    $itk_component(list) configure -width $chars -height $lines
	}
	
    } else {
	error "bad visibleitems option\
		\"$itk_option(-visibleitems)\": should be\
		widthxheight"
    }
}

# ------------------------------------------------------------------
# OPTION: -textmenuloadcommand
#
# Dynamically loads the popup menu based on what was selected.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::textmenuloadcommand {}

# ------------------------------------------------------------------
# OPTION: -imagemenuloadcommand
#
# Dynamically loads the popup menu based on what was selected.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::imagemenuloadcommand {}


# ------------------------------------------------------------------
#                         PUBLIC METHODS
# ------------------------------------------------------------------

# ----------------------------------------------------------------------
# PUBLIC METHOD: clear
#
# Removes all items from the display including all tags and icons.  
# The display will remain empty until the -filter or -querycommand 
# options are set.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::clear {} {
    $itk_component(list) configure -state normal -cursor watch
    $itk_component(list) delete 1.0 end
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)

    # Clear the tags
    eval $itk_component(list) tag delete [$itk_component(list) tag names]
    
    catch {unset _nodes}
    catch {unset _text}
    catch {unset _tags}
    catch {unset _icons}
    catch {unset _states}
    catch {unset _images}
    catch {unset _indents}
    catch {unset _marked}
    catch {unset _selected}
    set _markers  ""
    set _posted   ""
    set _ucounter 0
    set _hcounter 0 

    foreach mark [$itk_component(list) mark names] {
        $itk_component(list) mark unset $mark
    }

    return
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: selection option ?uid uid...?
#
# Handles all operations controlling selections in the hierarchy.
# Selections may be cleared, added, removed, or queried.  The add and
# remove options accept a series of unique ids.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::selection {op args} {
    switch -- $op {
        clear {
            $itk_component(list) tag remove hilite 1.0 end
            catch {unset _selected}
	    return
        }
        add {
            foreach node $args {
                set _selected($node) 1
                catch {
                    $itk_component(list) tag add hilite \
			    "$node.first" "$node.last"
                }
            }
        }
        remove {
            foreach node $args {
                catch {
                    unset _selected($node)
                    $itk_component(list) tag remove hilite \
			    "$node.first" "$node.last"
                }
            }
        }
	get {
	    return [array names _selected]
	}
        default {
            error "bad selection operation \"$op\":\
                   should be add, remove, clear or get"
        }
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: mark option ?arg arg...?
#
# Handles all operations controlling marks in the hierarchy.  Marks may 
# be cleared, added, removed, or queried.  The add and remove options 
# accept a series of unique ids.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::mark {op args} {
    switch -- $op {
        clear {
            $itk_component(list) tag remove lowlite 1.0 end
            catch {unset _marked}
	    return
        }
        add {
            foreach node $args {
                set _marked($node) 1
                catch {
                    $itk_component(list) tag add lowlite \
			    "$node.first" "$node.last"
                }
            }
        }
        remove {
            foreach node $args {
                catch {
                    unset _marked($node)
                    $itk_component(list) tag remove lowlite \
			    "$node.first" "$node.last"
                }
            }
        }
	get {
	    return [array names _marked]
	}
        default {
            error "bad mark operation \"$op\":\
                   should be add, remove, clear or get"
        }
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: current
#
# Returns the node that was most recently selected by the right mouse
# button when the item menu was posted.  Usually used by the code
# in the item menu to figure out what item is being manipulated.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::current {} {
    return $_posted
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: expand node
#
# Expands the hierarchy beneath the specified node.  Since this can take
# a moment for large hierarchies, the cursor will be changed to a watch
# during the expansion.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::expand {node} {
    if {! [info exists _states($node)]} {
	error "bad expand node argument: \"$node\", the node doesn't exist"
    }

    if {!$_states($node) && \
	    (([lsearch $_tags($node) branch] != -1) || \
	     ([llength [_contents $node]] > 0))} {
        $itk_component(list) configure -state normal -cursor watch
        update

	#
	# Get the indentation level for the node.
	#
        set indent $_indents($node)

        set _markers ""
        $itk_component(list) mark set insert "$node:start"
        _drawLevel $node $indent

	#
	# Following the draw, all our markers need adjusting.
	#
        foreach {name index} $_markers {
            $itk_component(list) mark set $name $index
        }

	#
	# Set the image to be the open icon, denote the new state,
	# and set the cursor back to normal along with the state.
	#
	$_images($node) configure -image $itk_option(-openicon)

        set _states($node) 1

        $itk_component(list) configure -state disabled \
		-cursor $itk_option(-cursor)
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: collapse node
#
# Collapses the hierarchy beneath the specified node.  Since this can 
# take a moment for large hierarchies, the cursor will be changed to a 
# watch during the expansion.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::collapse {node} {
    if {! [info exists _states($node)]} {
	error "bad collapse node argument: \"$node\", the node doesn't exist"
    }

    if {[info exists _states($node)] && $_states($node) && \
	    (([lsearch $_tags($node) branch] != -1) || \
	     ([llength [_contents $node]] > 0))} {
        $itk_component(list) configure -state normal -cursor watch
	update

	_deselectSubNodes $node

        $itk_component(list) delete "$node:start" "$node:end"

	catch {$_images($node) configure -image $itk_option(-closedicon)}

        set _states($node) 0

        $itk_component(list) configure -state disabled \
	    -cursor $itk_option(-cursor)
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: toggle node
#
# Toggles the hierarchy beneath the specified node.  If the hierarchy
# is currently expanded, then it is collapsed, and vice-versa.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::toggle {node} {
    if {! [info exists _states($node)]} {
	error "bad toggle node argument: \"$node\", the node doesn't exist"
    }

    if {$_states($node)} {
        collapse $node
    } else {
        expand $node
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: prune node
#
# Removes a particular node from the hierarchy.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::prune {node} {
    #
    # While we're working, change the state and cursor so we can
    # edit the text and give a busy visual clue.
    #
    $itk_component(list) configure -state normal -cursor watch

    #
    # Recursively delete all the subnode information from our internal
    # arrays and remove all the tags.  
    #
    _deleteNodeInfo $node

    #
    # If the mark $node:end exists then the node has decendents so
    # so we'll remove from the mark $node:start to $node:end in order 
    # to delete all the subnodes below it in the text.  
    # 
    if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {
	$itk_component(list) delete $node:start $node:end
	$itk_component(list) mark unset $node:end
    } 

    #
    # Next we need to remove the node itself.  Using the ranges for
    # its tag we'll remove it from line start to the end plus one
    # character which takes us to the start of the next node.
    #
    foreach {start end} [$itk_component(list) tag ranges $node] {
	$itk_component(list) delete "$start linestart" "$end + 1 char"
    }

    #
    # Delete the tag for this node.
    #
    $itk_component(list) tag delete $node

    #
    # The node must be removed from the list of subnodes for its parent.
    # We don't really have a clean way to do upwards referencing, so
    # the dirty way will have to do.  We'll cycle through each node
    # and if this node is in its list of subnodes, we'll remove it.
    #
    foreach uid [array names _nodes] {
	if {[set index [lsearch $_nodes($uid) $node]] != -1} {
	    set _nodes($uid) [lreplace $_nodes($uid) $index $index]
	}
    }

    #
    # We're done, so change the state and cursor back to their 
    # original values.
    #
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: draw ?when?
#
# Performs a complete draw of the entire hierarchy.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::draw {{when -now}} {
    if {$when == "-eventually"} {
        if {$_pending == ""} {
            set _pending [after idle [itcl::code $this draw -now]]
        }
        return
    } elseif {$when != "-now"} {
        error "bad when option \"$when\": should be -eventually or -now"
    }
    $itk_component(list) configure -state normal -cursor watch
    update

    $itk_component(list) delete 1.0 end
    catch {unset _images}
    set _markers ""

    _drawLevel "" ""

    foreach {name index} $_markers {
        $itk_component(list) mark set $name $index
    }

    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
    set _pending ""
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: refresh node
#
# Performs a redraw of a specific node.  If that node is currently 
# not visible, then no action is taken.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::refresh {node} {
    if {! [info exists _nodes($node)]} {
	error "bad refresh node argument: \"$node\", the node doesn't exist"
    }

    
    if {! $_states($node)} {return}

    foreach parent [_getHeritage $node] {
	if {! $_states($parent)} {return}
    }

    $itk_component(list) configure -state normal -cursor watch
    $itk_component(list) delete $node:start $node:end

    set _markers ""
    $itk_component(list) mark set insert "$node:start"
    set indent $_indents($node)

    _drawLevel $node $indent

    foreach {name index} $_markers {
        $itk_component(list) mark set $name $index
    }

    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ------------------------------------------------------------------
# THIN WRAPPED TEXT METHODS:
#
# The following methods are thin wraps of standard text methods.
# Consult the Tk text man pages for functionallity and argument
# documentation.
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# PUBLIC METHOD: bbox index
#
# Returns four element list describing the bounding box for the list
# item at index
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::bbox {index} {
    return [$itk_component(list) bbox $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD compare index1 op index2
#
# Compare indices according to relational operator.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::compare {index1 op index2} {
    return [$itk_component(list) compare $index1 $op $index2]
}

# ------------------------------------------------------------------
# PUBLIC METHOD delete first ?last?
#
# Delete a range of characters from the text.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::delete {first {last {}}} {
    $itk_component(list) configure -state normal -cursor watch
    $itk_component(list) delete $first $last
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ------------------------------------------------------------------
# PUBLIC METHOD dump ?switches? index1 ?index2?
#
# Returns information about the contents of the text widget from 
# index1 to index2.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::dump {args} {
    return [eval $itk_component(list) dump $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD dlineinfo index
#
# Returns a five element list describing the area occupied by the
# display line containing index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::dlineinfo {index} {
    return [$itk_component(list) dlineinfo $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD get index1 ?index2?
#
# Return text from start index to end index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::get {index1 {index2 {}}} {
    return [$itk_component(list) get $index1 $index2]
}

# ------------------------------------------------------------------
# PUBLIC METHOD index index
#
# Return position corresponding to index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::index {index} {
    return [$itk_component(list) index $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD insert index chars ?tagList?
#
# Insert text at index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::insert {args} {
    $itk_component(list) configure -state normal -cursor watch
    eval $itk_component(list) insert $args
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ------------------------------------------------------------------
# PUBLIC METHOD scan option args
#
# Implements scanning on texts.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::scan {option args} {
    eval $itk_component(list) scan $option $args
}

# ------------------------------------------------------------------
# PUBLIC METHOD search ?switches? pattern index ?varName?
#
# Searches the text for characters matching a pattern.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::search {args} {
    return [eval $itk_component(list) search $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD see index
#
# Adjusts the view in the window so the character at index is 
# visible.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::see {index} {
    $itk_component(list) see $index
}

# ------------------------------------------------------------------
# PUBLIC METHOD tag option ?arg arg ...?
#
# Manipulate tags dependent on options.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::tag {op args} {
    return [eval $itk_component(list) tag $op $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD window option ?arg arg ...?
#
# Manipulate embedded windows.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::window {option args} {
    return [eval $itk_component(list) window $option $args]
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: xview args
#
# Thin wrap of the text widget's xview command.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::xview {args} {
    return [eval itk_component(list) xview $args]
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: yview args
#
# Thin wrap of the text widget's yview command.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::yview {args} {
    return [eval $itk_component(list) yview $args]
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: expanded node
#
# Tells if a node is expanded or collapsed
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::expanded {node} {
    if {! [info exists _states($node)]} {
	error "bad collapse node argument: \"$node\", the node doesn't exist"
    }
    
    return $_states($node)
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: expState
#
# Returns a list of all expanded nodes
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::expState {} {
    set nodes [_contents ""]
    set open ""
    set i 0
    while {1} {
	if {[info exists _states([lindex $nodes $i])] &&
	$_states([lindex $nodes $i])} {
	    lappend open [lindex $nodes $i]
	    foreach child [_contents [lindex $nodes $i]] {
		lappend nodes $child
	    }
	}
	incr i
	if {$i >= [llength $nodes]} {break}
    }
    
    return $open
}

# ------------------------------------------------------------------
#                       PROTECTED METHODS
# ------------------------------------------------------------------

# ----------------------------------------------------------------------
# PROTECTED METHOD: _drawLevel node indent
#
# Used internally by draw to draw one level of the hierarchy.
# Draws all of the nodes under node, using the indent string to
# indent nodes.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_drawLevel {node indent} {
    lappend _markers "$node:start" [$itk_component(list) index insert]
    set bg [$itk_component(list) cget -background]

    #
    # Obtain the list of subnodes for this node and cycle through
    # each one displaying it in the hierarchy.
    #
    foreach child [_contents $node] {
	set _images($child) "$itk_component(list).hicon[incr _hcounter]"

        if {![info exists _states($child)]} {
            set _states($child) $itk_option(-expanded)
        }

	#
	# Check the user tags to see if they have been kind enough
	# to tell us ahead of time what type of node we are dealing
	# with branch or leaf.  If they neglected to do so, then
	# get the contents of the child node to see if it has children
	# itself.
	#
	set display 0

	if {[lsearch $_tags($child) leaf] != -1} {
	    set type leaf
	} elseif {[lsearch $_tags($child) branch] != -1} {
	    set type branch
	} else {
	    if {[llength [_contents $child]] == 0} {
		set type leaf
	    } else {
		set type branch
	    }
	}

	#
	# Now that we know the type of node, branch or leaf, we know
	# the type of icon to use.
	#
	if {$type == "leaf"} {
            set icon $itk_option(-nodeicon)
            eval $_filterCode
	} else {
            if {$_states($child)} {
                set icon $itk_option(-openicon)
            } else {
                set icon $itk_option(-closedicon)
            }
            set display 1
	}

	#
	# If display is set then we're going to be drawing this node.
	# Save off the indentation level for this node and do the indent.
	#
	if {$display} {
	    set _indents($child) "$indent\t"
	    $itk_component(list) insert insert $indent

	    #
	    # Add the branch or leaf icon and setup a binding to toggle
	    # its expanded/collapsed state.
	    #
	    label $_images($child) -image $icon -background $bg 
	    # DRH - enhanced and added features that handle image clicking,
	    # double clicking, and right clicking behavior
	    bind $_images($child) <ButtonPress-1> \
	      "[itcl::code $this toggle $child]; [itcl::code $this _imageSelect $child]"
	    bind $_images($child) <Double-1> [itcl::code $this _imageDblClick $child]
	    bind $_images($child) <ButtonPress-3> \
	      [itcl::code $this _imagePost $child $_images($child) $type %x %y]
	    $itk_component(list) window create insert -window $_images($child)

	    #
	    # If any user icons exist then draw them as well.  The little
	    # regexp is just to check and see if they've passed in a
	    # command which needs to be evaluated as opposed to just
	    # a variable.  Also, attach a binding to call them if their
	    # icon is selected.
	    #
	    if {[info exists _icons($child)]} {
		foreach image $_icons($child) {
		    set wid "$itk_component(list).uicon[incr _ucounter]"

		    if {[regexp {\[.*\]} $image]} {
			eval label $wid -image $image -background $bg 
		    } else {
			label $wid -image $image -background $bg 
		    }

		    # DRH - this will bind events to the icons to allow
		    # clicking, double clicking, and right clicking actions.
		    bind $wid <ButtonPress-1> \
			    [itcl::code $this _iconSelect $child $image]
		    bind $wid <Double-1> \
			    [itcl::code $this _iconDblSelect $child $image]
		    bind $wid <ButtonPress-3> \
			    [itcl::code $this _imagePost $child $wid $type %x %y]
		    $itk_component(list) window create insert -window $wid
		}
	    }

	    #
	    # Create the list of tags to be applied to the text.  Start
	    # out with a tag of "info" and append "hilite" if the node
	    # is currently selected, finally add the tags given by the
	    # user.
	    #
	    set texttags [list "info" $child]

	    if {[info exists _selected($child)]} {
		lappend texttags hilite
	    } 

            # The following conditional added for SF ticket #600941.
            if {[info exists _marked($child)]} { 
                lappend texttags lowlite 
            } 

	    foreach tag $_tags($child) {
		lappend texttags $tag
	    }

	    #
	    # Insert the text for the node along with the tags and 
	    # append to the markers the start of this node.  The text
	    # has been broken at newlines into a list.  We'll make sure
	    # that each line is at the same indentation position.
	    #
	    set firstline 1
	    foreach line $_text($child) {
		if {$firstline} {
		    $itk_component(list) insert insert " "
		} else {
		    $itk_component(list) insert insert "$indent\t"
		}

		$itk_component(list) insert insert $line $texttags "\n"
		set firstline 0
	    }

	    $itk_component(list) tag raise $child
	    lappend _markers "$child:start" [$itk_component(list) index insert]

	    #
	    # If the state of the node is open, proceed to draw the next 
	    # node below it in the hierarchy.
	    #
	    if {$_states($child)} {
		_drawLevel $child "$indent\t"
	    }
	}
    }

    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]]]} ...}
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_contents {uid} {
    if {$itk_option(-alwaysquery)} {
    } else {
      if {[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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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 [lindex $node end] 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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------------
itcl::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
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_isInternalTag {tag} {
   set ii [expr {[lsearch -exact {info hilite lowlite unknown} $tag] != -1}];
   return $ii;
}

# ----------------------------------------------------------------------
# PRIVATE METHOD: _configureTags
#
# This method added to fix SF ticket #596111.  When the -querycommand
# is reset after initial construction, the text component loses its
# tag configuration.  This method resets the hilite, lowlite, and info
# tags.  csmith: 9/5/02
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_configureTags {} {
  tag configure hilite -background $itk_option(-selectbackground) \
    -foreground $itk_option(-selectforeground)
  tag configure lowlite -background $itk_option(-markbackground) \
    -foreground $itk_option(-markforeground)
  tag configure info -font $itk_option(-font) -spacing1 6
}