1# ---------------------------------------------------------------------------- 2# tree.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: tree.tcl 606 2004-04-05 07:06:06Z mcourtoi $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - Tree::create 8# - Tree::configure 9# - Tree::cget 10# - Tree::insert 11# - Tree::itemconfigure 12# - Tree::itemcget 13# - Tree::bindText 14# - Tree::bindImage 15# - Tree::delete 16# - Tree::move 17# - Tree::reorder 18# - Tree::selection 19# - Tree::exists 20# - Tree::parent 21# - Tree::index 22# - Tree::nodes 23# - Tree::see 24# - Tree::opentree 25# - Tree::closetree 26# - Tree::edit 27# - Tree::xview 28# - Tree::yview 29# - Tree::_update_edit_size 30# - Tree::_destroy 31# - Tree::_see 32# - Tree::_recexpand 33# - Tree::_subdelete 34# - Tree::_update_scrollregion 35# - Tree::_cross_event 36# - Tree::_draw_node 37# - Tree::_draw_subnodes 38# - Tree::_update_nodes 39# - Tree::_draw_tree 40# - Tree::_redraw_tree 41# - Tree::_redraw_selection 42# - Tree::_redraw_idle 43# - Tree::_drag_cmd 44# - Tree::_drop_cmd 45# - Tree::_over_cmd 46# - Tree::_auto_scroll 47# - Tree::_scroll 48# ---------------------------------------------------------------------------- 49 50namespace eval Tree { 51 Widget::define Tree tree DragSite DropSite DynamicHelp 52 53 namespace eval Node { 54 Widget::declare Tree::Node { 55 {-text String "" 0} 56 {-font TkResource "" 0 listbox} 57 {-image TkResource "" 0 label} 58 {-window String "" 0} 59 {-fill TkResource black 0 {listbox -foreground}} 60 {-data String "" 0} 61 {-open Boolean 0 0} 62 {-selectable Boolean 1 0} 63 {-drawcross Enum auto 0 {auto allways never}} 64 {-padx Int -1 0 "%d >= -1"} 65 {-deltax Int -1 0 "%d >= -1"} 66 {-anchor String "w" 0 ""} 67 } 68 } 69 70 DynamicHelp::include Tree::Node balloon 71 72 Widget::tkinclude Tree canvas .c \ 73 remove { 74 -insertwidth -insertbackground -insertborderwidth -insertofftime 75 -insertontime -selectborderwidth -closeenough -confine -scrollregion 76 -xscrollincrement -yscrollincrement -width -height 77 } \ 78 initialize { 79 -relief sunken -borderwidth 2 -takefocus 1 80 -highlightthickness 1 -width 200 81 } 82 83 Widget::declare Tree { 84 {-deltax Int 10 0 "%d >= 0"} 85 {-deltay Int 15 0 "%d >= 0"} 86 {-padx Int 20 0 "%d >= 0"} 87 {-background TkResource "" 0 listbox} 88 {-selectbackground TkResource "" 0 listbox} 89 {-selectforeground TkResource "" 0 listbox} 90 {-selectcommand String "" 0} 91 {-width TkResource "" 0 listbox} 92 {-height TkResource "" 0 listbox} 93 {-selectfill Boolean 0 0} 94 {-showlines Boolean 1 0} 95 {-linesfill TkResource black 0 {listbox -foreground}} 96 {-linestipple TkResource "" 0 {label -bitmap}} 97 {-crossfill TkResource black 0 {listbox -foreground}} 98 {-redraw Boolean 1 0} 99 {-opencmd String "" 0} 100 {-closecmd String "" 0} 101 {-dropovermode Flag "wpn" 0 "wpn"} 102 {-bg Synonym -background} 103 104 {-crossopenimage String "" 0} 105 {-crosscloseimage String "" 0} 106 {-crossopenbitmap String "" 0} 107 {-crossclosebitmap String "" 0} 108 } 109 110 DragSite::include Tree "TREE_NODE" 1 111 DropSite::include Tree { 112 TREE_NODE {copy {} move {}} 113 } 114 115 Widget::addmap Tree "" .c {-deltay -yscrollincrement} 116 117 # Trees on windows have a white (system window) background 118 if { $::tcl_platform(platform) == "windows" } { 119 option add *Tree.c.background SystemWindow widgetDefault 120 option add *TreeNode.fill SystemWindowText widgetDefault 121 } 122 123 bind Tree <FocusIn> [list after idle {BWidget::refocus %W %W.c}] 124 bind Tree <Destroy> [list Tree::_destroy %W] 125 bind Tree <Configure> [list Tree::_update_scrollregion %W] 126 127 128 bind TreeSentinalStart <Button-1> { 129 if { $::Tree::sentinal(%W) } { 130 set ::Tree::sentinal(%W) 0 131 break 132 } 133 } 134 135 bind TreeSentinalEnd <Button-1> { 136 set ::Tree::sentinal(%W) 0 137 } 138 139 bind TreeFocus <Button-1> [list focus %W] 140 141 variable _edit 142} 143 144 145# ---------------------------------------------------------------------------- 146# Command Tree::create 147# ---------------------------------------------------------------------------- 148proc Tree::create { path args } { 149 variable $path 150 upvar 0 $path data 151 152 Widget::init Tree $path $args 153 set ::Tree::sentinal($path.c) 0 154 155 if {[Widget::cget $path -crossopenbitmap] == ""} { 156 set file [file join $::BWIDGET::LIBRARY images "minus.xbm"] 157 Widget::configure $path [list -crossopenbitmap @$file] 158 } 159 if {[Widget::cget $path -crossclosebitmap] == ""} { 160 set file [file join $::BWIDGET::LIBRARY images "plus.xbm"] 161 Widget::configure $path [list -crossclosebitmap @$file] 162 } 163 164 set data(root) {{}} 165 set data(selnodes) {} 166 set data(upd,level) 0 167 set data(upd,nodes) {} 168 set data(upd,afterid) "" 169 set data(dnd,scroll) "" 170 set data(dnd,afterid) "" 171 set data(dnd,selnodes) {} 172 set data(dnd,node) "" 173 174 frame $path -class Tree -bd 0 -highlightthickness 0 -relief flat \ 175 -takefocus 0 176 # For 8.4+ we don't want to inherit the padding 177 catch {$path configure -padx 0 -pady 0} 178 eval [list canvas $path.c] [Widget::subcget $path .c] -xscrollincrement 8 179 bindtags $path.c [list TreeSentinalStart TreeFocus $path.c Canvas \ 180 [winfo toplevel $path] all TreeSentinalEnd] 181 pack $path.c -expand yes -fill both 182 $path.c bind cross <ButtonPress-1> [list Tree::_cross_event $path] 183 184 # Added by ericm@scriptics.com 185 # These allow keyboard traversal of the tree 186 bind $path.c <KeyPress-Up> [list Tree::_keynav up $path] 187 bind $path.c <KeyPress-Down> [list Tree::_keynav down $path] 188 bind $path.c <KeyPress-Right> [list Tree::_keynav right $path] 189 bind $path.c <KeyPress-Left> [list Tree::_keynav left $path] 190 bind $path.c <KeyPress-space> [list +Tree::_keynav space $path] 191 192 # These allow keyboard control of the scrolling 193 bind $path.c <Control-KeyPress-Up> [list $path.c yview scroll -1 units] 194 bind $path.c <Control-KeyPress-Down> [list $path.c yview scroll 1 units] 195 bind $path.c <Control-KeyPress-Left> [list $path.c xview scroll -1 units] 196 bind $path.c <Control-KeyPress-Right> [list $path.c xview scroll 1 units] 197 # ericm@scriptics.com 198 199 BWidget::bindMouseWheel $path.c 200 201 DragSite::setdrag $path $path.c Tree::_init_drag_cmd \ 202 [Widget::cget $path -dragendcmd] 1 203 DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd 1 204 205 Widget::create Tree $path 206 207 set w [Widget::cget $path -width] 208 set h [Widget::cget $path -height] 209 set dy [Widget::cget $path -deltay] 210 $path.c configure -width [expr {$w*8}] -height [expr {$h*$dy}] 211 212 # ericm 213 # Bind <Button-1> to select the clicked node -- no reason not to, right? 214 215 ## Bind button 1 to select the node via the _mouse_select command. 216 ## This command will generate the proper <<TreeSelect>> virtual event 217 ## when necessary. 218 set selectcmd Tree::_mouse_select 219 Tree::bindText $path <Button-1> [list $selectcmd $path set] 220 Tree::bindImage $path <Button-1> [list $selectcmd $path set] 221 Tree::bindText $path <Control-Button-1> [list $selectcmd $path toggle] 222 Tree::bindImage $path <Control-Button-1> [list $selectcmd $path toggle] 223 224 225 # Add sentinal bindings for double-clicking on items, to handle the 226 # gnarly Tk bug wherein: 227 # ButtonClick 228 # ButtonClick 229 # On a canvas item translates into button click on the item, button click 230 # on the canvas, double-button on the item, single button click on the 231 # canvas (which can happen if the double-button on the item causes some 232 # other event to be handled in between when the button clicks are examined 233 # for the canvas) 234 $path.c bind TreeItemSentinal <Double-Button-1> \ 235 [list set ::Tree::sentinal($path.c) 1] 236 # ericm 237 238 return $path 239} 240 241 242# ---------------------------------------------------------------------------- 243# Command Tree::configure 244# ---------------------------------------------------------------------------- 245proc Tree::configure { path args } { 246 variable $path 247 upvar 0 $path data 248 249 set res [Widget::configure $path $args] 250 251 set ch1 [expr {[Widget::hasChanged $path -deltax val] | 252 [Widget::hasChanged $path -deltay dy] | 253 [Widget::hasChanged $path -padx val] | 254 [Widget::hasChanged $path -showlines val]}] 255 256 set ch2 [expr {[Widget::hasChanged $path -selectbackground val] | 257 [Widget::hasChanged $path -selectforeground val]}] 258 259 if { [Widget::hasChanged $path -linesfill fill] | 260 [Widget::hasChanged $path -linestipple stipple] } { 261 $path.c itemconfigure line -fill $fill -stipple $stipple 262 } 263 264 if { [Widget::hasChanged $path -crossfill fill] } { 265 $path.c itemconfigure cross -foreground $fill 266 } 267 268 if {[Widget::hasChanged $path -selectfill fill]} { 269 # Make sure that the full-width boxes have either all or none 270 # of the standard node bindings 271 if {$fill} { 272 foreach event [$path.c bind "node"] { 273 $path.c bind "box" $event [$path.c bind "node" $event] 274 } 275 } else { 276 foreach event [$path.c bind "node"] { 277 $path.c bind "box" $event {} 278 } 279 } 280 } 281 282 if { $ch1 } { 283 _redraw_idle $path 3 284 } elseif { $ch2 } { 285 _redraw_idle $path 1 286 } 287 288 if { [Widget::hasChanged $path -height h] } { 289 $path.c configure -height [expr {$h*$dy}] 290 } 291 if { [Widget::hasChanged $path -width w] } { 292 $path.c configure -width [expr {$w*8}] 293 } 294 295 if { [Widget::hasChanged $path -redraw bool] && $bool } { 296 set upd $data(upd,level) 297 set data(upd,level) 0 298 _redraw_idle $path $upd 299 } 300 301 set force [Widget::hasChanged $path -dragendcmd dragend] 302 DragSite::setdrag $path $path.c Tree::_init_drag_cmd $dragend $force 303 DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd 304 305 return $res 306} 307 308 309# ---------------------------------------------------------------------------- 310# Command Tree::cget 311# ---------------------------------------------------------------------------- 312proc Tree::cget { path option } { 313 return [Widget::cget $path $option] 314} 315 316 317# ---------------------------------------------------------------------------- 318# Command Tree::insert 319# ---------------------------------------------------------------------------- 320proc Tree::insert { path index parent node args } { 321 variable $path 322 upvar 0 $path data 323 324 set node [_node_name $path $node] 325 set node [Widget::nextIndex $path $node] 326 327 if { [info exists data($node)] } { 328 return -code error "node \"$node\" already exists" 329 } 330 if { ![info exists data($parent)] } { 331 return -code error "node \"$parent\" does not exist" 332 } 333 334 Widget::init Tree::Node $path.$node $args 335 if {[string equal $index "end"]} { 336 lappend data($parent) $node 337 } else { 338 incr index 339 set data($parent) [linsert $data($parent) $index $node] 340 } 341 set data($node) [list $parent] 342 343 if { [string equal $parent "root"] } { 344 _redraw_idle $path 3 345 } elseif { [visible $path $parent] } { 346 # parent is visible... 347 if { [Widget::getMegawidgetOption $path.$parent -open] } { 348 # ...and opened -> redraw whole 349 _redraw_idle $path 3 350 } else { 351 # ...and closed -> redraw cross 352 lappend data(upd,nodes) $parent 8 353 _redraw_idle $path 2 354 } 355 } 356 357 return $node 358} 359 360 361# ---------------------------------------------------------------------------- 362# Command Tree::itemconfigure 363# ---------------------------------------------------------------------------- 364proc Tree::itemconfigure { path node args } { 365 variable $path 366 upvar 0 $path data 367 368 set node [_node_name $path $node] 369 if { [string equal $node "root"] || ![info exists data($node)] } { 370 return -code error "node \"$node\" does not exist" 371 } 372 373 set result [Widget::configure $path.$node $args] 374 375 _set_help $path $node 376 377 if { [visible $path $node] } { 378 set lopt {} 379 set flag 0 380 foreach opt {-window -image -drawcross -font -text -fill} { 381 set flag [expr {$flag << 1}] 382 if { [Widget::hasChanged $path.$node $opt val] } { 383 set flag [expr {$flag | 1}] 384 } 385 } 386 387 if { [Widget::hasChanged $path.$node -open val] } { 388 if {[llength $data($node)] > 1} { 389 # node have subnodes - full redraw 390 _redraw_idle $path 3 391 } else { 392 # force a redraw of the plus/minus sign 393 set flag [expr {$flag | 8}] 394 } 395 } 396 397 if {$data(upd,level) < 3 && [Widget::hasChanged $path.$node -padx x]} { 398 _redraw_idle $path 3 399 } 400 401 if { $data(upd,level) < 3 && $flag } { 402 if { [set idx [lsearch -exact $data(upd,nodes) $node]] == -1 } { 403 lappend data(upd,nodes) $node $flag 404 } else { 405 incr idx 406 set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}] 407 set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag] 408 } 409 _redraw_idle $path 2 410 } 411 } 412 return $result 413} 414 415 416# ---------------------------------------------------------------------------- 417# Command Tree::itemcget 418# ---------------------------------------------------------------------------- 419proc Tree::itemcget { path node option } { 420 # Instead of upvar'ing $path as data for this test, just directly refer to 421 # it, as that is faster. 422 set node [_node_name $path $node] 423 if { [string equal $node "root"] || \ 424 ![info exists ::Tree::${path}($node)] } { 425 return -code error "node \"$node\" does not exist" 426 } 427 428 return [Widget::cget $path.$node $option] 429} 430 431 432# ---------------------------------------------------------------------------- 433# Command Tree::bindText 434# ---------------------------------------------------------------------------- 435proc Tree::bindText { path event script } { 436 if {[string length $script]} { 437 append script " \[Tree::_get_node_name [list $path] current 2\]" 438 } 439 $path.c bind "node" $event $script 440 if {[Widget::getoption $path -selectfill]} { 441 $path.c bind "box" $event $script 442 } else { 443 $path.c bind "box" $event {} 444 } 445} 446 447 448# ---------------------------------------------------------------------------- 449# Command Tree::bindImage 450# ---------------------------------------------------------------------------- 451proc Tree::bindImage { path event script } { 452 if {[string length $script]} { 453 append script " \[Tree::_get_node_name [list $path] current 2\]" 454 } 455 $path.c bind "img" $event $script 456 if {[Widget::getoption $path -selectfill]} { 457 $path.c bind "box" $event $script 458 } else { 459 $path.c bind "box" $event {} 460 } 461} 462 463 464# ---------------------------------------------------------------------------- 465# Command Tree::delete 466# ---------------------------------------------------------------------------- 467proc Tree::delete { path args } { 468 variable $path 469 upvar 0 $path data 470 471 foreach lnodes $args { 472 foreach node $lnodes { 473 set node [_node_name $path $node] 474 if { ![string equal $node "root"] && [info exists data($node)] } { 475 set parent [lindex $data($node) 0] 476 set idx [lsearch -exact $data($parent) $node] 477 set data($parent) [lreplace $data($parent) $idx $idx] 478 _subdelete $path [list $node] 479 } 480 } 481 } 482 483 _redraw_idle $path 3 484} 485 486 487# ---------------------------------------------------------------------------- 488# Command Tree::move 489# ---------------------------------------------------------------------------- 490proc Tree::move { path parent node index } { 491 variable $path 492 upvar 0 $path data 493 494 set node [_node_name $path $node] 495 if { [string equal $node "root"] || ![info exists data($node)] } { 496 return -code error "node \"$node\" does not exist" 497 } 498 if { ![info exists data($parent)] } { 499 return -code error "node \"$parent\" does not exist" 500 } 501 set p $parent 502 while { ![string equal $p "root"] } { 503 if { [string equal $p $node] } { 504 return -code error "node \"$parent\" is a descendant of \"$node\"" 505 } 506 set p [parent $path $p] 507 } 508 509 set oldp [lindex $data($node) 0] 510 set idx [lsearch -exact $data($oldp) $node] 511 set data($oldp) [lreplace $data($oldp) $idx $idx] 512 set data($node) [concat [list $parent] [lrange $data($node) 1 end]] 513 if { [string equal $index "end"] } { 514 lappend data($parent) $node 515 } else { 516 incr index 517 set data($parent) [linsert $data($parent) $index $node] 518 } 519 if { ([string equal $oldp "root"] || 520 ([visible $path $oldp] && [Widget::getoption $path.$oldp -open])) || 521 ([string equal $parent "root"] || 522 ([visible $path $parent] && [Widget::getoption $path.$parent -open])) } { 523 _redraw_idle $path 3 524 } 525} 526 527 528# ---------------------------------------------------------------------------- 529# Command Tree::reorder 530# ---------------------------------------------------------------------------- 531proc Tree::reorder { path node neworder } { 532 variable $path 533 upvar 0 $path data 534 535 set node [_node_name $path $node] 536 if { ![info exists data($node)] } { 537 return -code error "node \"$node\" does not exist" 538 } 539 set children [lrange $data($node) 1 end] 540 if { [llength $children] } { 541 set children [BWidget::lreorder $children $neworder] 542 set data($node) [linsert $children 0 [lindex $data($node) 0]] 543 if { [visible $path $node] && [Widget::getoption $path.$node -open] } { 544 _redraw_idle $path 3 545 } 546 } 547} 548 549 550# ---------------------------------------------------------------------------- 551# Command Tree::selection 552# ---------------------------------------------------------------------------- 553proc Tree::selection { path cmd args } { 554 variable $path 555 upvar 0 $path data 556 557 switch -- $cmd { 558 toggle { 559 foreach node $args { 560 set node [_node_name $path $node] 561 if {![info exists data($node)]} { 562 return -code error \ 563 "$path selection toggle: Cannot toggle unknown node \"$node\"." 564 } 565 } 566 foreach node $args { 567 set node [_node_name $path $node] 568 if {[$path selection includes $node]} { 569 $path selection remove $node 570 } else { 571 $path selection add $node 572 } 573 } 574 } 575 set { 576 foreach node $args { 577 set node [_node_name $path $node] 578 if {![info exists data($node)]} { 579 return -code error \ 580 "$path selection set: Cannot select unknown node \"$node\"." 581 } 582 } 583 set data(selnodes) {} 584 foreach node $args { 585 set node [_node_name $path $node] 586 if { [Widget::getoption $path.$node -selectable] } { 587 if { [lsearch -exact $data(selnodes) $node] == -1 } { 588 lappend data(selnodes) $node 589 } 590 } 591 } 592 __call_selectcmd $path 593 } 594 add { 595 foreach node $args { 596 set node [_node_name $path $node] 597 if {![info exists data($node)]} { 598 return -code error \ 599 "$path selection add: Cannot select unknown node \"$node\"." 600 } 601 } 602 foreach node $args { 603 set node [_node_name $path $node] 604 if { [Widget::getoption $path.$node -selectable] } { 605 if { [lsearch -exact $data(selnodes) $node] == -1 } { 606 lappend data(selnodes) $node 607 } 608 } 609 } 610 __call_selectcmd $path 611 } 612 range { 613 # Here's our algorithm: 614 # make a list of all nodes, then take the range from node1 615 # to node2 and select those nodes 616 # 617 # This works because of how this widget handles redraws: 618 # The tree is always completely redrawn, and always from 619 # top to bottom. So the list of visible nodes *is* the 620 # list of nodes, and we can use that to decide which nodes 621 # to select. 622 623 if {[llength $args] != 2} { 624 return -code error \ 625 "wrong#args: Expected $path selection range node1 node2" 626 } 627 628 foreach {node1 node2} $args break 629 630 set node1 [_node_name $path $node1] 631 set node2 [_node_name $path $node2] 632 if {![info exists data($node1)]} { 633 return -code error \ 634 "$path selection range: Cannot start range at unknown node \"$node1\"." 635 } 636 if {![info exists data($node2)]} { 637 return -code error \ 638 "$path selection range: Cannot end range at unknown node \"$node2\"." 639 } 640 641 set nodes {} 642 foreach nodeItem [$path.c find withtag node] { 643 set node [Tree::_get_node_name $path $nodeItem 2] 644 if { [Widget::getoption $path.$node -selectable] } { 645 lappend nodes $node 646 } 647 } 648 # surles: Set the root string to the first element on the list. 649 if {$node1 == "root"} { 650 set node1 [lindex $nodes 0] 651 } 652 if {$node2 == "root"} { 653 set node2 [lindex $nodes 0] 654 } 655 656 # Find the first visible ancestor of node1, starting with node1 657 while {[set index1 [lsearch -exact $nodes $node1]] == -1} { 658 set node1 [lindex $data($node1) 0] 659 } 660 # Find the first visible ancestor of node2, starting with node2 661 while {[set index2 [lsearch -exact $nodes $node2]] == -1} { 662 set node2 [lindex $data($node2) 0] 663 } 664 # If the nodes were given in backwards order, flip the 665 # indices now 666 if { $index2 < $index1 } { 667 incr index1 $index2 668 set index2 [expr {$index1 - $index2}] 669 set index1 [expr {$index1 - $index2}] 670 } 671 set data(selnodes) [lrange $nodes $index1 $index2] 672 __call_selectcmd $path 673 } 674 remove { 675 foreach node $args { 676 set node [_node_name $path $node] 677 if { [set idx [lsearch -exact $data(selnodes) $node]] != -1 } { 678 set data(selnodes) [lreplace $data(selnodes) $idx $idx] 679 } 680 } 681 __call_selectcmd $path 682 } 683 clear { 684 if {[llength $args] != 0} { 685 return -code error \ 686 "wrong#args: Expected $path selection clear" 687 } 688 set data(selnodes) {} 689 __call_selectcmd $path 690 } 691 get { 692 if {[llength $args] != 0} { 693 return -code error \ 694 "wrong#args: Expected $path selection get" 695 } 696 return $data(selnodes) 697 } 698 includes { 699 if {[llength $args] != 1} { 700 return -code error \ 701 "wrong#args: Expected $path selection includes node" 702 } 703 set node [lindex $args 0] 704 set node [_node_name $path $node] 705 return [expr {[lsearch -exact $data(selnodes) $node] != -1}] 706 } 707 default { 708 return 709 } 710 } 711 _redraw_idle $path 1 712} 713 714 715proc Tree::getcanvas { path } { 716 return $path.c 717} 718 719 720proc Tree::__call_selectcmd { path } { 721 variable $path 722 upvar 0 $path data 723 724 set selectcmd [Widget::getoption $path -selectcommand] 725 if {[llength $selectcmd]} { 726 lappend selectcmd $path 727 lappend selectcmd $data(selnodes) 728 uplevel \#0 $selectcmd 729 } 730 return 731} 732 733# ---------------------------------------------------------------------------- 734# Command Tree::exists 735# ---------------------------------------------------------------------------- 736proc Tree::exists { path node } { 737 variable $path 738 upvar 0 $path data 739 740 set node [_node_name $path $node] 741 return [info exists data($node)] 742} 743 744 745# ---------------------------------------------------------------------------- 746# Command Tree::visible 747# ---------------------------------------------------------------------------- 748proc Tree::visible { path node } { 749 set node [_node_name $path $node] 750 set idn [$path.c find withtag n:$node] 751 return [llength $idn] 752} 753 754 755# ---------------------------------------------------------------------------- 756# Command Tree::parent 757# ---------------------------------------------------------------------------- 758proc Tree::parent { path node } { 759 variable $path 760 upvar 0 $path data 761 762 set node [_node_name $path $node] 763 if { ![info exists data($node)] } { 764 return -code error "node \"$node\" does not exist" 765 } 766 return [lindex $data($node) 0] 767} 768 769 770# ---------------------------------------------------------------------------- 771# Command Tree::index 772# ---------------------------------------------------------------------------- 773proc Tree::index { path node } { 774 variable $path 775 upvar 0 $path data 776 777 set node [_node_name $path $node] 778 if { [string equal $node "root"] || ![info exists data($node)] } { 779 return -code error "node \"$node\" does not exist" 780 } 781 set parent [lindex $data($node) 0] 782 return [expr {[lsearch -exact $data($parent) $node] - 1}] 783} 784 785 786# ---------------------------------------------------------------------------- 787# Tree::find 788# Returns the node given a position. 789# findInfo @x,y ?confine? 790# lineNumber 791# ---------------------------------------------------------------------------- 792proc Tree::find {path findInfo {confine ""}} { 793 if {[regexp -- {^@([0-9]+),([0-9]+)$} $findInfo match x y]} { 794 set x [$path.c canvasx $x] 795 set y [$path.c canvasy $y] 796 } elseif {[regexp -- {^[0-9]+$} $findInfo lineNumber]} { 797 set dy [Widget::getoption $path -deltay] 798 set y [expr {$dy*($lineNumber+0.5)}] 799 set confine "" 800 } else { 801 return -code error "invalid find spec \"$findInfo\"" 802 } 803 804 set found 0 805 set region [$path.c bbox all] 806 if {[llength $region]} { 807 set xi [lindex $region 0] 808 set xs [lindex $region 2] 809 foreach id [$path.c find overlapping $xi $y $xs $y] { 810 set ltags [$path.c gettags $id] 811 set item [lindex $ltags 1] 812 if { [string equal $item "node"] || 813 [string equal $item "img"] || 814 [string equal $item "win"] } { 815 # item is the label or image/window of the node 816 set node [Tree::_get_node_name $path $id 2] 817 set found 1 818 break 819 } 820 } 821 } 822 823 if {$found} { 824 if {[string equal $confine "confine"]} { 825 # test if x stand inside node bbox 826 set padx [_get_node_padx $path $node] 827 set xi [expr {[lindex [$path.c coords n:$node] 0] - $padx}] 828 set xs [lindex [$path.c bbox n:$node] 2] 829 if {$x >= $xi && $x <= $xs} { 830 return $node 831 } 832 } else { 833 return $node 834 } 835 } 836 return "" 837} 838 839 840# ---------------------------------------------------------------------------- 841# Command Tree::line 842# Returns the line where is drawn a node. 843# ---------------------------------------------------------------------------- 844proc Tree::line {path node} { 845 set node [_node_name $path $node] 846 set item [$path.c find withtag n:$node] 847 if {[string length $item]} { 848 set dy [Widget::getoption $path -deltay] 849 set y [lindex [$path.c coords $item] 1] 850 set line [expr {int($y/$dy)}] 851 } else { 852 set line -1 853 } 854 return $line 855} 856 857 858# ---------------------------------------------------------------------------- 859# Command Tree::nodes 860# ---------------------------------------------------------------------------- 861proc Tree::nodes { path node {first ""} {last ""} } { 862 variable $path 863 upvar 0 $path data 864 865 set node [_node_name $path $node] 866 if { ![info exists data($node)] } { 867 return -code error "node \"$node\" does not exist" 868 } 869 870 if { ![string length $first] } { 871 return [lrange $data($node) 1 end] 872 } 873 874 if { ![string length $last] } { 875 return [lindex [lrange $data($node) 1 end] $first] 876 } else { 877 return [lrange [lrange $data($node) 1 end] $first $last] 878 } 879} 880 881 882# Tree::visiblenodes -- 883# 884# Retrieve a list of all the nodes in a tree. 885# 886# Arguments: 887# path tree to retrieve nodes for. 888# 889# Results: 890# nodes list of nodes in the tree. 891 892proc Tree::visiblenodes { path } { 893 variable $path 894 upvar 0 $path data 895 896 # Root is always open (?), so all of its children automatically get added 897 # to the result, and to the stack. 898 set st [lrange $data(root) 1 end] 899 set result $st 900 901 while {[llength $st]} { 902 set node [lindex $st end] 903 set st [lreplace $st end end] 904 # Danger, danger! Using getMegawidgetOption is fragile, but much 905 # much faster than going through cget. 906 if { [Widget::getMegawidgetOption $path.$node -open] } { 907 set nodes [lrange $data($node) 1 end] 908 set result [concat $result $nodes] 909 set st [concat $st $nodes] 910 } 911 } 912 return $result 913} 914 915# ---------------------------------------------------------------------------- 916# Command Tree::see 917# ---------------------------------------------------------------------------- 918proc Tree::see { path node } { 919 variable $path 920 upvar 0 $path data 921 922 set node [_node_name $path $node] 923 if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } { 924 after cancel $data(upd,afterid) 925 _redraw_tree $path 926 } 927 set idn [$path.c find withtag n:$node] 928 if { $idn != "" } { 929 Tree::_see $path $idn 930 } 931} 932 933 934# ---------------------------------------------------------------------------- 935# Command Tree::opentree 936# ---------------------------------------------------------------------------- 937# JDC: added option recursive 938proc Tree::opentree { path node {recursive 1} } { 939 variable $path 940 upvar 0 $path data 941 942 set node [_node_name $path $node] 943 if { [string equal $node "root"] || ![info exists data($node)] } { 944 return -code error "node \"$node\" does not exist" 945 } 946 947 _recexpand $path $node 1 $recursive [Widget::getoption $path -opencmd] 948 _redraw_idle $path 3 949} 950 951 952# ---------------------------------------------------------------------------- 953# Command Tree::closetree 954# ---------------------------------------------------------------------------- 955proc Tree::closetree { path node {recursive 1} } { 956 variable $path 957 upvar 0 $path data 958 959 set node [_node_name $path $node] 960 if { [string equal $node "root"] || ![info exists data($node)] } { 961 return -code error "node \"$node\" does not exist" 962 } 963 964 _recexpand $path $node 0 $recursive [Widget::getoption $path -closecmd] 965 _redraw_idle $path 3 966} 967 968 969proc Tree::toggle { path node } { 970 if {[$path itemcget $node -open]} { 971 $path closetree $node 0 972 } else { 973 $path opentree $node 0 974 } 975} 976 977 978# ---------------------------------------------------------------------------- 979# Command Tree::edit 980# ---------------------------------------------------------------------------- 981proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} { 982 variable _edit 983 variable $path 984 upvar 0 $path data 985 986 set node [_node_name $path $node] 987 if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } { 988 after cancel $data(upd,afterid) 989 _redraw_tree $path 990 } 991 set idn [$path.c find withtag n:$node] 992 if { $idn != "" } { 993 Tree::_see $path $idn 994 995 set oldfg [$path.c itemcget $idn -fill] 996 set sbg [Widget::getoption $path -selectbackground] 997 set coords [$path.c coords $idn] 998 set x [lindex $coords 0] 999 set y [lindex $coords 1] 1000 set bd [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}] 1001 set w [expr {[winfo width $path] - 2*$bd}] 1002 set wmax [expr {[$path.c canvasx $w]-$x}] 1003 1004 set _edit(text) $text 1005 set _edit(wait) 0 1006 1007 $path.c itemconfigure $idn -fill [Widget::getoption $path -background] 1008 $path.c itemconfigure s:$node -fill {} -outline {} 1009 1010 set frame [frame $path.edit \ 1011 -relief flat -borderwidth 0 -highlightthickness 0 \ 1012 -background [Widget::getoption $path -background]] 1013 set ent [entry $frame.edit \ 1014 -width 0 \ 1015 -relief solid \ 1016 -borderwidth 1 \ 1017 -highlightthickness 0 \ 1018 -foreground [Widget::getoption $path.$node -fill] \ 1019 -background [Widget::getoption $path -background] \ 1020 -selectforeground [Widget::getoption $path -selectforeground] \ 1021 -selectbackground $sbg \ 1022 -font [Widget::getoption $path.$node -font] \ 1023 -textvariable Tree::_edit(text)] 1024 pack $ent -ipadx 8 -anchor w 1025 1026 set idw [$path.c create window $x $y -window $frame -anchor w] 1027 trace variable Tree::_edit(text) w \ 1028 [list Tree::_update_edit_size $path $ent $idw $wmax] 1029 tkwait visibility $ent 1030 grab $frame 1031 BWidget::focus set $ent 1032 1033 _update_edit_size $path $ent $idw $wmax 1034 update 1035 if { $select } { 1036 $ent selection range 0 end 1037 $ent icursor end 1038 $ent xview end 1039 } 1040 1041 bindtags $ent [list $ent Entry] 1042 bind $ent <Escape> {set Tree::_edit(wait) 0} 1043 bind $ent <Return> {set Tree::_edit(wait) 1} 1044 if { $clickres == 0 || $clickres == 1 } { 1045 bind $frame <Button> [list set Tree::_edit(wait) $clickres] 1046 } 1047 1048 set ok 0 1049 while { !$ok } { 1050 tkwait variable Tree::_edit(wait) 1051 if { !$_edit(wait) || $verifycmd == "" || 1052 [uplevel \#0 $verifycmd [list $_edit(text)]] } { 1053 set ok 1 1054 } 1055 } 1056 1057 trace vdelete Tree::_edit(text) w \ 1058 [list Tree::_update_edit_size $path $ent $idw $wmax] 1059 grab release $frame 1060 BWidget::focus release $ent 1061 destroy $frame 1062 $path.c delete $idw 1063 $path.c itemconfigure $idn -fill $oldfg 1064 $path.c itemconfigure s:$node -fill $sbg -outline $sbg 1065 1066 if { $_edit(wait) } { 1067 return $_edit(text) 1068 } 1069 } 1070 return "" 1071} 1072 1073 1074# ---------------------------------------------------------------------------- 1075# Command Tree::xview 1076# ---------------------------------------------------------------------------- 1077proc Tree::xview { path args } { 1078 return [eval [list $path.c xview] $args] 1079} 1080 1081 1082# ---------------------------------------------------------------------------- 1083# Command Tree::yview 1084# ---------------------------------------------------------------------------- 1085proc Tree::yview { path args } { 1086 return [eval [list $path.c yview] $args] 1087} 1088 1089 1090# ---------------------------------------------------------------------------- 1091# Command Tree::_update_edit_size 1092# ---------------------------------------------------------------------------- 1093proc Tree::_update_edit_size { path entry idw wmax args } { 1094 set entw [winfo reqwidth $entry] 1095 if { $entw+8 >= $wmax } { 1096 $path.c itemconfigure $idw -width $wmax 1097 } else { 1098 $path.c itemconfigure $idw -width 0 1099 } 1100} 1101 1102 1103# ---------------------------------------------------------------------------- 1104# Command Tree::_see 1105# ---------------------------------------------------------------------------- 1106proc Tree::_see { path idn } { 1107 set bbox [$path.c bbox $idn] 1108 set scrl [$path.c cget -scrollregion] 1109 1110 set ymax [lindex $scrl 3] 1111 set dy [$path.c cget -yscrollincrement] 1112 set yv [$path yview] 1113 set yv0 [expr {round([lindex $yv 0]*$ymax/$dy)}] 1114 set yv1 [expr {round([lindex $yv 1]*$ymax/$dy)}] 1115 set y [expr {int([lindex [$path.c coords $idn] 1]/$dy)}] 1116 if { $y < $yv0 } { 1117 $path.c yview scroll [expr {$y-$yv0}] units 1118 } elseif { $y >= $yv1 } { 1119 $path.c yview scroll [expr {$y-$yv1+1}] units 1120 } 1121 1122 set xmax [lindex $scrl 2] 1123 set dx [$path.c cget -xscrollincrement] 1124 set xv [$path xview] 1125 set x0 [expr {int([lindex $bbox 0]/$dx)}] 1126 set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}] 1127 set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}] 1128 if { $x0 >= $xv1 || $x0 < $xv0 } { 1129 $path.c xview scroll [expr {$x0-$xv0}] units 1130 } 1131} 1132 1133 1134# ---------------------------------------------------------------------------- 1135# Command Tree::_recexpand 1136# ---------------------------------------------------------------------------- 1137# JDC : added option recursive 1138proc Tree::_recexpand { path node expand recursive cmd } { 1139 variable $path 1140 upvar 0 $path data 1141 1142 if { [Widget::getoption $path.$node -open] != $expand } { 1143 Widget::setoption $path.$node -open $expand 1144 if { $cmd != "" } { 1145 uplevel \#0 $cmd [list $node] 1146 } 1147 } 1148 1149 if { $recursive } { 1150 foreach subnode [lrange $data($node) 1 end] { 1151 _recexpand $path $subnode $expand $recursive $cmd 1152 } 1153 } 1154} 1155 1156 1157# ---------------------------------------------------------------------------- 1158# Command Tree::_subdelete 1159# ---------------------------------------------------------------------------- 1160proc Tree::_subdelete { path lnodes } { 1161 variable $path 1162 upvar 0 $path data 1163 1164 set sel $data(selnodes) 1165 1166 while { [llength $lnodes] } { 1167 set lsubnodes [list] 1168 foreach node $lnodes { 1169 foreach subnode [lrange $data($node) 1 end] { 1170 lappend lsubnodes $subnode 1171 } 1172 unset data($node) 1173 set idx [lsearch -exact $sel $node] 1174 if { $idx >= 0 } { 1175 set sel [lreplace $sel $idx $idx] 1176 } 1177 if { [set win [Widget::getoption $path.$node -window]] != "" } { 1178 destroy $win 1179 } 1180 Widget::destroy $path.$node 1181 } 1182 set lnodes $lsubnodes 1183 } 1184 1185 set data(selnodes) $sel 1186} 1187 1188 1189# ---------------------------------------------------------------------------- 1190# Command Tree::_update_scrollregion 1191# ---------------------------------------------------------------------------- 1192proc Tree::_update_scrollregion { path } { 1193 set bd [expr {2*([$path.c cget -borderwidth]+[$path.c cget -highlightthickness])}] 1194 set w [expr {[winfo width $path] - $bd}] 1195 set h [expr {[winfo height $path] - $bd}] 1196 set xinc [$path.c cget -xscrollincrement] 1197 set yinc [$path.c cget -yscrollincrement] 1198 set bbox [$path.c bbox node] 1199 if { [llength $bbox] } { 1200 set xs [lindex $bbox 2] 1201 set ys [lindex $bbox 3] 1202 1203 if { $w < $xs } { 1204 set w [expr {int($xs)}] 1205 if { [set r [expr {$w % $xinc}]] } { 1206 set w [expr {$w+$xinc-$r}] 1207 } 1208 } 1209 if { $h < $ys } { 1210 set h [expr {int($ys)}] 1211 if { [set r [expr {$h % $yinc}]] } { 1212 set h [expr {$h+$yinc-$r}] 1213 } 1214 } 1215 } 1216 1217 $path.c configure -scrollregion [list 0 0 $w $h] 1218 1219 if {[Widget::getoption $path -selectfill]} { 1220 _redraw_selection $path 1221 } 1222} 1223 1224 1225# ---------------------------------------------------------------------------- 1226# Command Tree::_cross_event 1227# ---------------------------------------------------------------------------- 1228proc Tree::_cross_event { path } { 1229 variable $path 1230 upvar 0 $path data 1231 1232 set node [Tree::_get_node_name $path current 1] 1233 if { [Widget::getoption $path.$node -open] } { 1234 Tree::itemconfigure $path $node -open 0 1235 if { [set cmd [Widget::getoption $path -closecmd]] != "" } { 1236 uplevel \#0 $cmd [list $node] 1237 } 1238 } else { 1239 Tree::itemconfigure $path $node -open 1 1240 if { [set cmd [Widget::getoption $path -opencmd]] != "" } { 1241 uplevel \#0 $cmd [list $node] 1242 } 1243 } 1244} 1245 1246 1247proc Tree::_draw_cross { path node open x y } { 1248 set idc [$path.c find withtag c:$node] 1249 1250 if { $open } { 1251 set img [Widget::cget $path -crossopenimage] 1252 set bmp [Widget::cget $path -crossopenbitmap] 1253 } else { 1254 set img [Widget::cget $path -crosscloseimage] 1255 set bmp [Widget::cget $path -crossclosebitmap] 1256 } 1257 1258 ## If we already have a cross for this node, we just adjust the image. 1259 if {$idc != ""} { 1260 if {$img == ""} { 1261 $path.c itemconfigure $idc -bitmap $bmp 1262 } else { 1263 $path.c itemconfigure $idc -image $img 1264 } 1265 return 1266 } 1267 1268 ## Create a new image for the cross. If the user has specified an 1269 ## image, it overrides a bitmap. 1270 if {$img == ""} { 1271 $path.c create bitmap $x $y \ 1272 -bitmap $bmp \ 1273 -background [$path.c cget -background] \ 1274 -foreground [Widget::getoption $path -crossfill] \ 1275 -tags [list cross c:$node] -anchor c 1276 } else { 1277 $path.c create image $x $y \ 1278 -image $img \ 1279 -tags [list cross c:$node] -anchor c 1280 } 1281} 1282 1283 1284# ---------------------------------------------------------------------------- 1285# Command Tree::_draw_node 1286# ---------------------------------------------------------------------------- 1287proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } { 1288 global env 1289 variable $path 1290 upvar 0 $path data 1291 1292 set x1 [expr {$x0+$deltax+5}] 1293 set y1 $y0 1294 if { $showlines } { 1295 $path.c create line $x0 $y0 $x1 $y0 \ 1296 -fill [Widget::getoption $path -linesfill] \ 1297 -stipple [Widget::getoption $path -linestipple] \ 1298 -tags line 1299 } 1300 $path.c create text [expr {$x1+$padx}] $y0 \ 1301 -text [Widget::getoption $path.$node -text] \ 1302 -fill [Widget::getoption $path.$node -fill] \ 1303 -font [Widget::getoption $path.$node -font] \ 1304 -anchor w \ 1305 -tags [Tree::_get_node_tags $path $node [list node n:$node]] 1306 set len [expr {[llength $data($node)] > 1}] 1307 set dc [Widget::getoption $path.$node -drawcross] 1308 set exp [Widget::getoption $path.$node -open] 1309 1310 if { $len && $exp } { 1311 set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \ 1312 [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines] 1313 } 1314 1315 if {![string equal $dc "never"] && ($len || [string equal $dc "allways"])} { 1316 _draw_cross $path $node $exp $x0 $y0 1317 } 1318 1319 if { [set win [Widget::getoption $path.$node -window]] != "" } { 1320 set a [Widget::cget $path.$node -anchor] 1321 $path.c create window $x1 $y0 -window $win -anchor $a \ 1322 -tags [Tree::_get_node_tags $path $node [list win i:$node]] 1323 } elseif { [set img [Widget::getoption $path.$node -image]] != "" } { 1324 set a [Widget::cget $path.$node -anchor] 1325 $path.c create image $x1 $y0 -image $img -anchor $a \ 1326 -tags [Tree::_get_node_tags $path $node [list img i:$node]] 1327 } 1328 set box [$path.c bbox n:$node i:$node] 1329 set id [$path.c create rect 0 [lindex $box 1] \ 1330 [winfo screenwidth $path] [lindex $box 3] \ 1331 -tags [Tree::_get_node_tags $path $node [list box b:$node]] \ 1332 -fill {} -outline {}] 1333 $path.c lower $id 1334 1335 _set_help $path $node 1336 1337 return $y1 1338} 1339 1340 1341# ---------------------------------------------------------------------------- 1342# Command Tree::_draw_subnodes 1343# ---------------------------------------------------------------------------- 1344proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } { 1345 set y1 $y0 1346 foreach node $nodes { 1347 set padx [_get_node_padx $path $node] 1348 set deltax [_get_node_deltax $path $node] 1349 set yp $y1 1350 set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines] 1351 } 1352 if { $showlines && [llength $nodes] } { 1353 set id [$path.c create line $x0 $y0 $x0 [expr {$yp+$deltay}] \ 1354 -fill [Widget::getoption $path -linesfill] \ 1355 -stipple [Widget::getoption $path -linestipple] \ 1356 -tags line] 1357 1358 $path.c lower $id 1359 } 1360 return $y1 1361} 1362 1363 1364# ---------------------------------------------------------------------------- 1365# Command Tree::_update_nodes 1366# ---------------------------------------------------------------------------- 1367proc Tree::_update_nodes { path } { 1368 global env 1369 variable $path 1370 upvar 0 $path data 1371 1372 set deltax [Widget::getoption $path -deltax] 1373 set padx [Widget::getoption $path -padx] 1374 foreach {node flag} $data(upd,nodes) { 1375 set idn [$path.c find withtag "n:$node"] 1376 if { $idn == "" } { 1377 continue 1378 } 1379 set padx [_get_node_padx $path $node] 1380 set deltax [_get_node_deltax $path $node] 1381 set c [$path.c coords $idn] 1382 set x0 [expr {[lindex $c 0]-$padx}] 1383 set y0 [lindex $c 1] 1384 if { $flag & 48 } { 1385 # -window or -image modified 1386 set win [Widget::getoption $path.$node -window] 1387 set img [Widget::getoption $path.$node -image] 1388 set idi [$path.c find withtag i:$node] 1389 set type [lindex [$path.c gettags $idi] 1] 1390 if { [string length $win] } { 1391 if { [string equal $type "win"] } { 1392 $path.c itemconfigure $idi -window $win 1393 } else { 1394 $path.c delete $idi 1395 $path.c create window $x0 $y0 -window $win -anchor w \ 1396 -tags [Tree::_get_node_tags $path $node \ 1397 [list win i:$node]] 1398 } 1399 } elseif { [string length $img] } { 1400 if { [string equal $type "img"] } { 1401 $path.c itemconfigure $idi -image $img 1402 } else { 1403 $path.c delete $idi 1404 $path.c create image $x0 $y0 -image $img -anchor w \ 1405 -tags [Tree::_get_node_tags $path $node \ 1406 [list img i:$node]] 1407 } 1408 } else { 1409 $path.c delete $idi 1410 } 1411 } 1412 1413 if { $flag & 8 } { 1414 # -drawcross modified 1415 set len [expr {[llength $data($node)] > 1}] 1416 set dc [Widget::getoption $path.$node -drawcross] 1417 set exp [Widget::getoption $path.$node -open] 1418 1419 if {![string equal $dc "never"] 1420 && ($len || [string equal $dc "allways"])} { 1421 _draw_cross $path $node $exp $x0 $y0 1422 } else { 1423 set idc [$path.c find withtag c:$node] 1424 $path.c delete $idc 1425 } 1426 } 1427 1428 if { $flag & 7 } { 1429 # -font, -text or -fill modified 1430 $path.c itemconfigure $idn \ 1431 -text [Widget::getoption $path.$node -text] \ 1432 -fill [Widget::getoption $path.$node -fill] \ 1433 -font [Widget::getoption $path.$node -font] 1434 } 1435 } 1436} 1437 1438 1439# ---------------------------------------------------------------------------- 1440# Command Tree::_draw_tree 1441# ---------------------------------------------------------------------------- 1442proc Tree::_draw_tree { path } { 1443 variable $path 1444 upvar 0 $path data 1445 1446 $path.c delete all 1447 set cursor [$path.c cget -cursor] 1448 $path.c configure -cursor watch 1449 _draw_subnodes $path [lrange $data(root) 1 end] 8 \ 1450 [expr {-[Widget::getoption $path -deltay]/2}] \ 1451 [Widget::getoption $path -deltax] \ 1452 [Widget::getoption $path -deltay] \ 1453 [Widget::getoption $path -padx] \ 1454 [Widget::getoption $path -showlines] 1455 $path.c configure -cursor $cursor 1456} 1457 1458 1459# ---------------------------------------------------------------------------- 1460# Command Tree::_redraw_tree 1461# ---------------------------------------------------------------------------- 1462proc Tree::_redraw_tree { path } { 1463 variable $path 1464 upvar 0 $path data 1465 1466 if { [Widget::getoption $path -redraw] } { 1467 if { $data(upd,level) == 2 } { 1468 _update_nodes $path 1469 } elseif { $data(upd,level) == 3 } { 1470 _draw_tree $path 1471 } 1472 _redraw_selection $path 1473 _update_scrollregion $path 1474 set data(upd,nodes) {} 1475 set data(upd,level) 0 1476 set data(upd,afterid) "" 1477 } 1478} 1479 1480 1481# ---------------------------------------------------------------------------- 1482# Command Tree::_redraw_selection 1483# ---------------------------------------------------------------------------- 1484proc Tree::_redraw_selection { path } { 1485 variable $path 1486 upvar 0 $path data 1487 1488 set selbg [Widget::getoption $path -selectbackground] 1489 set selfg [Widget::getoption $path -selectforeground] 1490 set fill [Widget::getoption $path -selectfill] 1491 if {$fill} { 1492 set scroll [$path.c cget -scrollregion] 1493 if {[llength $scroll]} { 1494 set xmax [expr {[lindex $scroll 2]-1}] 1495 } else { 1496 set xmax [winfo width $path] 1497 } 1498 } 1499 foreach id [$path.c find withtag sel] { 1500 set node [Tree::_get_node_name $path $id 1] 1501 $path.c itemconfigure "n:$node" -fill [Widget::getoption $path.$node -fill] 1502 } 1503 $path.c delete sel 1504 foreach node $data(selnodes) { 1505 set bbox [$path.c bbox "n:$node"] 1506 if { [llength $bbox] } { 1507 if {$fill} { 1508 # get the image to (if any), as it may have different height 1509 set bbox [$path.c bbox "n:$node" "i:$node"] 1510 set bbox [list 0 [lindex $bbox 1] $xmax [lindex $bbox 3]] 1511 } 1512 set id [$path.c create rectangle $bbox -tags [list sel s:$node] \ 1513 -fill $selbg -outline $selbg] 1514 $path.c itemconfigure "n:$node" -fill $selfg 1515 $path.c lower $id 1516 } 1517 } 1518} 1519 1520 1521# ---------------------------------------------------------------------------- 1522# Command Tree::_redraw_idle 1523# ---------------------------------------------------------------------------- 1524proc Tree::_redraw_idle { path level } { 1525 variable $path 1526 upvar 0 $path data 1527 1528 if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } { 1529 set data(upd,afterid) [after idle Tree::_redraw_tree $path] 1530 } 1531 if { $level > $data(upd,level) } { 1532 set data(upd,level) $level 1533 } 1534 return "" 1535} 1536 1537 1538# ---------------------------------------------------------------------------- 1539# Command Tree::_init_drag_cmd 1540# ---------------------------------------------------------------------------- 1541proc Tree::_init_drag_cmd { path X Y top } { 1542 set path [winfo parent $path] 1543 set ltags [$path.c gettags current] 1544 set item [lindex $ltags 1] 1545 if { [string equal $item "node"] || 1546 [string equal $item "img"] || 1547 [string equal $item "win"] } { 1548 set node [Tree::_get_node_name $path current 2] 1549 if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } { 1550 return [uplevel \#0 $cmd [list $path $node $top]] 1551 } 1552 if { [set type [Widget::getoption $path -dragtype]] == "" } { 1553 set type "TREE_NODE" 1554 } 1555 if { [set img [Widget::getoption $path.$node -image]] != "" } { 1556 pack [label $top.l -image $img -padx 0 -pady 0] 1557 } 1558 return [list $type {copy move link} $node] 1559 } 1560 return {} 1561} 1562 1563 1564# ---------------------------------------------------------------------------- 1565# Command Tree::_drop_cmd 1566# ---------------------------------------------------------------------------- 1567proc Tree::_drop_cmd { path source X Y op type dnddata } { 1568 set path [winfo parent $path] 1569 variable $path 1570 upvar 0 $path data 1571 1572 $path.c delete drop 1573 if { [string length $data(dnd,afterid)] } { 1574 after cancel $data(dnd,afterid) 1575 set data(dnd,afterid) "" 1576 } 1577 set data(dnd,scroll) "" 1578 if { [llength $data(dnd,node)] } { 1579 if { [set cmd [Widget::getoption $path -dropcmd]] != "" } { 1580 return [uplevel \#0 $cmd [list $path $source $data(dnd,node) $op $type $dnddata]] 1581 } 1582 } 1583 return 0 1584} 1585 1586 1587# ---------------------------------------------------------------------------- 1588# Command Tree::_over_cmd 1589# ---------------------------------------------------------------------------- 1590proc Tree::_over_cmd { path source event X Y op type dnddata } { 1591 set path [winfo parent $path] 1592 variable $path 1593 upvar 0 $path data 1594 1595 if { [string equal $event "leave"] } { 1596 # we leave the window tree 1597 $path.c delete drop 1598 if { [string length $data(dnd,afterid)] } { 1599 after cancel $data(dnd,afterid) 1600 set data(dnd,afterid) "" 1601 } 1602 set data(dnd,scroll) "" 1603 return 0 1604 } 1605 1606 if { [string equal $event "enter"] } { 1607 # we enter the window tree - dnd data initialization 1608 set mode [Widget::getoption $path -dropovermode] 1609 set data(dnd,mode) 0 1610 foreach c {w p n} { 1611 set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}] 1612 } 1613 set bbox [$path.c bbox all] 1614 if { [llength $bbox] } { 1615 set data(dnd,xs) [lindex $bbox 2] 1616 set data(dnd,empty) 0 1617 } else { 1618 set data(dnd,xs) 0 1619 set data(dnd,empty) 1 1620 } 1621 set data(dnd,node) {} 1622 } 1623 1624 set x [expr {$X-[winfo rootx $path]}] 1625 set y [expr {$Y-[winfo rooty $path]}] 1626 $path.c delete drop 1627 set data(dnd,node) {} 1628 1629 # test for auto-scroll unless mode is widget only 1630 if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } { 1631 return 2 1632 } 1633 1634 if { $data(dnd,mode) & 4 } { 1635 # dropovermode includes widget 1636 set target [list widget] 1637 set vmode 4 1638 } else { 1639 set target [list ""] 1640 set vmode 0 1641 } 1642 if { ($data(dnd,mode) & 2) && $data(dnd,empty) } { 1643 # dropovermode includes position and tree is empty 1644 lappend target [list root 0] 1645 set vmode [expr {$vmode | 2}] 1646 } 1647 1648 set xc [$path.c canvasx $x] 1649 set xs $data(dnd,xs) 1650 if { $xc <= $xs } { 1651 set yc [$path.c canvasy $y] 1652 set dy [$path.c cget -yscrollincrement] 1653 set line [expr {int($yc/$dy)}] 1654 set xi 0 1655 set yi [expr {$line*$dy}] 1656 set ys [expr {$yi+$dy}] 1657 set found 0 1658 foreach id [$path.c find overlapping $xi $yi $xs $ys] { 1659 set ltags [$path.c gettags $id] 1660 set item [lindex $ltags 1] 1661 if { [string equal $item "node"] || 1662 [string equal $item "img"] || 1663 [string equal $item "win"] } { 1664 # item is the label or image/window of the node 1665 set node [Tree::_get_node_name $path $id 2] 1666 set found 1 1667 break 1668 } 1669 } 1670 if {$found} { 1671 set padx [_get_node_padx $path $node] 1672 set deltax [_get_node_deltax $path $node] 1673 set xi [expr {[lindex [$path.c coords n:$node] 0] - $padx - 1}] 1674 if { $data(dnd,mode) & 1 } { 1675 # dropovermode includes node 1676 lappend target $node 1677 set vmode [expr {$vmode | 1}] 1678 } else { 1679 lappend target "" 1680 } 1681 1682 if { $data(dnd,mode) & 2 } { 1683 # dropovermode includes position 1684 if { $yc >= $yi+$dy/2 } { 1685 # position is after $node 1686 if { [Widget::getoption $path.$node -open] && 1687 [llength $data($node)] > 1 } { 1688 # $node is open and have subnodes 1689 # drop position is 0 in children of $node 1690 set parent $node 1691 set index 0 1692 set xli [expr {$xi-5}] 1693 } else { 1694 # $node is not open and doesn't have subnodes 1695 # drop position is after $node in children of parent of $node 1696 set parent [lindex $data($node) 0] 1697 set index [lsearch -exact $data($parent) $node] 1698 set xli [expr {$xi - $deltax - 5}] 1699 } 1700 set yl $ys 1701 } else { 1702 # position is before $node 1703 # drop position is before $node in children of parent of $node 1704 set parent [lindex $data($node) 0] 1705 set index [expr {[lsearch -exact $data($parent) $node] - 1}] 1706 set xli [expr {$xi - $deltax - 5}] 1707 set yl $yi 1708 } 1709 lappend target [list $parent $index] 1710 set vmode [expr {$vmode | 2}] 1711 } else { 1712 lappend target {} 1713 } 1714 1715 if { ($vmode & 3) == 3 } { 1716 # result have both node and position 1717 # we compute what is the preferred method 1718 if { $yc-$yi <= 3 || $ys-$yc <= 3 } { 1719 lappend target "position" 1720 } else { 1721 lappend target "node" 1722 } 1723 } 1724 } 1725 } 1726 1727 if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != "" } { 1728 # user-defined dropover command 1729 set res [uplevel \#0 $cmd [list $path $source $target $op $type $dnddata]] 1730 set code [lindex $res 0] 1731 set newmode 0 1732 if { $code & 1 } { 1733 # update vmode 1734 set mode [lindex $res 1] 1735 if { ($vmode & 1) && [string equal $mode "node"] } { 1736 set newmode 1 1737 } elseif { ($vmode & 2) && [string equal $mode "position"] } { 1738 set newmode 2 1739 } elseif { ($vmode & 4) && [string equal $mode "widget"] } { 1740 set newmode 4 1741 } 1742 } 1743 set vmode $newmode 1744 } else { 1745 if { ($vmode & 3) == 3 } { 1746 # result have both item and position 1747 # we choose the preferred method 1748 if { [string equal [lindex $target 3] "position"] } { 1749 set vmode [expr {$vmode & ~1}] 1750 } else { 1751 set vmode [expr {$vmode & ~2}] 1752 } 1753 } 1754 1755 if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } { 1756 # dropovermode is widget or empty - recall is not necessary 1757 set code 1 1758 } else { 1759 set code 3 1760 } 1761 } 1762 1763 if {!$data(dnd,empty)} { 1764 # draw dnd visual following vmode 1765 if { $vmode & 1 } { 1766 set data(dnd,node) [list "node" [lindex $target 1]] 1767 $path.c create rectangle $xi $yi $xs $ys -tags drop 1768 } elseif { $vmode & 2 } { 1769 set data(dnd,node) [concat "position" [lindex $target 2]] 1770 $path.c create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop 1771 } elseif { $vmode & 4 } { 1772 set data(dnd,node) [list "widget"] 1773 } else { 1774 set code [expr {$code & 2}] 1775 } 1776 } 1777 1778 if { $code & 1 } { 1779 DropSite::setcursor based_arrow_down 1780 } else { 1781 DropSite::setcursor dot 1782 } 1783 return $code 1784} 1785 1786 1787# ---------------------------------------------------------------------------- 1788# Command Tree::_auto_scroll 1789# ---------------------------------------------------------------------------- 1790proc Tree::_auto_scroll { path x y } { 1791 variable $path 1792 upvar 0 $path data 1793 1794 set xmax [winfo width $path] 1795 set ymax [winfo height $path] 1796 set scroll {} 1797 if { $y <= 6 } { 1798 if { [lindex [$path.c yview] 0] > 0 } { 1799 set scroll [list yview -1] 1800 DropSite::setcursor sb_up_arrow 1801 } 1802 } elseif { $y >= $ymax-6 } { 1803 if { [lindex [$path.c yview] 1] < 1 } { 1804 set scroll [list yview 1] 1805 DropSite::setcursor sb_down_arrow 1806 } 1807 } elseif { $x <= 6 } { 1808 if { [lindex [$path.c xview] 0] > 0 } { 1809 set scroll [list xview -1] 1810 DropSite::setcursor sb_left_arrow 1811 } 1812 } elseif { $x >= $xmax-6 } { 1813 if { [lindex [$path.c xview] 1] < 1 } { 1814 set scroll [list xview 1] 1815 DropSite::setcursor sb_right_arrow 1816 } 1817 } 1818 1819 if { [string length $data(dnd,afterid)] && ![string equal $data(dnd,scroll) $scroll] } { 1820 after cancel $data(dnd,afterid) 1821 set data(dnd,afterid) "" 1822 } 1823 1824 set data(dnd,scroll) $scroll 1825 if { [string length $scroll] && ![string length $data(dnd,afterid)] } { 1826 set data(dnd,afterid) [after 200 Tree::_scroll $path $scroll] 1827 } 1828 return $data(dnd,afterid) 1829} 1830 1831 1832# ---------------------------------------------------------------------------- 1833# Command Tree::_scroll 1834# ---------------------------------------------------------------------------- 1835proc Tree::_scroll { path cmd dir } { 1836 variable $path 1837 upvar 0 $path data 1838 1839 if { ($dir == -1 && [lindex [$path.c $cmd] 0] > 0) || 1840 ($dir == 1 && [lindex [$path.c $cmd] 1] < 1) } { 1841 $path.c $cmd scroll $dir units 1842 set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir] 1843 } else { 1844 set data(dnd,afterid) "" 1845 DropSite::setcursor dot 1846 } 1847} 1848 1849# Tree::_keynav -- 1850# 1851# Handle navigational keypresses on the tree. 1852# 1853# Arguments: 1854# which tag indicating the direction of motion: 1855# up move to the node graphically above current 1856# down move to the node graphically below current 1857# left close current if open, else move to parent 1858# right open current if closed, else move to child 1859# open open current if closed, close current if open 1860# win name of the tree widget 1861# 1862# Results: 1863# None. 1864 1865proc Tree::_keynav {which win} { 1866 # Keyboard navigation is riddled with special cases. In order to avoid 1867 # the complex logic, we will instead make a list of all the visible, 1868 # selectable nodes, then do a simple next or previous operation. 1869 1870 # One easy way to get all of the visible nodes is to query the canvas 1871 # object for all the items with the "node" tag; since the tree is always 1872 # completely redrawn, this list will be in vertical order. 1873 set nodes {} 1874 foreach nodeItem [$win.c find withtag node] { 1875 set node [Tree::_get_node_name $win $nodeItem 2] 1876 if { [Widget::cget $win.$node -selectable] } { 1877 lappend nodes $node 1878 } 1879 } 1880 1881 # Keyboard navigation is all relative to the current node 1882 # surles: Get the current node for single or multiple selection schemas. 1883 set node [_get_current_node $win] 1884 1885 switch -exact -- $which { 1886 "up" { 1887 # Up goes to the node that is vertically above the current node 1888 # (NOT necessarily the current node's parent) 1889 if { [string equal $node ""] } { 1890 return 1891 } 1892 set index [lsearch -exact $nodes $node] 1893 incr index -1 1894 if { $index >= 0 } { 1895 $win selection set [lindex $nodes $index] 1896 _set_current_node $win [lindex $nodes $index] 1897 $win see [lindex $nodes $index] 1898 return 1899 } 1900 } 1901 "down" { 1902 # Down goes to the node that is vertically below the current node 1903 if { [string equal $node ""] } { 1904 $win selection set [lindex $nodes 0] 1905 _set_current_node $win [lindex $nodes 0] 1906 $win see [lindex $nodes 0] 1907 return 1908 } 1909 1910 set index [lsearch -exact $nodes $node] 1911 incr index 1912 if { $index < [llength $nodes] } { 1913 $win selection set [lindex $nodes $index] 1914 _set_current_node $win [lindex $nodes $index] 1915 $win see [lindex $nodes $index] 1916 return 1917 } 1918 } 1919 "right" { 1920 # On a right arrow, if the current node is closed, open it. 1921 # If the current node is open, go to its first child 1922 if { [string equal $node ""] } { 1923 return 1924 } 1925 set open [$win itemcget $node -open] 1926 if { $open } { 1927 if { [llength [$win nodes $node]] } { 1928 set index [lsearch -exact $nodes $node] 1929 incr index 1930 if { $index < [llength $nodes] } { 1931 $win selection set [lindex $nodes $index] 1932 _set_current_node $win [lindex $nodes $index] 1933 $win see [lindex $nodes $index] 1934 return 1935 } 1936 } 1937 } else { 1938 $win itemconfigure $node -open 1 1939 if { [set cmd [Widget::getoption $win -opencmd]] != "" } { 1940 uplevel \#0 $cmd [list $node] 1941 } 1942 return 1943 } 1944 } 1945 "left" { 1946 # On a left arrow, if the current node is open, close it. 1947 # If the current node is closed, go to its parent. 1948 if { [string equal $node ""] } { 1949 return 1950 } 1951 set open [$win itemcget $node -open] 1952 if { $open } { 1953 $win itemconfigure $node -open 0 1954 if { [set cmd [Widget::getoption $win -closecmd]] != "" } { 1955 uplevel \#0 $cmd [list $node] 1956 } 1957 return 1958 } else { 1959 set parent [$win parent $node] 1960 if { [string equal $parent "root"] } { 1961 set parent $node 1962 } else { 1963 while { ![$win itemcget $parent -selectable] } { 1964 set parent [$win parent $parent] 1965 if { [string equal $parent "root"] } { 1966 set parent $node 1967 break 1968 } 1969 } 1970 } 1971 $win selection set $parent 1972 _set_current_node $win $parent 1973 $win see $parent 1974 return 1975 } 1976 } 1977 "space" { 1978 if { [string equal $node ""] } { 1979 return 1980 } 1981 set open [$win itemcget $node -open] 1982 if { [llength [$win nodes $node]] } { 1983 1984 # Toggle the open status of the chosen node. 1985 1986 $win itemconfigure $node -open [expr {$open?0:1}] 1987 1988 if {$open} { 1989 # Node was open, is now closed. Call the close-cmd 1990 1991 if { [set cmd [Widget::getoption $win -closecmd]] != "" } { 1992 uplevel \#0 $cmd [list $node] 1993 } 1994 } else { 1995 # Node was closed, is now open. Call the open-cmd 1996 1997 if { [set cmd [Widget::getoption $win -opencmd]] != "" } { 1998 uplevel \#0 $cmd [list $node] 1999 } 2000 } 2001 } 2002 } 2003 } 2004 return 2005} 2006 2007# Tree::_get_current_node -- 2008# 2009# Get the current node for either single or multiple 2010# node selection trees. If the tree allows for 2011# multiple selection, return the cursor node. Otherwise, 2012# if there is a selection, return the first node in the 2013# list. If there is no selection, return the root node. 2014# 2015# arguments: 2016# win name of the tree widget 2017# 2018# Results: 2019# The current node. 2020 2021proc Tree::_get_current_node {win} { 2022 if {[info exists selectTree::selectCursor($win)]} { 2023 set result $selectTree::selectCursor($win) 2024 } elseif {[set selList [$win selection get]] != {}} { 2025 set result [lindex $selList 0] 2026 } else { 2027 set result "" 2028 } 2029 return $result 2030} 2031 2032# Tree::_set_current_node -- 2033# 2034# Set the current node for either single or multiple 2035# node selection trees. 2036# 2037# arguments: 2038# win Name of the tree widget 2039# node The current node. 2040# 2041# Results: 2042# None. 2043 2044proc Tree::_set_current_node {win node} { 2045 if {[info exists selectTree::selectCursor($win)]} { 2046 set selectTree::selectCursor($win) $node 2047 } 2048 return 2049} 2050 2051# Tree::_get_node_name -- 2052# 2053# Given a canvas item, get the name of the tree node represented by that 2054# item. 2055# 2056# Arguments: 2057# path tree to query 2058# item Optional canvas item to examine; if omitted, 2059# defaults to "current" 2060# tagindex Optional tag index, since the n:nodename tag is not 2061# in the same spot for all canvas items. If omitted, 2062# defaults to "end-1", so it works with "current" item. 2063# 2064# Results: 2065# node name of the tree node. 2066 2067proc Tree::_get_node_name {path {item current} {tagindex end-1}} { 2068 return [string range [lindex [$path.c gettags $item] $tagindex] 2 end] 2069} 2070 2071# Tree::_get_node_padx -- 2072# 2073# Given a node in the tree, return it's padx value. If the value is 2074# less than 0, default to the padx of the entire tree. 2075# 2076# Arguments: 2077# path Tree to query 2078# node Node in the tree 2079# 2080# Results: 2081# padx The numeric padx value 2082proc Tree::_get_node_padx {path node} { 2083 set padx [Widget::getoption $path.$node -padx] 2084 if {$padx < 0} { set padx [Widget::getoption $path -padx] } 2085 return $padx 2086} 2087 2088# Tree::_get_node_deltax -- 2089# 2090# Given a node in the tree, return it's deltax value. If the value is 2091# less than 0, default to the deltax of the entire tree. 2092# 2093# Arguments: 2094# path Tree to query 2095# node Node in the tree 2096# 2097# Results: 2098# deltax The numeric deltax value 2099proc Tree::_get_node_deltax {path node} { 2100 set deltax [Widget::getoption $path.$node -deltax] 2101 if {$deltax < 0} { set deltax [Widget::getoption $path -deltax] } 2102 return $deltax 2103} 2104 2105 2106# Tree::_get_node_tags -- 2107# 2108# Given a node in the tree, return a list of tags to apply to its 2109# canvas item. 2110# 2111# Arguments: 2112# path Tree to query 2113# node Node in the tree 2114# tags A list of tags to add to the final list 2115# 2116# Results: 2117# list The list of tags to apply to the canvas item 2118proc Tree::_get_node_tags {path node {tags ""}} { 2119 eval [list lappend list TreeItemSentinal] $tags 2120 if {[Widget::getoption $path.$node -helptext] == ""} { return $list } 2121 2122 switch -- [Widget::getoption $path.$node -helptype] { 2123 balloon { 2124 lappend list BwHelpBalloon 2125 } 2126 variable { 2127 lappend list BwHelpVariable 2128 } 2129 } 2130 return $list 2131} 2132 2133# Tree::_set_help -- 2134# 2135# Register dynamic help for a node in the tree. 2136# 2137# Arguments: 2138# path Tree to query 2139# node Node in the tree 2140# force Optional argument to force a reset of the help 2141# 2142# Results: 2143# none 2144proc Tree::_set_help { path node } { 2145 Widget::getVariable $path help 2146 2147 set item $path.$node 2148 set opts [list -helptype -helptext -helpvar] 2149 foreach {cty ctx cv} [eval [list Widget::hasChangedX $item] $opts] break 2150 set text [Widget::getoption $item -helptext] 2151 2152 ## If we've never set help for this item before, and text is not blank, 2153 ## we need to setup help. We also need to reset help if any of the 2154 ## options have changed. 2155 if { (![info exists help($node)] && $text != "") || $cty || $ctx || $cv } { 2156 set help($node) 1 2157 set type [Widget::getoption $item -helptype] 2158 switch $type { 2159 balloon { 2160 DynamicHelp::register $path.c balloon n:$node $text 2161 DynamicHelp::register $path.c balloon i:$node $text 2162 DynamicHelp::register $path.c balloon b:$node $text 2163 } 2164 variable { 2165 set var [Widget::getoption $item -helpvar] 2166 DynamicHelp::register $path.c variable n:$node $var $text 2167 DynamicHelp::register $path.c variable i:$node $var $text 2168 DynamicHelp::register $path.c variable b:$node $var $text 2169 } 2170 } 2171 } 2172} 2173 2174proc Tree::_mouse_select { path cmd args } { 2175 eval selection [list $path] [list $cmd] $args 2176 switch -- $cmd { 2177 "add" - "clear" - "remove" - "set" - "toggle" { 2178 event generate $path <<TreeSelect>> 2179 } 2180 } 2181} 2182 2183 2184proc Tree::_node_name { path node } { 2185 set map [list & _ | _ ^ _ ! _] 2186 return [string map $map $node] 2187} 2188 2189 2190# ---------------------------------------------------------------------------- 2191# Command Tree::_destroy 2192# ---------------------------------------------------------------------------- 2193proc Tree::_destroy { path } { 2194 variable $path 2195 upvar 0 $path data 2196 2197 if { $data(upd,afterid) != "" } { 2198 after cancel $data(upd,afterid) 2199 } 2200 if { $data(dnd,afterid) != "" } { 2201 after cancel $data(dnd,afterid) 2202 } 2203 _subdelete $path [lrange $data(root) 1 end] 2204 Widget::destroy $path 2205 unset data 2206} 2207