arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/tests/entry.test

@@ -0,0 +1,173 @@
+if { [lsearch [package names] tcltest] == -1 } {
+	package require tcltest
+	namespace import tcltest::*
+}
+lappend auto_path /home/ericm/bwidget
+package require BWidget
+
+option add *Entry.borderWidth 2
+option add *Entry.highlightThickness 2
+option add *Entry.font {Helvetica -12}
+option add *Entry.relief sunken
+
+Entry .e
+pack .e
+update
+set i 0
+foreach test {
+    {-background #ff0000 #ff0000 non-existent \
+	    {unknown color name "non-existent"}}
+    {-bd 4 4 bad Value {bad screen distance "badValue"}}
+    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
+    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+    {-command foo foo {} {}}
+    {-disabledforeground blue blue non-existent \
+	    {unknown color name "non-existent"}}
+    {-editable false false shazbot {expected boolean value but got "shazbot"}}
+    {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
+    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
+    {-font {Helvetica 12 italic} {Helvetica 12 italic} {} \
+	    {font "" doesn't exist}}
+    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
+    {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
+    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
+    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
+    {-highlightthickness -2 0 {} {}}
+    {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
+    {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
+    {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
+    {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
+    {-justify right right bogus \
+	    {bad justification "bogus": must be left, right, or center}}
+    {-relief groove groove 1.5 \
+	    {bad relief "1.5": must be flat, groove, raised, ridge,\
+	    solid, or sunken}}
+    {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
+    {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+    {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
+    {-show * * {} {}}
+    {-state normal normal bogus \
+	    {bad state "bogus": must be disabled or normal}}
+    {-takefocus "any string" "any string" {} {}}
+    {-text foobar foobar {} {}}
+    {-textvariable i i {} {}}
+    {-width 402 402 3p {expected integer but got "3p"}}
+    {-xscrollcommand {Some command} {Some command} {} {}}
+} {
+    set name [lindex $test 0]
+    test entry-1.$i {configuration options} {
+        .e configure $name [lindex $test 1]
+        list [lindex [.e configure $name] 4] [.e cget $name]
+    } [list [lindex $test 2] [lindex $test 2]]
+    incr i
+}
+destroy .e
+
+test Entry-2.1 {Entry} {
+    list [catch {Entry} msg] $msg
+} {1 {no value given for parameter "path" to "Entry"}}
+test Entry-2.2 {Entry} {
+    list [catch {Entry gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test Entry-2.3 {Entry procedure} {
+    Entry .e
+    set res [list [winfo exists .e] [winfo class .e] [info commands .e]]
+    destroy .e
+    set res
+} {1 Entry .e}
+test Entry-2.4 {Entr procedure} {
+    list [catch {Entry .e -gorp foo} msg] $msg [winfo exists .e] \
+            [info commands .e]
+} {1 {unknown option "-gorp"} 0 {}}
+    
+test Entry-3.1 {disabled state grays widget} {
+    Entry .e -disabledforeground blue -foreground red -state normal
+    set res [list [.e cget -foreground] [.e cget -disabledforeground] \
+	    [.e:cmd cget -foreground]]
+    .e configure -state disabled
+    lappend res [.e:cmd cget -foreground]
+    .e configure -state normal
+    lappend res [.e:cmd cget -foreground]
+    destroy .e
+    set res
+} {red blue red blue red}
+test Entry-3.2 {changing disabledforeground of an enabled entry} {
+    Entry .e -disabledforeground blue -foreground red -state normal
+    set res [list [.e cget -foreground] [.e cget -disabledforeground] \
+	    [.e:cmd cget -foreground]]
+    .e configure -disabledforeground green
+    lappend res [.e:cmd cget -foreground]
+    destroy .e
+    set res
+} {red blue red red}
+test Entry-3.3 {changing normal foreground of a disabled entry} {
+    Entry .e -disabledforeground blue -foreground red -state disabled
+    set res [list [.e cget -foreground] [.e cget -disabledforeground] \
+	    [.e:cmd cget -foreground]]
+    .e configure -foreground green
+    lappend res [.e:cmd cget -foreground]
+    destroy .e
+    set res
+} {red blue blue blue}
+test Entry-3.4 {changing disabled foreground of a disabled entry} {
+    Entry .e -disabledforeground blue -foreground red -state disabled
+    set res [list [.e cget -foreground] [.e cget -disabledforeground] \
+	    [.e:cmd cget -foreground]]
+    .e configure -disabledforeground green
+    lappend res [.e:cmd cget -foreground]
+    destroy .e
+    set res
+} {red blue blue green}
+
+test Entry-4.1 {editable flag enables/disables editing} {
+    Entry .e -editable true
+    set res [expr {[lsearch [bindtags .e] BwDisabledEntry] == -1}]
+    .e configure -editable false
+    lappend res [expr {[lsearch [bindtags .e] BwDisabledEntry] != -1}]
+    destroy .e
+    set res
+} {1 1}
+test Entry-4.2 {editable flag does not impact foreground color} {
+    Entry .e -editable 1 -foreground red -disabledforeground blue -state normal
+    set res [list [.e:cmd cget -foreground]]
+    .e configure -editable false
+    lappend res [.e:cmd cget -foreground]
+    destroy .e
+    set res
+} {red red}
+test Entry-4.3 {editable flag changes cursor} {
+    Entry .e -editable 1
+    set res [list [.e:cmd cget -cursor]]
+    .e configure -editable 0
+    lappend res [.e:cmd cget -cursor]
+    destroy .e
+    set res
+} [list xterm left_ptr]
+
+test Entry-5.1 {-text flag gets entry text} {
+    Entry .e
+    .e delete 0 end
+    .e insert end foobar
+    set res [.e cget -text]
+    destroy .e
+    set res
+} foobar
+test Entry-5.2 {-text flag sets entry text} {
+    Entry .e
+    .e delete 0 end
+    .e configure -text barbaz
+    set res [.e get]
+    destroy .e
+    set res
+} barbaz
+
+test Entry-6.1 {-command works} {
+    set ::foo 0
+    Entry .e -command {incr ::foo}
+    Entry::invoke .e
+    destroy .e
+    set ::foo
+} 1
+
+tcltest::cleanupTests
+exit

data/tcl/BWidget-1.8.0/titleframe.tcl

@@ -0,0 +1,170 @@
+# ------------------------------------------------------------------------------
+#  titleframe.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - TitleFrame::create
+#     - TitleFrame::configure
+#     - TitleFrame::cget
+#     - TitleFrame::getframe
+#     - TitleFrame::_place
+# ------------------------------------------------------------------------------
+
+namespace eval TitleFrame {
+    Widget::define TitleFrame titleframe
+
+    Widget::declare TitleFrame {
+        {-relief      TkResource groove 0 frame}
+        {-borderwidth TkResource 2      0 frame}
+        {-font        TkResource ""     0 label}
+        {-foreground  TkResource ""     0 label}
+        {-state       TkResource ""     0 label}
+        {-background  TkResource ""     0 frame}
+        {-text        String     ""     0}
+        {-ipad        Int        4      0 "%d >=0"}
+        {-side        Enum       left   0 {left center right}}
+        {-baseline    Enum       center 0 {top center bottom}}
+        {-fg          Synonym    -foreground}
+        {-bg          Synonym    -background}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap TitleFrame "" :cmd {-background {}}
+    Widget::addmap TitleFrame "" .l   {
+    	-background {} -foreground {} -text {} -font {}
+    }
+    Widget::addmap TitleFrame "" .l   {-state {}}
+    Widget::addmap TitleFrame "" .p   {-background {}}
+    Widget::addmap TitleFrame "" .b   {
+    	-background {} -relief {} -borderwidth {}
+    }
+    Widget::addmap TitleFrame "" .b.p {-background {}}
+    Widget::addmap TitleFrame "" .f   {-background {}}
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::create
+# ------------------------------------------------------------------------------
+proc TitleFrame::create { path args } {
+    Widget::init TitleFrame $path $args
+
+    set frame  [eval [list frame $path] [Widget::subcget $path :cmd] \
+	    -class TitleFrame -relief flat -bd 0 -highlightthickness 0]
+
+    set padtop [eval [list frame $path.p] [Widget::subcget $path :cmd] \
+	    -relief flat -borderwidth 0]
+    set border [eval [list frame $path.b] [Widget::subcget $path .b] -highlightthickness 0]
+    set label  [eval [list label $path.l] [Widget::subcget $path .l] \
+                    -highlightthickness 0 \
+                    -relief flat \
+                    -bd     0 -padx 2 -pady 0]
+    set padbot [eval [list frame $border.p] [Widget::subcget $path .p] \
+	    -relief flat -bd 0 -highlightthickness 0]
+    set frame  [eval [list frame $path.f] [Widget::subcget $path .f] \
+	    -relief flat -bd 0 -highlightthickness 0]
+    set height [winfo reqheight $label]
+
+    switch [Widget::getoption $path -side] {
+        left   { set relx 0.0; set x 5;  set anchor nw }
+        center { set relx 0.5; set x 0;  set anchor n  }
+        right  { set relx 1.0; set x -5; set anchor ne }
+    }
+    set bd [Widget::getoption $path -borderwidth]
+    switch [Widget::getoption $path -baseline] {
+        top    {
+	    set y    0
+	    set htop $height
+	    set hbot 1
+	}
+        center {
+	    set y    0
+	    set htop [expr {$height/2}]
+	    set hbot [expr {$height/2+$height%2+1}]
+	}
+        bottom {
+	    set y    [expr {$bd+1}]
+	    set htop 1
+	    set hbot $height
+	}
+    }
+    $padtop configure -height $htop
+    $padbot configure -height $hbot
+
+    set pad [Widget::getoption $path -ipad]
+    pack $padbot -side top -fill x
+    pack $frame  -in $border -fill both -expand yes -padx $pad -pady $pad
+
+    pack $padtop -side top -fill x
+    pack $border -fill both -expand yes
+
+    place $label -relx $relx -x $x -anchor $anchor -y $y
+
+    bind $label <Configure> [list TitleFrame::_place $path]
+    bind $path  <Destroy>   [list Widget::destroy %W]
+
+    return [Widget::create TitleFrame $path]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::configure
+# ------------------------------------------------------------------------------
+proc TitleFrame::configure { path args } {
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -ipad pad] } {
+        pack configure $path.f -padx $pad -pady $pad
+    }
+    if { [Widget::hasChanged $path -borderwidth val] |
+         [Widget::hasChanged $path -font        val] |
+         [Widget::hasChanged $path -side        val] |
+         [Widget::hasChanged $path -baseline    val] } {
+        _place $path
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::cget
+# ------------------------------------------------------------------------------
+proc TitleFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::getframe
+# ------------------------------------------------------------------------------
+proc TitleFrame::getframe { path } {
+    return $path.f
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command TitleFrame::_place
+# ------------------------------------------------------------------------------
+proc TitleFrame::_place { path } {
+    set height [winfo height $path.l]
+    switch [Widget::getoption $path -side] {
+        left    { set relx 0.0; set x 10;  set anchor nw }
+        center  { set relx 0.5; set x 0;   set anchor n  }
+        right   { set relx 1.0; set x -10; set anchor ne }
+    }
+    set bd [Widget::getoption $path -borderwidth]
+    switch [Widget::getoption $path -baseline] {
+        top    { set htop $height; set hbot 1; set y 0 }
+        center { set htop [expr {$height/2}]; set hbot [expr {$height/2+$height%2+1}]; set y 0 }
+        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
+    }
+    $path.p   configure -height $htop
+    $path.b.p configure -height $hbot
+
+    place $path.l -relx $relx -x $x -anchor $anchor -y $y
+}
+
+
+
+

data/tcl/BWidget-1.8.0/tree.tcl

@@ -0,0 +1,2228 @@
+# ----------------------------------------------------------------------------
+#  tree.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: tree.tcl,v 1.54 2006/09/28 15:46:06 dev_null42a Exp $
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - Tree::create
+#     - Tree::configure
+#     - Tree::cget
+#     - Tree::insert
+#     - Tree::itemconfigure
+#     - Tree::itemcget
+#     - Tree::bindArea
+#     - Tree::bindText
+#     - Tree::bindImage
+#     - Tree::delete
+#     - Tree::move
+#     - Tree::reorder
+#     - Tree::selection
+#     - Tree::exists
+#     - Tree::parent
+#     - Tree::index
+#     - Tree::nodes
+#     - Tree::see
+#     - Tree::opentree
+#     - Tree::closetree
+#     - Tree::edit
+#     - Tree::xview
+#     - Tree::yview
+#     - Tree::_update_edit_size
+#     - Tree::_destroy
+#     - Tree::_see
+#     - Tree::_recexpand
+#     - Tree::_subdelete
+#     - Tree::_update_scrollregion
+#     - Tree::_cross_event
+#     - Tree::_draw_node
+#     - Tree::_draw_subnodes
+#     - Tree::_update_nodes
+#     - Tree::_draw_tree
+#     - Tree::_redraw_tree
+#     - Tree::_redraw_selection
+#     - Tree::_redraw_idle
+#     - Tree::_drag_cmd
+#     - Tree::_drop_cmd
+#     - Tree::_over_cmd
+#     - Tree::_auto_scroll
+#     - Tree::_scroll
+# ----------------------------------------------------------------------------
+
+namespace eval Tree {
+    Widget::define Tree tree DragSite DropSite DynamicHelp
+
+    namespace eval Node {
+        Widget::declare Tree::Node {
+            {-text       String     ""      0}
+            {-font       TkResource ""      0 listbox}
+            {-image      TkResource ""      0 label}
+            {-window     String     ""      0}
+            {-fill       TkResource black   0 {listbox -foreground}}
+            {-data       String     ""      0}
+            {-open       Boolean    0       0}
+	    {-selectable Boolean    1       0}
+            {-drawcross  Enum       auto    0 {auto always never allways}}
+	    {-padx       Int        -1      0 "%d >= -1"}
+	    {-deltax     Int        -1      0 "%d >= -1"}
+	    {-anchor     String     "w"     0 ""}
+        }
+    }
+
+    DynamicHelp::include Tree::Node balloon
+
+    Widget::tkinclude Tree canvas .c \
+	    remove     {
+	-insertwidth -insertbackground -insertborderwidth -insertofftime
+	-insertontime -selectborderwidth -closeenough -confine -scrollregion
+	-xscrollincrement -yscrollincrement -width -height
+    } \
+	    initialize {
+	-relief sunken -borderwidth 2 -takefocus 1
+	-highlightthickness 1 -width 200
+    }
+
+    Widget::declare Tree {
+        {-deltax           Int 10 0 "%d >= 0"}
+        {-deltay           Int 15 0 "%d >= 0"}
+        {-padx             Int 20 0 "%d >= 0"}
+        {-background       TkResource "" 0 listbox}
+        {-selectbackground TkResource "" 0 listbox}
+        {-selectforeground TkResource "" 0 listbox}
+	{-selectcommand    String     "" 0}
+        {-width            TkResource "" 0 listbox}
+        {-height           TkResource "" 0 listbox}
+        {-selectfill       Boolean 0  0}
+        {-showlines        Boolean 1  0}
+        {-linesfill        TkResource black  0 {listbox -foreground}}
+        {-linestipple      TkResource ""     0 {label -bitmap}}
+	{-crossfill        TkResource black  0 {listbox -foreground}}
+        {-redraw           Boolean 1  0}
+        {-opencmd          String  "" 0}
+        {-closecmd         String  "" 0}
+        {-dropovermode     Flag    "wpn" 0 "wpn"}
+        {-bg               Synonym -background}
+
+        {-crossopenimage    String  ""  0}
+        {-crosscloseimage   String  ""  0}
+        {-crossopenbitmap   String  ""  0}
+        {-crossclosebitmap  String  ""  0}
+    }
+
+    DragSite::include Tree "TREE_NODE" 1
+    DropSite::include Tree {
+        TREE_NODE {copy {} move {}}
+    }
+
+    Widget::addmap Tree "" .c {-deltay -yscrollincrement}
+
+    # Trees on windows have a white (system window) background
+    if { $::tcl_platform(platform) == "windows" } {
+	option add *Tree.c.background SystemWindow widgetDefault
+	option add *TreeNode.fill SystemWindowText widgetDefault
+    }
+
+    bind Tree <FocusIn>   [list after idle {BWidget::refocus %W %W.c}]
+    bind Tree <Destroy>   [list Tree::_destroy %W]
+    bind Tree <Configure> [list Tree::_update_scrollregion %W]
+
+
+    bind TreeSentinalStart <Button-1> {
+	if { $::Tree::sentinal(%W) } {
+	    set ::Tree::sentinal(%W) 0
+	    break
+	}
+    }
+
+    bind TreeSentinalEnd <Button-1> {
+	set ::Tree::sentinal(%W) 0
+    }
+
+    bind TreeFocus <Button-1> [list focus %W]
+
+    variable _edit
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::create
+# ----------------------------------------------------------------------------
+proc Tree::create { path args } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::init Tree $path $args
+    set ::Tree::sentinal($path.c) 0
+
+    if {[Widget::cget $path -crossopenbitmap] == ""} {
+        set file [file join $::BWIDGET::LIBRARY images "minus.xbm"]
+        Widget::configure $path [list -crossopenbitmap @$file]
+    }
+    if {[Widget::cget $path -crossclosebitmap] == ""} {
+        set file [file join $::BWIDGET::LIBRARY images "plus.xbm"]
+        Widget::configure $path [list -crossclosebitmap @$file]
+    }
+
+    set data(root)         {{}}
+    set data(selnodes)     {}
+    set data(upd,level)    0
+    set data(upd,nodes)    {}
+    set data(upd,afterid)  ""
+    set data(dnd,scroll)   ""
+    set data(dnd,afterid)  ""
+    set data(dnd,selnodes) {}
+    set data(dnd,node)     ""
+
+    frame $path -class Tree -bd 0 -highlightthickness 0 -relief flat \
+	    -takefocus 0
+    # For 8.4+ we don't want to inherit the padding
+    catch {$path configure -padx 0 -pady 0}
+    eval [list canvas $path.c] [Widget::subcget $path .c] -xscrollincrement 8
+    bindtags $path.c [list TreeSentinalStart TreeFocus $path.c Canvas \
+	    [winfo toplevel $path] all TreeSentinalEnd]
+    pack $path.c -expand yes -fill both
+    $path.c bind cross <ButtonPress-1> [list Tree::_cross_event $path]
+
+    # Added by ericm@scriptics.com
+    # These allow keyboard traversal of the tree
+    bind $path.c <KeyPress-Up>    [list Tree::_keynav up $path]
+    bind $path.c <KeyPress-Down>  [list Tree::_keynav down $path]
+    bind $path.c <KeyPress-Right> [list Tree::_keynav right $path]
+    bind $path.c <KeyPress-Left>  [list Tree::_keynav left $path]
+    bind $path.c <KeyPress-space> [list +Tree::_keynav space $path]
+
+    # These allow keyboard control of the scrolling
+    bind $path.c <Control-KeyPress-Up>    [list $path.c yview scroll -1 units]
+    bind $path.c <Control-KeyPress-Down>  [list $path.c yview scroll  1 units]
+    bind $path.c <Control-KeyPress-Left>  [list $path.c xview scroll -1 units]
+    bind $path.c <Control-KeyPress-Right> [list $path.c xview scroll  1 units]
+    # ericm@scriptics.com
+
+    BWidget::bindMouseWheel $path.c
+
+    DragSite::setdrag $path $path.c Tree::_init_drag_cmd \
+	    [Widget::cget $path -dragendcmd] 1
+    DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd 1
+
+    Widget::create Tree $path
+
+    set w [Widget::cget $path -width]
+    set h [Widget::cget $path -height]
+    set dy [Widget::cget $path -deltay]
+    $path.c configure -width [expr {$w*8}] -height [expr {$h*$dy}]
+
+    # ericm
+    # Bind <Button-1> to select the clicked node -- no reason not to, right?
+
+    ## Bind button 1 to select the node via the _mouse_select command.
+    ## This command will generate the proper <<TreeSelect>> virtual event
+    ## when necessary.
+    set selectcmd Tree::_mouse_select
+    Tree::bindText  $path <Button-1>         [list $selectcmd $path set]
+    Tree::bindImage $path <Button-1>         [list $selectcmd $path set]
+    Tree::bindText  $path <Control-Button-1> [list $selectcmd $path toggle]
+    Tree::bindImage $path <Control-Button-1> [list $selectcmd $path toggle]
+
+    # Add sentinal bindings for double-clicking on items, to handle the 
+    # gnarly Tk bug wherein:
+    # ButtonClick
+    # ButtonClick
+    # On a canvas item translates into button click on the item, button click
+    # on the canvas, double-button on the item, single button click on the
+    # canvas (which can happen if the double-button on the item causes some
+    # other event to be handled in between when the button clicks are examined
+    # for the canvas)
+    $path.c bind TreeItemSentinal <Double-Button-1> \
+	[list set ::Tree::sentinal($path.c) 1]
+    # ericm
+
+    return $path
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::configure
+# ----------------------------------------------------------------------------
+proc Tree::configure { path args } {
+    variable $path
+    upvar 0  $path data
+
+    set res [Widget::configure $path $args]
+
+    set ch1 [expr {[Widget::hasChanged $path -deltax val] |
+                   [Widget::hasChanged $path -deltay dy]  |
+                   [Widget::hasChanged $path -padx val]   |
+                   [Widget::hasChanged $path -showlines val]}]
+
+    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
+                   [Widget::hasChanged $path -selectforeground val]}]
+
+    if { [Widget::hasChanged $path -linesfill   fill] |
+         [Widget::hasChanged $path -linestipple stipple] } {
+        $path.c itemconfigure line  -fill $fill -stipple $stipple
+    }
+
+    if { [Widget::hasChanged $path -crossfill fill] } {
+        $path.c itemconfigure cross -foreground $fill
+    }
+
+    if {[Widget::hasChanged $path -selectfill fill]} {
+	# Make sure that the full-width boxes have either all or none
+	# of the standard node bindings
+	if {$fill} {
+	    foreach event [$path.c bind "node"] {
+		$path.c bind "box" $event [$path.c bind "node" $event]
+	    }
+	} else {
+	    foreach event [$path.c bind "node"] {
+		$path.c bind "box" $event {}
+	    }
+	}
+    }
+
+    if { $ch1 } {
+        _redraw_idle $path 3
+    } elseif { $ch2 } {
+        _redraw_idle $path 1
+    }
+
+    if { [Widget::hasChanged $path -height h] } {
+        $path.c configure -height [expr {$h*$dy}]
+    }
+    if { [Widget::hasChanged $path -width w] } {
+        $path.c configure -width [expr {$w*8}]
+    }
+
+    if { [Widget::hasChanged $path -redraw bool] && $bool } {
+        set upd $data(upd,level)
+        set data(upd,level) 0
+        _redraw_idle $path $upd
+    }
+
+    set force [Widget::hasChanged $path -dragendcmd dragend]
+    DragSite::setdrag $path $path.c Tree::_init_drag_cmd $dragend $force
+    DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd
+
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::cget
+# ----------------------------------------------------------------------------
+proc Tree::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::insert
+# ----------------------------------------------------------------------------
+proc Tree::insert { path index parent node args } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    set node [Widget::nextIndex $path $node]
+
+    if { [info exists data($node)] } {
+        return -code error "node \"$node\" already exists"
+    }
+    if { ![info exists data($parent)] } {
+        return -code error "node \"$parent\" does not exist"
+    }
+
+    Widget::init Tree::Node $path.$node $args
+    if {[string equal $index "end"]} {
+        lappend data($parent) $node
+    } else {
+        incr index
+        set data($parent) [linsert $data($parent) $index $node]
+    }
+    set data($node) [list $parent]
+
+    if { [string equal $parent "root"] } {
+        _redraw_idle $path 3
+    } elseif { [visible $path $parent] } {
+        # parent is visible...
+        if { [Widget::getMegawidgetOption $path.$parent -open] } {
+            # ...and opened -> redraw whole
+            _redraw_idle $path 3
+        } else {
+            # ...and closed -> redraw cross
+            lappend data(upd,nodes) $parent 8
+            _redraw_idle $path 2
+        }
+    }
+
+    return $node
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::itemconfigure
+# ----------------------------------------------------------------------------
+proc Tree::itemconfigure { path node args } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [string equal $node "root"] || ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+
+    set result [Widget::configure $path.$node $args]
+
+    _set_help $path $node
+
+    if { [visible $path $node] } {
+        set lopt   {}
+        set flag   0
+        foreach opt {-window -image -drawcross -font -text -fill} {
+            set flag [expr {$flag << 1}]
+            if { [Widget::hasChanged $path.$node $opt val] } {
+                set flag [expr {$flag | 1}]
+            }
+        }
+
+        if { [Widget::hasChanged $path.$node -open val] } {
+            if {[llength $data($node)] > 1} {
+                # node have subnodes - full redraw
+                _redraw_idle $path 3
+            } else {
+                # force a redraw of the plus/minus sign
+                set flag [expr {$flag | 8}]
+            }
+        }
+
+	if {$data(upd,level) < 3 && [Widget::hasChanged $path.$node -padx x]} {
+	    _redraw_idle $path 3
+	}
+
+	if { $data(upd,level) < 3 && $flag } {
+            if { [set idx [lsearch -exact $data(upd,nodes) $node]] == -1 } {
+                lappend data(upd,nodes) $node $flag
+            } else {
+                incr idx
+                set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}]
+                set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag]
+            }
+            _redraw_idle $path 2
+        }
+    }
+    return $result
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::itemcget
+# ----------------------------------------------------------------------------
+proc Tree::itemcget { path node option } {
+    # Instead of upvar'ing $path as data for this test, just directly refer to
+    # it, as that is faster.
+    set node [_node_name $path $node]
+    if { [string equal $node "root"] || \
+	    ![info exists ::Tree::${path}($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+
+    return [Widget::cget $path.$node $option]
+}
+
+# ----------------------------------------------------------------------------
+# Command Tree::bindArea
+# ----------------------------------------------------------------------------
+proc Tree::bindArea { path event script } {
+    bind $path.c $event $script
+}
+
+# ----------------------------------------------------------------------------
+#  Command Tree::bindText
+# ----------------------------------------------------------------------------
+proc Tree::bindText { path event script } {
+    if {[string length $script]} {
+	append script " \[Tree::_get_node_name [list $path] current 2\]"
+    }
+    $path.c bind "node" $event $script
+    if {[Widget::getoption $path -selectfill]} {
+	$path.c bind "box" $event $script
+    } else {
+	$path.c bind "box" $event {}
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::bindImage
+# ----------------------------------------------------------------------------
+proc Tree::bindImage { path event script } {
+    if {[string length $script]} {
+	append script " \[Tree::_get_node_name [list $path] current 2\]"
+    }
+    $path.c bind "img" $event $script
+    if {[Widget::getoption $path -selectfill]} {
+	$path.c bind "box" $event $script
+    } else {
+	$path.c bind "box" $event {}
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::delete
+# ----------------------------------------------------------------------------
+proc Tree::delete { path args } {
+    variable $path
+    upvar 0  $path data
+
+    set sel 0
+    foreach lnodes $args {
+	foreach node $lnodes {
+            set node [_node_name $path $node]
+	    if { ![string equal $node "root"] && [info exists data($node)] } {
+		set parent [lindex $data($node) 0]
+		set idx	   [lsearch -exact $data($parent) $node]
+		set data($parent) [lreplace $data($parent) $idx $idx]
+		incr sel [_subdelete $path [list $node]]
+	    }
+	}
+    }
+    if {$sel} {
+	# if selection changed, call the selectcommand
+	__call_selectcmd $path
+    }
+
+    _redraw_idle $path 3
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::move
+# ----------------------------------------------------------------------------
+proc Tree::move { path parent node index } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [string equal $node "root"] || ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+    if { ![info exists data($parent)] } {
+        return -code error "node \"$parent\" does not exist"
+    }
+    set p $parent
+    while { ![string equal $p "root"] } {
+        if { [string equal $p $node] } {
+            return -code error "node \"$parent\" is a descendant of \"$node\""
+        }
+        set p [parent $path $p]
+    }
+
+    set oldp        [lindex $data($node) 0]
+    set idx         [lsearch -exact $data($oldp) $node]
+    set data($oldp) [lreplace $data($oldp) $idx $idx]
+    set data($node) [concat [list $parent] [lrange $data($node) 1 end]]
+    if { [string equal $index "end"] } {
+        lappend data($parent) $node
+    } else {
+        incr index
+        set data($parent) [linsert $data($parent) $index $node]
+    }
+    if { ([string equal $oldp "root"] ||
+          ([visible $path $oldp] && [Widget::getoption $path.$oldp   -open])) ||
+         ([string equal $parent "root"] ||
+          ([visible $path $parent] && [Widget::getoption $path.$parent -open])) } {
+        _redraw_idle $path 3
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::reorder
+# ----------------------------------------------------------------------------
+proc Tree::reorder { path node neworder } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+    set children [lrange $data($node) 1 end]
+    if { [llength $children] } {
+        set children [BWidget::lreorder $children $neworder]
+        set data($node) [linsert $children 0 [lindex $data($node) 0]]
+        if { [visible $path $node] && [Widget::getoption $path.$node -open] } {
+            _redraw_idle $path 3
+        }
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::selection
+# ----------------------------------------------------------------------------
+proc Tree::selection { path cmd args } {
+    variable $path
+    upvar 0  $path data
+
+    switch -- $cmd {
+	toggle {
+            foreach node $args {
+                set node [_node_name $path $node]
+                if {![info exists data($node)]} {
+		    return -code error \
+			    "$path selection toggle: Cannot toggle unknown node \"$node\"."
+		}
+	    }
+            foreach node $args {
+                set node [_node_name $path $node]
+		if {[$path selection includes $node]} {
+		    $path selection remove $node
+		} else {
+		    $path selection add $node
+		}
+            }
+	}
+        set {
+            foreach node $args {
+                set node [_node_name $path $node]
+                if {![info exists data($node)]} {
+		    return -code error \
+			    "$path selection set: Cannot select unknown node \"$node\"."
+		}
+	    }
+            set data(selnodes) {}
+            foreach node $args {
+                set node [_node_name $path $node]
+		if { [Widget::getoption $path.$node -selectable] } {
+		    if { [lsearch -exact $data(selnodes) $node] == -1 } {
+			lappend data(selnodes) $node
+		    }
+		}
+            }
+	    __call_selectcmd $path
+        }
+        add {
+            foreach node $args {
+                set node [_node_name $path $node]
+                if {![info exists data($node)]} {
+		    return -code error \
+			    "$path selection add: Cannot select unknown node \"$node\"."
+		}
+	    }
+            foreach node $args {
+                set node [_node_name $path $node]
+		if { [Widget::getoption $path.$node -selectable] } {
+		    if { [lsearch -exact $data(selnodes) $node] == -1 } {
+			lappend data(selnodes) $node
+		    }
+		}
+            }
+	    __call_selectcmd $path
+        }
+	range {
+	    # Here's our algorithm:
+	    #    make a list of all nodes, then take the range from node1
+	    #    to node2 and select those nodes
+	    #
+	    # This works because of how this widget handles redraws:
+	    #    The tree is always completely redrawn, and always from
+	    #    top to bottom. So the list of visible nodes *is* the
+	    #    list of nodes, and we can use that to decide which nodes
+	    #    to select.
+
+	    if {[llength $args] != 2} {
+		return -code error \
+			"wrong#args: Expected $path selection range node1 node2"
+	    }
+
+	    foreach {node1 node2} $args break
+
+            set node1 [_node_name $path $node1]
+            set node2 [_node_name $path $node2]
+	    if {![info exists data($node1)]} {
+		return -code error \
+			"$path selection range: Cannot start range at unknown node \"$node1\"."
+	    }
+	    if {![info exists data($node2)]} {
+		return -code error \
+			"$path selection range: Cannot end range at unknown node \"$node2\"."
+	    }
+
+	    set nodes {}
+	    foreach nodeItem [$path.c find withtag node] {
+		set node [Tree::_get_node_name $path $nodeItem 2]
+		if { [Widget::getoption $path.$node -selectable] } {
+		    lappend nodes $node
+		}
+	    }
+	    # surles: Set the root string to the first element on the list.
+	    if {$node1 == "root"} {
+		set node1 [lindex $nodes 0]
+	    }
+	    if {$node2 == "root"} {
+		set node2 [lindex $nodes 0]
+	    }
+
+	    # Find the first visible ancestor of node1, starting with node1
+	    while {[set index1 [lsearch -exact $nodes $node1]] == -1} {
+		set node1 [lindex $data($node1) 0]
+	    }
+	    # Find the first visible ancestor of node2, starting with node2
+	    while {[set index2 [lsearch -exact $nodes $node2]] == -1} {
+		set node2 [lindex $data($node2) 0]
+	    }
+	    # If the nodes were given in backwards order, flip the
+	    # indices now
+	    if { $index2 < $index1 } {
+		incr index1 $index2
+		set index2 [expr {$index1 - $index2}]
+		set index1 [expr {$index1 - $index2}]
+	    }
+	    set data(selnodes) [lrange $nodes $index1 $index2]
+	    __call_selectcmd $path
+	}
+        remove {
+            foreach node $args {
+                set node [_node_name $path $node]
+                if { [set idx [lsearch -exact $data(selnodes) $node]] != -1 } {
+                    set data(selnodes) [lreplace $data(selnodes) $idx $idx]
+                }
+            }
+	    __call_selectcmd $path
+        }
+        clear {
+	    if {[llength $args] != 0} {
+		return -code error \
+			"wrong#args: Expected $path selection clear"
+	    }
+            set data(selnodes) {}
+	    __call_selectcmd $path
+        }
+        get {
+	    if {[llength $args] != 0} {
+		return -code error \
+			"wrong#args: Expected $path selection get"
+	    }
+            return $data(selnodes)
+        }
+        includes {
+	    if {[llength $args] != 1} {
+		return -code error \
+			"wrong#args: Expected $path selection includes node"
+	    }
+	    set node [lindex $args 0]
+            set node [_node_name $path $node]
+            return [expr {[lsearch -exact $data(selnodes) $node] != -1}]
+        }
+        default {
+            return
+        }
+    }
+    _redraw_idle $path 1
+}
+
+
+proc Tree::getcanvas { path } {
+    return $path.c
+}
+
+
+proc Tree::__call_selectcmd { path } {
+    variable $path
+    upvar 0  $path data
+
+    set selectcmd [Widget::getoption $path -selectcommand]
+    if {[llength $selectcmd]} {
+	lappend selectcmd $path
+	lappend selectcmd $data(selnodes)
+	uplevel \#0 $selectcmd
+    }
+    return
+}
+
+# ----------------------------------------------------------------------------
+#  Command Tree::exists
+# ----------------------------------------------------------------------------
+proc Tree::exists { path node } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    return [info exists data($node)]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::visible
+# ----------------------------------------------------------------------------
+proc Tree::visible { path node } {
+    set node [_node_name $path $node]
+    set idn [$path.c find withtag n:$node]
+    return [llength $idn]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::parent
+# ----------------------------------------------------------------------------
+proc Tree::parent { path node } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+    return [lindex $data($node) 0]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::index
+# ----------------------------------------------------------------------------
+proc Tree::index { path node } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [string equal $node "root"] || ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+    set parent [lindex $data($node) 0]
+    return [expr {[lsearch -exact $data($parent) $node] - 1}]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Tree::find
+#     Returns the node given a position.
+#  findInfo     @x,y ?confine?
+#               lineNumber
+# ----------------------------------------------------------------------------
+proc Tree::find {path findInfo {confine ""}} {
+    if {[regexp -- {^@([0-9]+),([0-9]+)$} $findInfo match x y]} {
+        set x [$path.c canvasx $x]
+        set y [$path.c canvasy $y]
+    } elseif {[regexp -- {^[0-9]+$} $findInfo lineNumber]} {
+        set dy [Widget::getoption $path -deltay]
+        set y  [expr {$dy*($lineNumber+0.5)}]
+        set confine ""
+    } else {
+        return -code error "invalid find spec \"$findInfo\""
+    }
+
+    set found  0
+    set region [$path.c bbox all]
+    if {[llength $region]} {
+        set xi [lindex $region 0]
+        set xs [lindex $region 2]
+        foreach id [$path.c find overlapping $xi $y $xs $y] {
+            set ltags [$path.c gettags $id]
+            set item  [lindex $ltags 1]
+            if { [string equal $item "node"] ||
+                 [string equal $item "img"]  ||
+                 [string equal $item "win"] } {
+                # item is the label or image/window of the node
+                set node  [Tree::_get_node_name $path $id 2]
+                set found 1
+                break
+            }
+        }
+    }
+
+    if {$found} {
+        if {![string equal $confine ""]} {
+            # test if x stand inside node bbox
+	    set padx [_get_node_padx $path $node]
+            set xi [expr {[lindex [$path.c coords n:$node] 0] - $padx}]
+            set xs [lindex [$path.c bbox n:$node] 2]
+            if {$x >= $xi && $x <= $xs} {
+                return $node
+            }
+        } else {
+            return $node
+        }
+    }
+    return ""
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::line
+#     Returns the line where a node was drawn.
+# ----------------------------------------------------------------------------
+proc Tree::line {path node} {
+    set node [_node_name $path $node]
+    set item [$path.c find withtag n:$node]
+    if {[string length $item]} {
+        set dy   [Widget::getoption $path -deltay]
+        set y    [lindex [$path.c coords $item] 1]
+        set line [expr {int($y/$dy)}]
+    } else {
+        set line -1
+    }
+    return $line
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::nodes
+# ----------------------------------------------------------------------------
+proc Tree::nodes { path node {first ""} {last ""} } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+
+    if { ![string length $first] } {
+        return [lrange $data($node) 1 end]
+    }
+
+    if { ![string length $last] } {
+        return [lindex [lrange $data($node) 1 end] $first]
+    } else {
+        return [lrange [lrange $data($node) 1 end] $first $last]
+    }
+}
+
+
+# Tree::visiblenodes --
+#
+#	Retrieve a list of all the nodes in a tree.
+#
+# Arguments:
+#	path	tree to retrieve nodes for.
+#
+# Results:
+#	nodes	list of nodes in the tree.
+
+proc Tree::visiblenodes { path } {
+    variable $path
+    upvar 0  $path data
+
+    # Root is always open (?), so all of its children automatically get added
+    # to the result, and to the stack.
+    set st [lrange $data(root) 1 end]
+    set result $st
+
+    while {[llength $st]} {
+	set node [lindex $st end]
+	set st [lreplace $st end end]
+	# Danger, danger!  Using getMegawidgetOption is fragile, but much
+	# much faster than going through cget.
+	if { [Widget::getMegawidgetOption $path.$node -open] } {
+	    set nodes [lrange $data($node) 1 end]
+	    set result [concat $result $nodes]
+	    set st [concat $st $nodes]
+	}
+    }
+    return $result
+}
+
+# ----------------------------------------------------------------------------
+#  Command Tree::see
+# ----------------------------------------------------------------------------
+proc Tree::see { path node } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
+        after cancel $data(upd,afterid)
+        _redraw_tree $path
+    }
+    set idn [$path.c find withtag n:$node]
+    if { $idn != "" } {
+        Tree::_see $path $idn
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::opentree
+# ----------------------------------------------------------------------------
+# JDC: added option recursive
+proc Tree::opentree { path node {recursive 1} } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [string equal $node "root"] || ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+
+    _recexpand $path $node 1 $recursive [Widget::getoption $path -opencmd]
+    _redraw_idle $path 3
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::closetree
+# ----------------------------------------------------------------------------
+proc Tree::closetree { path node {recursive 1} } {
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [string equal $node "root"] || ![info exists data($node)] } {
+        return -code error "node \"$node\" does not exist"
+    }
+
+    _recexpand $path $node 0 $recursive [Widget::getoption $path -closecmd]
+    _redraw_idle $path 3
+}
+
+
+proc Tree::toggle { path node } {
+    if {[$path itemcget $node -open]} {
+        $path closetree $node 0
+    } else {
+        $path opentree $node 0
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::edit
+# ----------------------------------------------------------------------------
+proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} {
+    variable _edit
+    variable $path
+    upvar 0  $path data
+
+    set node [_node_name $path $node]
+    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
+        after cancel $data(upd,afterid)
+        _redraw_tree $path
+    }
+    set idn [$path.c find withtag n:$node]
+    if { $idn != "" } {
+        Tree::_see $path $idn
+
+        set oldfg  [$path.c itemcget $idn -fill]
+        set sbg    [Widget::getoption $path -selectbackground]
+        set coords [$path.c coords $idn]
+        set x      [lindex $coords 0]
+        set y      [lindex $coords 1]
+        set bd     [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}]
+        set w      [expr {[winfo width $path] - 2*$bd}]
+        set wmax   [expr {[$path.c canvasx $w]-$x}]
+
+        set _edit(text) $text
+        set _edit(wait) 0
+
+        $path.c itemconfigure $idn    -fill [Widget::getoption $path -background]
+        $path.c itemconfigure s:$node -fill {} -outline {}
+
+        set frame  [frame $path.edit \
+                        -relief flat -borderwidth 0 -highlightthickness 0 \
+                        -background [Widget::getoption $path -background]]
+        set ent    [entry $frame.edit \
+                        -width              0     \
+                        -relief             solid \
+                        -borderwidth        1     \
+                        -highlightthickness 0     \
+                        -foreground         [Widget::getoption $path.$node -fill] \
+                        -background         [Widget::getoption $path -background] \
+                        -selectforeground   [Widget::getoption $path -selectforeground] \
+                        -selectbackground   $sbg  \
+                        -font               [Widget::getoption $path.$node -font] \
+                        -textvariable       Tree::_edit(text)]
+        pack $ent -ipadx 8 -anchor w
+
+        set idw [$path.c create window $x $y -window $frame -anchor w]
+        trace variable Tree::_edit(text) w \
+	    [list Tree::_update_edit_size $path $ent $idw $wmax]
+        tkwait visibility $ent
+        grab  $frame
+        BWidget::focus set $ent
+
+        _update_edit_size $path $ent $idw $wmax
+        update
+        if { $select } {
+            $ent selection range 0 end
+            $ent icursor end
+            $ent xview end
+        }
+
+        bindtags $ent [list $ent Entry]
+        bind $ent <Escape> {set Tree::_edit(wait) 0}
+        bind $ent <Return> {set Tree::_edit(wait) 1}
+        if { $clickres == 0 || $clickres == 1 } {
+            bind $frame <Button>  [list set Tree::_edit(wait) $clickres]
+        }
+
+        set ok 0
+        while { !$ok } {
+            tkwait variable Tree::_edit(wait)
+            if { !$_edit(wait) || [llength $verifycmd]==0 ||
+                 [uplevel \#0 $verifycmd [list $_edit(text)]] } {
+                set ok 1
+            }
+        }
+
+        trace vdelete Tree::_edit(text) w \
+	    [list Tree::_update_edit_size $path $ent $idw $wmax]
+        grab release $frame
+        BWidget::focus release $ent
+        destroy $frame
+        $path.c delete $idw
+        $path.c itemconfigure $idn    -fill $oldfg
+        $path.c itemconfigure s:$node -fill $sbg -outline $sbg
+
+        if { $_edit(wait) } {
+            return $_edit(text)
+        }
+    }
+    return ""
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::xview
+# ----------------------------------------------------------------------------
+proc Tree::xview { path args } {
+    return [eval [linsert $args 0 $path.c xview]]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::yview
+# ----------------------------------------------------------------------------
+proc Tree::yview { path args } {
+    return [eval [linsert $args 0 $path.c yview]]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_update_edit_size
+# ----------------------------------------------------------------------------
+proc Tree::_update_edit_size { path entry idw wmax args } {
+    set entw [winfo reqwidth $entry]
+    if { $entw+8 >= $wmax } {
+        $path.c itemconfigure $idw -width $wmax
+    } else {
+        $path.c itemconfigure $idw -width 0
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_see
+# ----------------------------------------------------------------------------
+proc Tree::_see { path idn } {
+    set bbox [$path.c bbox $idn]
+    set scrl [$path.c cget -scrollregion]
+
+    set ymax [lindex $scrl 3]
+    set dy   [$path.c cget -yscrollincrement]
+    set yv   [$path yview]
+    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
+    set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
+    set y    [expr {int([lindex [$path.c coords $idn] 1]/$dy)}]
+    if { $y < $yv0 } {
+        $path.c yview scroll [expr {$y-$yv0}] units
+    } elseif { $y >= $yv1 } {
+        $path.c yview scroll [expr {$y-$yv1+1}] units
+    }
+
+    set xmax [lindex $scrl 2]
+    set dx   [$path.c cget -xscrollincrement]
+    set xv   [$path xview]
+    set x0   [expr {int([lindex $bbox 0]/$dx)}]
+    set xv0  [expr {round([lindex $xv 0]*$xmax/$dx)}]
+    set xv1  [expr {round([lindex $xv 1]*$xmax/$dx)}]
+    if { $x0 >= $xv1 || $x0 < $xv0 } {
+	$path.c xview scroll [expr {$x0-$xv0}] units
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_recexpand
+# ----------------------------------------------------------------------------
+# JDC : added option recursive
+proc Tree::_recexpand { path node expand recursive cmd } {
+    variable $path
+    upvar 0  $path data
+
+    if { [Widget::getoption $path.$node -open] != $expand } {
+        Widget::setoption $path.$node -open $expand
+        if {[llength $cmd]} {
+            uplevel \#0 $cmd [list $node]
+        }
+    }
+
+    if { $recursive } {
+	foreach subnode [lrange $data($node) 1 end] {
+	    _recexpand $path $subnode $expand $recursive $cmd
+	}
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_subdelete
+# ----------------------------------------------------------------------------
+proc Tree::_subdelete { path lnodes } {
+    variable $path
+    upvar 0  $path data
+
+    set sel $data(selnodes)
+    set selchanged 0
+
+    while { [llength $lnodes] } {
+        set lsubnodes [list]
+        foreach node $lnodes {
+            foreach subnode [lrange $data($node) 1 end] {
+                lappend lsubnodes $subnode
+            }
+            unset data($node)
+	    set idx [lsearch -exact $sel $node]
+	    if { $idx >= 0 } {
+		set sel [lreplace $sel $idx $idx]
+		incr selchanged
+	    }
+            if { [set win [Widget::getoption $path.$node -window]] != "" } {
+                destroy $win
+            }
+            Widget::destroy $path.$node
+        }
+        set lnodes $lsubnodes
+    }
+
+    set data(selnodes) $sel
+    # return number of sel items changes
+    return $selchanged
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_update_scrollregion
+# ----------------------------------------------------------------------------
+proc Tree::_update_scrollregion { path } {
+    set bd   [expr {2*([$path.c cget -borderwidth]+[$path.c cget -highlightthickness])}]
+    set w    [expr {[winfo width  $path] - $bd}]
+    set h    [expr {[winfo height $path] - $bd}]
+    set xinc [$path.c cget -xscrollincrement]
+    set yinc [$path.c cget -yscrollincrement]
+    set bbox [$path.c bbox node]
+    if { [llength $bbox] } {
+        set xs [lindex $bbox 2]
+        set ys [lindex $bbox 3]
+
+        if { $w < $xs } {
+            set w [expr {int($xs)}]
+            if { [set r [expr {$w % $xinc}]] } {
+                set w [expr {$w+$xinc-$r}]
+            }
+        }
+        if { $h < $ys } {
+            set h [expr {int($ys)}]
+            if { [set r [expr {$h % $yinc}]] } {
+                set h [expr {$h+$yinc-$r}]
+            }
+        }
+    }
+
+    $path.c configure -scrollregion [list 0 0 $w $h]
+
+    if {[Widget::getoption $path -selectfill]} {
+        _redraw_selection $path
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_cross_event
+# ----------------------------------------------------------------------------
+proc Tree::_cross_event { path } {
+    variable $path
+    upvar 0  $path data
+
+    set node [Tree::_get_node_name $path current 1]
+    if { [Widget::getoption $path.$node -open] } {
+        Tree::itemconfigure $path $node -open 0
+        if {[llength [set cmd [Widget::getoption $path -closecmd]]]} {
+            uplevel \#0 $cmd [list $node]
+        }
+    } else {
+        Tree::itemconfigure $path $node -open 1
+        if {[llength [set cmd [Widget::getoption $path -opencmd]]]} {
+            uplevel \#0 $cmd [list $node]
+        }
+    }
+}
+
+
+proc Tree::_draw_cross { path node open x y } {
+    set idc [$path.c find withtag c:$node]
+
+    if { $open } {
+        set img [Widget::cget $path -crossopenimage]
+        set bmp [Widget::cget $path -crossopenbitmap]
+    } else {
+        set img [Widget::cget $path -crosscloseimage]
+        set bmp [Widget::cget $path -crossclosebitmap]
+    }
+
+    ## If we already have a cross for this node, we just adjust the image.
+    if {$idc != ""} {
+        if {$img == ""} {
+            $path.c itemconfigure $idc -bitmap $bmp
+        } else {
+            $path.c itemconfigure $idc -image $img
+        }
+        return
+    }
+
+    ## Create a new image for the cross.  If the user has specified an
+    ## image, it overrides a bitmap.
+    if {$img == ""} {
+        $path.c create bitmap $x $y \
+            -bitmap     $bmp \
+            -background [$path.c cget -background] \
+            -foreground [Widget::getoption $path -crossfill] \
+            -tags       [list cross c:$node] -anchor c
+    } else {
+        $path.c create image $x $y \
+            -image      $img \
+            -tags       [list cross c:$node] -anchor c
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_draw_node
+# ----------------------------------------------------------------------------
+proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } {
+    variable $path
+    upvar 0  $path data
+
+    set x1 [expr {$x0+$deltax+5}]
+    set y1 $y0
+    if { $showlines } {
+        $path.c create line $x0 $y0 $x1 $y0 \
+            -fill    [Widget::getoption $path -linesfill]   \
+            -stipple [Widget::getoption $path -linestipple] \
+            -tags    line
+    }
+    $path.c create text [expr {$x1+$padx}] $y0 \
+        -text   [Widget::getoption $path.$node -text] \
+        -fill   [Widget::getoption $path.$node -fill] \
+        -font   [Widget::getoption $path.$node -font] \
+        -anchor w \
+    	-tags   [Tree::_get_node_tags $path $node [list node n:$node]]
+    set len [expr {[llength $data($node)] > 1}]
+    set dc  [Widget::getoption $path.$node -drawcross]
+    set exp [Widget::getoption $path.$node -open]
+
+    if { $len && $exp } {
+        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
+                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
+    }
+
+    if {![string equal $dc "never"]
+	&& ($len || [string equal $dc "always"] || [string equal $dc "allways"])} {
+        _draw_cross $path $node $exp $x0 $y0
+    }
+
+    if { [set win [Widget::getoption $path.$node -window]] != "" } {
+	set a [Widget::cget $path.$node -anchor]
+        $path.c create window $x1 $y0 -window $win -anchor $a \
+		-tags [Tree::_get_node_tags $path $node [list win i:$node]]
+    } elseif { [set img [Widget::getoption $path.$node -image]] != "" } {
+	set a [Widget::cget $path.$node -anchor]
+        $path.c create image $x1 $y0 -image $img -anchor $a \
+		-tags   [Tree::_get_node_tags $path $node [list img i:$node]]
+    }
+    set box [$path.c bbox n:$node i:$node]
+    set id [$path.c create rect 0 [lindex $box 1] \
+		[winfo screenwidth $path] [lindex $box 3] \
+		-tags [Tree::_get_node_tags $path $node [list box b:$node]] \
+		-fill {} -outline {}]
+    $path.c lower $id
+
+    _set_help $path $node
+
+    return $y1
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_draw_subnodes
+# ----------------------------------------------------------------------------
+proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } {
+    set y1 $y0
+    foreach node $nodes {
+	set padx   [_get_node_padx $path $node]
+	set deltax [_get_node_deltax $path $node]
+        set yp $y1
+        set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]
+    }
+    if { $showlines && [llength $nodes] } {
+	if {$y0 < 0} {
+	    # Adjust the drawing of the line to the first root node
+	    # to start at the vertical point (not go up).
+	    incr y0 $deltay
+	}
+        set id [$path.c create line $x0 $y0 $x0 [expr {$yp+$deltay}] \
+                    -fill    [Widget::getoption $path -linesfill]   \
+                    -stipple [Widget::getoption $path -linestipple] \
+                    -tags    line]
+
+        $path.c lower $id
+    }
+    return $y1
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_update_nodes
+# ----------------------------------------------------------------------------
+proc Tree::_update_nodes { path } {
+    variable $path
+    upvar 0  $path data
+
+    foreach {node flag} $data(upd,nodes) {
+	set idn [$path.c find withtag "n:$node"]
+	if { $idn == "" } {
+	    continue
+	}
+	set padx   [_get_node_padx $path $node]
+	set deltax [_get_node_deltax $path $node]
+	set c  [$path.c coords $idn]
+	set x1 [expr {[lindex $c 0]-$padx}]
+	set x0 [expr {$x1-$deltax-5}]
+	set y0 [lindex $c 1]
+	if { $flag & 48 } {
+	    # -window or -image modified
+	    set win  [Widget::getoption $path.$node -window]
+	    set img  [Widget::getoption $path.$node -image]
+	    set anc  [Widget::cget $path.$node -anchor]
+	    set idi  [$path.c find withtag i:$node]
+	    set type [lindex [$path.c gettags $idi] 1]
+	    if { [string length $win] } {
+		if { [string equal $type "win"] } {
+		    $path.c itemconfigure $idi -window $win
+		} else {
+		    $path.c delete $idi
+		    $path.c create window $x1 $y0 -window $win -anchor $anc \
+			-tags [_get_node_tags $path $node [list win i:$node]]
+		}
+	    } elseif { [string length $img] } {
+		if { [string equal $type "img"] } {
+		    $path.c itemconfigure $idi -image $img
+		} else {
+		    $path.c delete $idi
+		    $path.c create image $x1 $y0 -image $img -anchor $anc \
+			-tags [_get_node_tags $path $node [list img i:$node]]
+		}
+	    } else {
+		$path.c delete $idi
+	    }
+	}
+
+	if { $flag & 8 } {
+	    # -drawcross modified
+	    set len [expr {[llength $data($node)] > 1}]
+	    set dc  [Widget::getoption $path.$node -drawcross]
+	    set exp [Widget::getoption $path.$node -open]
+
+	    if {![string equal $dc "never"]
+		&& ($len || [string equal $dc "always"] || [string equal $dc "allways"])} {
+		_draw_cross $path $node $exp $x0 $y0
+	    } else {
+		set idc [$path.c find withtag c:$node]
+		$path.c delete $idc
+	    }
+	}
+
+	if { $flag & 7 } {
+	    # -font, -text or -fill modified
+	    $path.c itemconfigure $idn \
+		-text [Widget::getoption $path.$node -text] \
+		-fill [Widget::getoption $path.$node -fill] \
+		-font [Widget::getoption $path.$node -font]
+	}
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_draw_tree
+# ----------------------------------------------------------------------------
+proc Tree::_draw_tree { path } {
+    variable $path
+    upvar 0  $path data
+
+    $path.c delete all
+    set cursor [$path.c cget -cursor]
+    $path.c configure -cursor watch
+    _draw_subnodes $path [lrange $data(root) 1 end] 8 \
+        [expr {-[Widget::getoption $path -deltay]/2}] \
+        [Widget::getoption $path -deltax] \
+        [Widget::getoption $path -deltay] \
+        [Widget::getoption $path -padx]   \
+        [Widget::getoption $path -showlines]
+    $path.c configure -cursor $cursor
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_redraw_tree
+# ----------------------------------------------------------------------------
+proc Tree::_redraw_tree { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { [Widget::getoption $path -redraw] } {
+        if { $data(upd,level) == 2 } {
+            _update_nodes $path
+        } elseif { $data(upd,level) == 3 } {
+            _draw_tree $path
+        }
+        _redraw_selection $path
+        _update_scrollregion $path
+        set data(upd,nodes)   {}
+        set data(upd,level)   0
+        set data(upd,afterid) ""
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_redraw_selection
+# ----------------------------------------------------------------------------
+proc Tree::_redraw_selection { path } {
+    variable $path
+    upvar 0  $path data
+
+    set selbg [Widget::getoption $path -selectbackground]
+    set selfg [Widget::getoption $path -selectforeground]
+    set fill  [Widget::getoption $path -selectfill]
+    if {$fill} {
+        set scroll [$path.c cget -scrollregion]
+        if {[llength $scroll]} {
+            set xmax [expr {[lindex $scroll 2]-1}]
+        } else {
+            set xmax [winfo width $path]
+        }
+    }
+    foreach id [$path.c find withtag sel] {
+        set node [Tree::_get_node_name $path $id 1]
+        $path.c itemconfigure "n:$node" -fill [Widget::getoption $path.$node -fill]
+    }
+    $path.c delete sel
+    foreach node $data(selnodes) {
+        set bbox [$path.c bbox "n:$node"]
+        if { [llength $bbox] } {
+            if {$fill} {
+		# get the image to (if any), as it may have different height
+		set bbox [$path.c bbox "n:$node" "i:$node"]
+                set bbox [list 0 [lindex $bbox 1] $xmax [lindex $bbox 3]]
+            }
+            set id [$path.c create rectangle $bbox -tags [list sel s:$node] \
+			-fill $selbg -outline $selbg]
+            $path.c itemconfigure "n:$node" -fill $selfg
+            $path.c lower $id
+        }
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_redraw_idle
+# ----------------------------------------------------------------------------
+proc Tree::_redraw_idle { path level } {
+    variable $path
+    upvar 0  $path data
+
+    if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
+        set data(upd,afterid) [after idle [list Tree::_redraw_tree $path]]
+    }
+    if { $level > $data(upd,level) } {
+        set data(upd,level) $level
+    }
+    return ""
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_init_drag_cmd
+# ----------------------------------------------------------------------------
+proc Tree::_init_drag_cmd { path X Y top } {
+    set path [winfo parent $path]
+    set ltags [$path.c gettags current]
+    set item  [lindex $ltags 1]
+    if { [string equal $item "node"] ||
+         [string equal $item "img"]  ||
+         [string equal $item "win"] } {
+        set node [Tree::_get_node_name $path current 2]
+        if {[llength [set cmd [Widget::getoption $path -draginitcmd]]]} {
+            return [uplevel \#0 $cmd [list $path $node $top]]
+        }
+        if { [set type [Widget::getoption $path -dragtype]] == "" } {
+            set type "TREE_NODE"
+        }
+        if { [set img [Widget::getoption $path.$node -image]] != "" } {
+            pack [label $top.l -image $img -padx 0 -pady 0]
+        }
+        return [list $type {copy move link} $node]
+    }
+    return {}
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_drop_cmd
+# ----------------------------------------------------------------------------
+proc Tree::_drop_cmd { path source X Y op type dnddata } {
+    set path [winfo parent $path]
+    variable $path
+    upvar 0  $path data
+
+    $path.c delete drop
+    if { [string length $data(dnd,afterid)] } {
+        after cancel $data(dnd,afterid)
+        set data(dnd,afterid) ""
+    }
+    set data(dnd,scroll) ""
+    if {[llength $data(dnd,node)]
+	&& [llength [set cmd [Widget::getoption $path -dropcmd]]]} {
+	return [uplevel \#0 $cmd \
+		    [list $path $source $data(dnd,node) $op $type $dnddata]]
+    }
+    return 0
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_over_cmd
+# ----------------------------------------------------------------------------
+proc Tree::_over_cmd { path source event X Y op type dnddata } {
+    set path [winfo parent $path]
+    variable $path
+    upvar 0  $path data
+
+    if { [string equal $event "leave"] } {
+        # we leave the window tree
+        $path.c delete drop
+        if { [string length $data(dnd,afterid)] } {
+            after cancel $data(dnd,afterid)
+            set data(dnd,afterid) ""
+        }
+        set data(dnd,scroll) ""
+        return 0
+    }
+
+    if { [string equal $event "enter"] } {
+        # we enter the window tree - dnd data initialization
+        set mode [Widget::getoption $path -dropovermode]
+        set data(dnd,mode) 0
+        foreach c {w p n} {
+            set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
+        }
+        set bbox [$path.c bbox all]
+        if { [llength $bbox] } {
+            set data(dnd,xs) [lindex $bbox 2]
+            set data(dnd,empty) 0
+        } else {
+            set data(dnd,xs) 0
+            set data(dnd,empty) 1
+        }
+        set data(dnd,node) {}
+    }
+
+    set x [expr {$X-[winfo rootx $path]}]
+    set y [expr {$Y-[winfo rooty $path]}]
+    $path.c delete drop
+    set data(dnd,node) {}
+
+    # test for auto-scroll unless mode is widget only
+    if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
+        return 2
+    }
+
+    if { $data(dnd,mode) & 4 } {
+        # dropovermode includes widget
+        set target [list widget]
+        set vmode  4
+    } else {
+        set target [list ""]
+        set vmode  0
+    }
+    if { ($data(dnd,mode) & 2) && $data(dnd,empty) } {
+        # dropovermode includes position and tree is empty
+        lappend target [list root 0]
+        set vmode  [expr {$vmode | 2}]
+    }
+
+    set xc [$path.c canvasx $x]
+    set xs $data(dnd,xs)
+    if { $xc <= $xs } {
+        set yc   [$path.c canvasy $y]
+        set dy   [$path.c cget -yscrollincrement]
+        set line [expr {int($yc/$dy)}]
+        set xi   0
+        set yi   [expr {$line*$dy}]
+        set ys   [expr {$yi+$dy}]
+        set found 0
+        foreach id [$path.c find overlapping $xi $yi $xs $ys] {
+            set ltags [$path.c gettags $id]
+            set item  [lindex $ltags 1]
+            if { [string equal $item "node"] ||
+                 [string equal $item "img"]  ||
+                 [string equal $item "win"] } {
+                # item is the label or image/window of the node
+                set node [Tree::_get_node_name $path $id 2]
+		set found 1
+		break
+	    }
+	}
+	if {$found} {
+	    set padx   [_get_node_padx $path $node]
+	    set deltax [_get_node_deltax $path $node]
+            set xi [expr {[lindex [$path.c coords n:$node] 0] - $padx - 1}]
+                if { $data(dnd,mode) & 1 } {
+                    # dropovermode includes node
+                    lappend target $node
+                    set vmode [expr {$vmode | 1}]
+                } else {
+                    lappend target ""
+                }
+
+                if { $data(dnd,mode) & 2 } {
+                    # dropovermode includes position
+                    if { $yc >= $yi+$dy/2 } {
+                        # position is after $node
+                        if { [Widget::getoption $path.$node -open] &&
+                             [llength $data($node)] > 1 } {
+                            # $node is open and have subnodes
+                            # drop position is 0 in children of $node
+                            set parent $node
+                            set index  0
+                            set xli    [expr {$xi-5}]
+                        } else {
+                            # $node is not open and doesn't have subnodes
+                            # drop position is after $node in children of parent of $node
+                            set parent [lindex $data($node) 0]
+                            set index  [lsearch -exact $data($parent) $node]
+                            set xli    [expr {$xi - $deltax - 5}]
+                        }
+                        set yl $ys
+                    } else {
+                        # position is before $node
+                        # drop position is before $node in children of parent of $node
+                        set parent [lindex $data($node) 0]
+                        set index  [expr {[lsearch -exact $data($parent) $node] - 1}]
+                        set xli    [expr {$xi - $deltax - 5}]
+                        set yl     $yi
+                    }
+                    lappend target [list $parent $index]
+                    set vmode  [expr {$vmode | 2}]
+                } else {
+                    lappend target {}
+                }
+
+                if { ($vmode & 3) == 3 } {
+                    # result have both node and position
+                    # we compute what is the preferred method
+                    if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
+                        lappend target "position"
+                    } else {
+                        lappend target "node"
+                    }
+                }
+            }
+        }
+
+    if {$vmode && [llength [set cmd [Widget::getoption $path -dropovercmd]]]} {
+        # user-defined dropover command
+        set res     [uplevel \#0 $cmd [list $path $source $target $op $type $dnddata]]
+        set code    [lindex $res 0]
+        set newmode 0
+        if { $code & 1 } {
+            # update vmode
+            set mode [lindex $res 1]
+            if { ($vmode & 1) && [string equal $mode "node"] } {
+                set newmode 1
+            } elseif { ($vmode & 2) && [string equal $mode "position"] } {
+                set newmode 2
+            } elseif { ($vmode & 4) && [string equal $mode "widget"] } {
+                set newmode 4
+            }
+        }
+        set vmode $newmode
+    } else {
+        if { ($vmode & 3) == 3 } {
+            # result have both item and position
+            # we choose the preferred method
+            if { [string equal [lindex $target 3] "position"] } {
+                set vmode [expr {$vmode & ~1}]
+            } else {
+                set vmode [expr {$vmode & ~2}]
+            }
+        }
+
+        if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
+            # dropovermode is widget or empty - recall is not necessary
+            set code 1
+        } else {
+            set code 3
+        }
+    }
+
+    if {!$data(dnd,empty)} {
+	# draw dnd visual following vmode
+	if { $vmode & 1 } {
+	    set data(dnd,node) [list "node" [lindex $target 1]]
+	    $path.c create rectangle $xi $yi $xs $ys -tags drop
+	} elseif { $vmode & 2 } {
+	    set data(dnd,node) [concat "position" [lindex $target 2]]
+	    $path.c create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop
+	} elseif { $vmode & 4 } {
+	    set data(dnd,node) [list "widget"]
+	} else {
+	    set code [expr {$code & 2}]
+	}
+    }
+
+    if { $code & 1 } {
+        DropSite::setcursor based_arrow_down
+    } else {
+        DropSite::setcursor dot
+    }
+    return $code
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_auto_scroll
+# ----------------------------------------------------------------------------
+proc Tree::_auto_scroll { path x y } {
+    variable $path
+    upvar 0  $path data
+
+    set xmax   [winfo width  $path]
+    set ymax   [winfo height $path]
+    set scroll {}
+    if { $y <= 6 } {
+        if { [lindex [$path.c yview] 0] > 0 } {
+            set scroll [list yview -1]
+            DropSite::setcursor sb_up_arrow
+        }
+    } elseif { $y >= $ymax-6 } {
+        if { [lindex [$path.c yview] 1] < 1 } {
+            set scroll [list yview 1]
+            DropSite::setcursor sb_down_arrow
+        }
+    } elseif { $x <= 6 } {
+        if { [lindex [$path.c xview] 0] > 0 } {
+            set scroll [list xview -1]
+            DropSite::setcursor sb_left_arrow
+        }
+    } elseif { $x >= $xmax-6 } {
+        if { [lindex [$path.c xview] 1] < 1 } {
+            set scroll [list xview 1]
+            DropSite::setcursor sb_right_arrow
+        }
+    }
+
+    if { [string length $data(dnd,afterid)] && ![string equal $data(dnd,scroll) $scroll] } {
+        after cancel $data(dnd,afterid)
+        set data(dnd,afterid) ""
+    }
+
+    set data(dnd,scroll) $scroll
+    if { [string length $scroll] && ![string length $data(dnd,afterid)] } {
+        set data(dnd,afterid) [after 200 [list Tree::_scroll $path $scroll]]
+    }
+    return $data(dnd,afterid)
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_scroll
+# ----------------------------------------------------------------------------
+proc Tree::_scroll { path cmd dir } {
+    variable $path
+    upvar 0  $path data
+
+    if { ($dir == -1 && [lindex [$path.c $cmd] 0] > 0) ||
+         ($dir == 1  && [lindex [$path.c $cmd] 1] < 1) } {
+        $path.c $cmd scroll $dir units
+        set data(dnd,afterid) [after 100 [list Tree::_scroll $path $cmd $dir]]
+    } else {
+        set data(dnd,afterid) ""
+        DropSite::setcursor dot
+    }
+}
+
+# Tree::_keynav --
+#
+#	Handle navigational keypresses on the tree.
+#
+# Arguments:
+#	which      tag indicating the direction of motion:
+#                  up         move to the node graphically above current
+#                  down       move to the node graphically below current
+#                  left       close current if open, else move to parent
+#                  right      open current if closed, else move to child
+#                  open       open current if closed, close current if open
+#       win        name of the tree widget
+#
+# Results:
+#	None.
+
+proc Tree::_keynav {which win} {
+    # check for an empty tree
+    if {[$win nodes root] eq ""} {
+        return
+    }
+
+    # Keyboard navigation is riddled with special cases.  In order to avoid
+    # the complex logic, we will instead make a list of all the visible,
+    # selectable nodes, then do a simple next or previous operation.
+
+    # One easy way to get all of the visible nodes is to query the canvas
+    # object for all the items with the "node" tag; since the tree is always
+    # completely redrawn, this list will be in vertical order.
+    set nodes {}
+    foreach nodeItem [$win.c find withtag node] {
+	set node [Tree::_get_node_name $win $nodeItem 2]
+	if { [Widget::cget $win.$node -selectable] } {
+	    lappend nodes $node
+	}
+    }
+
+    # Keyboard navigation is all relative to the current node
+    # surles: Get the current node for single or multiple selection schemas.
+    set node [_get_current_node $win]
+
+    switch -exact -- $which {
+	"up" {
+	    # Up goes to the node that is vertically above the current node
+	    # (NOT necessarily the current node's parent)
+	    if { [string equal $node ""] } {
+		return
+	    }
+	    set index [lsearch -exact $nodes $node]
+	    incr index -1
+	    if { $index >= 0 } {
+		$win selection set [lindex $nodes $index]
+		_set_current_node $win [lindex $nodes $index]
+		$win see [lindex $nodes $index]
+		return
+	    }
+	}
+	"down" {
+	    # Down goes to the node that is vertically below the current node
+	    if { [string equal $node ""] } {
+		$win selection set [lindex $nodes 0]
+		_set_current_node $win [lindex $nodes 0]
+		$win see [lindex $nodes 0]
+		return
+	    }
+
+	    set index [lsearch -exact $nodes $node]
+	    incr index
+	    if { $index < [llength $nodes] } {
+		$win selection set [lindex $nodes $index]
+		_set_current_node $win [lindex $nodes $index]
+		$win see [lindex $nodes $index]
+		return
+	    }
+	}
+	"right" {
+	    # On a right arrow, if the current node is closed, open it.
+	    # If the current node is open, go to its first child
+	    if { [string equal $node ""] } {
+		return
+	    }
+	    set open [$win itemcget $node -open]
+            if { $open } {
+                if { [llength [$win nodes $node]] } {
+		    set index [lsearch -exact $nodes $node]
+		    incr index
+		    if { $index < [llength $nodes] } {
+			$win selection set [lindex $nodes $index]
+			_set_current_node $win [lindex $nodes $index]
+			$win see [lindex $nodes $index]
+			return
+		    }
+                }
+            } else {
+                $win itemconfigure $node -open 1
+                if {[llength [set cmd [Widget::getoption $win -opencmd]]]} {
+                    uplevel \#0 $cmd [list $node]
+                }
+                return
+            }
+	}
+	"left" {
+	    # On a left arrow, if the current node is open, close it.
+	    # If the current node is closed, go to its parent.
+	    if { [string equal $node ""] } {
+		return
+	    }
+	    set open [$win itemcget $node -open]
+	    if { $open } {
+		$win itemconfigure $node -open 0
+                if {[llength [set cmd [Widget::getoption $win -closecmd]]]} {
+                    uplevel \#0 $cmd [list $node]
+                }
+		return
+	    } else {
+		set parent [$win parent $node]
+	        if { [string equal $parent "root"] } {
+		    set parent $node
+                } else {
+                    while { ![$win itemcget $parent -selectable] } {
+		        set parent [$win parent $parent]
+		        if { [string equal $parent "root"] } {
+			    set parent $node
+			    break
+		        }
+                    }
+		}
+		$win selection set $parent
+		_set_current_node $win $parent
+		$win see $parent
+		return
+	    }
+	}
+	"space" {
+	    if { [string equal $node ""] } {
+		return
+	    }
+	    set open [$win itemcget $node -open]
+	    if { [llength [$win nodes $node]] } {
+
+		# Toggle the open status of the chosen node.
+
+		$win itemconfigure $node -open [expr {$open?0:1}]
+
+		if {$open} {
+		    # Node was open, is now closed. Call the close-cmd
+
+		    if {[llength [set cmd [Widget::getoption $win -closecmd]]]} {
+			uplevel \#0 $cmd [list $node]
+		    }
+		} else {
+		    # Node was closed, is now open. Call the open-cmd
+
+		    if {[llength [set cmd [Widget::getoption $win -opencmd]]]} {
+			uplevel \#0 $cmd [list $node]
+		    }
+                }
+	    }
+	}
+    }
+    return
+}
+
+# Tree::_get_current_node --
+#
+#	Get the current node for either single or multiple
+#	node selection trees.  If the tree allows for 
+#	multiple selection, return the cursor node.  Otherwise,
+#	if there is a selection, return the first node in the
+#	list.  If there is no selection, return the root node.
+#
+# arguments:
+#       win        name of the tree widget
+#
+# Results:
+#	The current node.
+
+proc Tree::_get_current_node {win} {
+    if {[info exists selectTree::selectCursor($win)]} {
+	set result $selectTree::selectCursor($win)
+    } elseif {[llength [set selList [$win selection get]]]} {
+	set result [lindex $selList 0]
+    } else {
+	set result ""
+    }
+    return $result
+}
+
+# Tree::_set_current_node --
+#
+#	Set the current node for either single or multiple
+#	node selection trees.
+#
+# arguments:
+#       win        Name of the tree widget
+#	node	   The current node.
+#
+# Results:
+#	None.
+
+proc Tree::_set_current_node {win node} {
+    if {[info exists selectTree::selectCursor($win)]} {
+	set selectTree::selectCursor($win) $node
+    }
+    return
+}
+
+# Tree::_get_node_name --
+#
+#	Given a canvas item, get the name of the tree node represented by that
+#	item.
+#
+# Arguments:
+#	path		tree to query
+#	item		Optional canvas item to examine; if omitted, 
+#			defaults to "current"
+#	tagindex	Optional tag index, since the n:nodename tag is not
+#			in the same spot for all canvas items.  If omitted,
+#			defaults to "end-1", so it works with "current" item.
+#
+# Results:
+#	node	name of the tree node.
+
+proc Tree::_get_node_name {path {item current} {tagindex end-1}} {
+    return [string range [lindex [$path.c gettags $item] $tagindex] 2 end]
+}
+
+# Tree::_get_node_padx --
+#
+#	Given a node in the tree, return it's padx value.  If the value is
+#	less than 0, default to the padx of the entire tree.
+#
+# Arguments:
+#	path		Tree to query
+#	node		Node in the tree
+#
+# Results:
+#	padx		The numeric padx value
+proc Tree::_get_node_padx {path node} {
+    set padx [Widget::getoption $path.$node -padx]
+    if {$padx < 0} { set padx [Widget::getoption $path -padx] }
+    return $padx
+}
+
+# Tree::_get_node_deltax --
+#
+#	Given a node in the tree, return it's deltax value.  If the value is
+#	less than 0, default to the deltax of the entire tree.
+#
+# Arguments:
+#	path		Tree to query
+#	node		Node in the tree
+#
+# Results:
+#	deltax		The numeric deltax value
+proc Tree::_get_node_deltax {path node} {
+    set deltax [Widget::getoption $path.$node -deltax]
+    if {$deltax < 0} { set deltax [Widget::getoption $path -deltax] }
+    return $deltax
+}
+
+
+# Tree::_get_node_tags --
+#
+#	Given a node in the tree, return a list of tags to apply to its
+#       canvas item.
+#
+# Arguments:
+#	path		Tree to query
+#	node		Node in the tree
+#	tags		A list of tags to add to the final list
+#
+# Results:
+#	list		The list of tags to apply to the canvas item
+proc Tree::_get_node_tags {path node {tags ""}} {
+    eval [linsert $tags 0 lappend list TreeItemSentinal]
+    if {[Widget::getoption $path.$node -helptext] == ""} { return $list }
+
+    switch -- [Widget::getoption $path.$node -helptype] {
+	balloon {
+	    lappend list BwHelpBalloon
+	}
+	variable {
+	    lappend list BwHelpVariable
+	}
+    }
+    return $list
+}
+
+# Tree::_set_help --
+#
+#	Register dynamic help for a node in the tree.
+#
+# Arguments:
+#	path		Tree to query
+#	node		Node in the tree
+#       force		Optional argument to force a reset of the help
+#
+# Results:
+#	none
+proc Tree::_set_help { path node } {
+    Widget::getVariable $path help
+
+    set item $path.$node
+    set opts [list -helptype -helptext -helpvar]
+    foreach {cty ctx cv} [eval [linsert $opts 0 Widget::hasChangedX $item]] break
+    set text [Widget::getoption $item -helptext]
+
+    ## If we've never set help for this item before, and text is not blank,
+    ## we need to setup help.  We also need to reset help if any of the
+    ## options have changed.
+    if { (![info exists help($node)] && $text != "") || $cty || $ctx || $cv } {
+	set help($node) 1
+	set type [Widget::getoption $item -helptype]
+        switch $type {
+            balloon {
+		DynamicHelp::register $path.c balloon n:$node $text
+		DynamicHelp::register $path.c balloon i:$node $text
+		DynamicHelp::register $path.c balloon b:$node $text
+            }
+            variable {
+		set var [Widget::getoption $item -helpvar]
+		DynamicHelp::register $path.c variable n:$node $var $text
+		DynamicHelp::register $path.c variable i:$node $var $text
+		DynamicHelp::register $path.c variable b:$node $var $text
+            }
+        }
+    }
+}
+
+proc Tree::_mouse_select { path cmd args } {
+    eval [linsert $args 0 selection $path $cmd]
+    switch -- $cmd {
+        "add" - "clear" - "remove" - "set" - "toggle" {
+            event generate $path <<TreeSelect>>
+        }
+    }
+}
+
+
+proc Tree::_node_name { path node } {
+    set map [list & _ | _ ^ _ ! _]
+    return  [string map $map $node]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Tree::_destroy
+# ----------------------------------------------------------------------------
+proc Tree::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { $data(upd,afterid) != "" } {
+        after cancel $data(upd,afterid)
+    }
+    if { $data(dnd,afterid) != "" } {
+        after cancel $data(dnd,afterid)
+    }
+    _subdelete $path [lrange $data(root) 1 end]
+    Widget::destroy $path
+    unset data
+}