# ---------------------------------------------------------------------------- # tree.tcl # This file is part of Unifix BWidget Toolkit # $Id: tree.tcl,v 1.60.2.4 2011/06/23 08:28:04 oehhar 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 "" 0 {listbox -foreground}} {-linestipple TkResource "" 0 {label -bitmap}} {-crossfill TkResource "" 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 [list after idle {BWidget::refocus %W %W.c}] bind Tree [list Tree::_destroy %W] bind Tree [list Tree::_update_scrollregion %W] bind TreeSentinalStart { if { $::Tree::sentinal(%W) } { set ::Tree::sentinal(%W) 0 break } } bind TreeSentinalEnd { set ::Tree::sentinal(%W) 0 } bind TreeFocus [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 [list Tree::_cross_event $path] # Added by ericm@scriptics.com # These allow keyboard traversal of the tree bind $path.c [list Tree::_keynav up $path] bind $path.c [list Tree::_keynav down $path] bind $path.c [list Tree::_keynav right $path] bind $path.c [list Tree::_keynav left $path] bind $path.c [list +Tree::_keynav space $path] # These allow keyboard control of the scrolling bind $path.c [list $path.c yview scroll -1 units] bind $path.c [list $path.c yview scroll 1 units] bind $path.c [list $path.c xview scroll -1 units] bind $path.c [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 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 <> virtual event ## when necessary. set selectcmd Tree::_mouse_select Tree::bindText $path [list $selectcmd $path set] Tree::bindImage $path [list $selectcmd $path set] Tree::bindText $path [list $selectcmd $path toggle] Tree::bindImage $path [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 \ [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" } set parent [_node_name $path $parent] 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 MergeFlag $path $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 } { MergeFlag $path $node $flag _redraw_idle $path 2 } } return $result } proc Tree::MergeFlag { path node flag } { variable $path upvar 0 $path data # data(upd,nodes) is a key-val list: emulate a dict by an array array set n $data(upd,nodes) if {![info exists n($node)]} { lappend data(upd,nodes) $node $flag } else { set n($node) [expr {$n($node) | $flag}] set data(upd,nodes) [array get n] } return } # ---------------------------------------------------------------------------- # 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 1\]" } $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 1\]" } $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" } set nodes [list] foreach node $data(selnodes) { lappend nodes [_node_name_rev $path $node] } return $nodes } 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_name_rev $path $node] } } else { return [_node_name_rev $path $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 {set Tree::_edit(wait) 0} bind $ent {set Tree::_edit(wait) 1} if { $clickres == 0 || $clickres == 1 } { bind $frame