1# 2# [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do 3# what it currently does) 4# 5 6package require tk 7package require tcltest 2.2 8namespace import -force tcltest::* 9loadTestedCommands 10 11# consistencyCheck -- 12# Traverse the tree to make sure the item data structures 13# are properly linked. 14# 15# Since [$tv children] follows ->next links and [$tv index] 16# follows ->prev links, this should cover all invariants. 17# 18proc consistencyCheck {tv {item {}}} { 19 set i 0; 20 foreach child [$tv children $item] { 21 assert {[$tv parent $child] == $item} "parent $child = $item" 22 assert {[$tv index $child] == $i} "index $child [$tv index $child]=$i" 23 incr i 24 consistencyCheck $tv $child 25 } 26} 27 28proc assert {expr {message ""}} { 29 if {![uplevel 1 [list expr $expr]]} { 30 set error "PANIC! PANIC! PANIC: $message ($expr failed)" 31 puts stderr $error 32 error $error 33 } 34} 35 36test treeview-0 "treeview test - setup" -body { 37 ttk::treeview .tv -columns {a b c} 38 pack .tv -expand true -fill both 39 update 40} 41 42test treeview-1.1 "columns" -body { 43 .tv configure -columns {a b c} 44} 45 46test treeview-1.2 "Bad columns" -body { 47 #.tv configure -columns {illegal "list"value} 48 ttk::treeview .badtv -columns {illegal "list"value} 49} -returnCodes error -result "list element in quotes followed by*" -match glob 50 51test treeview-1.3 "bad displaycolumns" -body { 52 .tv configure -displaycolumns {a b d} 53} -returnCodes error -result "Invalid column index d" 54 55test treeview-1.4 "more bad displaycolumns" -body { 56 .tv configure -displaycolumns {1 2 3} 57} -returnCodes error -result "Column index 3 out of bounds" 58 59test treeview-1.5 "Don't forget to check negative numbers" -body { 60 .tv configure -displaycolumns {1 -2 3} 61} -returnCodes error -result "Column index -2 out of bounds" 62 63# Item creation. 64# 65test treeview-2.1 "insert -- not enough args" -body { 66 .tv insert 67} -returnCodes error -result "wrong # args: *" -match glob 68 69test treeview-2.3 "insert -- bad integer index" -body { 70 .tv insert {} badindex 71} -returnCodes error -result "expected integer *" -match glob 72 73test treeview-2.4 "insert -- bad parent node" -body { 74 .tv insert badparent end 75} -returnCodes error -result "Item badparent not found" -match glob 76 77test treeview-2.5 "insert -- finaly insert a node" -body { 78 .tv insert {} end -id newnode -text "New node" 79} -result newnode 80 81test treeview-2.6 "insert -- make sure node was inserted" -body { 82 .tv children {} 83} -result [list newnode] 84 85test treeview-2.7 "insert -- prevent duplicate node names" -body { 86 .tv insert {} end -id newnode 87} -returnCodes error -result "Item newnode already exists" 88 89test treeview-2.8 "insert -- new node at end" -body { 90 .tv insert {} end -id lastnode 91 consistencyCheck .tv 92 .tv children {} 93} -result [list newnode lastnode] 94 95consistencyCheck .tv 96 97test treeview-2.9 "insert -- new node at beginning" -body { 98 .tv insert {} 0 -id firstnode 99 consistencyCheck .tv 100 .tv children {} 101} -result [list firstnode newnode lastnode] 102 103test treeview-2.10 "insert -- one more node" -body { 104 .tv insert {} 2 -id onemore 105 consistencyCheck .tv 106 .tv children {} 107} -result [list firstnode newnode onemore lastnode] 108 109test treeview-2.11 "insert -- and another one" -body { 110 .tv insert {} 2 -id anotherone 111 consistencyCheck .tv 112 .tv children {} 113} -result [list firstnode newnode anotherone onemore lastnode] 114 115test treeview-2.12 "insert -- one more at end" -body { 116 .tv insert {} end -id newlastone 117 consistencyCheck .tv 118 .tv children {} 119} -result [list firstnode newnode anotherone onemore lastnode newlastone] 120 121test treeview-2.13 "insert -- one more at beginning" -body { 122 .tv insert {} 0 -id newfirstone 123 consistencyCheck .tv 124 .tv children {} 125} -result [list newfirstone firstnode newnode anotherone onemore lastnode newlastone] 126 127test treeview-2.14 "insert -- bad options" -body { 128 .tv insert {} end -badoption foo 129} -returnCodes error -result {unknown option "-badoption"} 130 131test treeview-2.15 "insert -- at position 0 w/no children" -body { 132 .tv insert newnode 0 -id newnode.n2 -text "Foo" 133 .tv children newnode 134} -result newnode.n2 ;# don't crash 135 136test treeview-2.16 "insert -- insert way past end" -body { 137 .tv insert newnode 99 -id newnode.n3 -text "Foo" 138 consistencyCheck .tv 139 .tv children newnode 140} -result [list newnode.n2 newnode.n3] 141 142test treeview-2.17 "insert -- insert before beginning" -body { 143 .tv insert newnode -1 -id newnode.n1 -text "Foo" 144 consistencyCheck .tv 145 .tv children newnode 146} -result [list newnode.n1 newnode.n2 newnode.n3] 147 148### 149# 150test treeview-3.1 "parent" -body { 151 .tv parent newnode.n1 152} -result newnode 153test treeview-3.2 "parent - top-level node" -body { 154 .tv parent newnode 155} -result {} 156test treeview-3.3 "parent - root node" -body { 157 .tv parent {} 158} -result {} 159test treeview-3.4 "index" -body { 160 list [.tv index newnode.n3] [.tv index newnode.n2] [.tv index newnode.n1] 161} -result [list 2 1 0] 162test treeview-3.5 "index - exhaustive test" -body { 163 set result [list] 164 foreach item [.tv children {}] { 165 lappend result [.tv index $item] 166 } 167 set result 168} -result [list 0 1 2 3 4 5 6] 169 170test treeview-3.6 "detach" -body { 171 .tv detach newnode 172 consistencyCheck .tv 173 .tv children {} 174} -result [list newfirstone firstnode anotherone onemore lastnode newlastone] 175# XREF: treeview-2.13 176 177test treeview-3.7 "detach didn't screw up internal links" -body { 178 consistencyCheck .tv 179 set result [list] 180 foreach item [.tv children {}] { 181 lappend result [.tv index $item] 182 } 183 set result 184} -result [list 0 1 2 3 4 5] 185 186test treeview-3.8 "detached node has no parent, index 0" -body { 187 list [.tv parent newnode] [.tv index newnode] 188} -result [list {} 0] 189# @@@ Can't distinguish detached nodes from first root node 190 191test treeview-3.9 "detached node's children undisturbed" -body { 192 .tv children newnode 193} -result [list newnode.n1 newnode.n2 newnode.n3] 194 195test treeview-3.10 "detach is idempotent" -body { 196 .tv detach newnode 197 consistencyCheck .tv 198 .tv children {} 199} -result [list newfirstone firstnode anotherone onemore lastnode newlastone] 200 201test treeview-3.11 "Can't detach root item" -body { 202 .tv detach [list {}] 203 update 204 consistencyCheck .tv 205} -returnCodes error -result "Cannot detach root item" 206consistencyCheck .tv 207 208test treeview-3.12 "Reattach" -body { 209 .tv move newnode {} end 210 consistencyCheck .tv 211 .tv children {} 212} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode] 213 214# Bug # ????? 215test treeview-3.13 "Re-reattach" -body { 216 .tv move newnode {} end 217 consistencyCheck .tv 218 .tv children {} 219} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode] 220 221catch { 222 .tv insert newfirstone end -id x1 223 .tv insert newfirstone end -id x2 224 .tv insert newfirstone end -id x3 225} 226 227test treeview-3.14 "Duplicated entry in children list" -body { 228 .tv children newfirstone [list x3 x1 x2 x3] 229 # ??? Maybe this should raise an error? 230 consistencyCheck .tv 231 .tv children newfirstone 232} -result [list x3 x1 x2] 233 234test treeview-3.14.1 "Duplicated entry in children list" -body { 235 .tv children newfirstone [list x1 x2 x3 x3 x2 x1] 236 consistencyCheck .tv 237 .tv children newfirstone 238} -result [list x1 x2 x3] 239 240test treeview-3.15 "Consecutive duplicate entries in children list" -body { 241 .tv children newfirstone [list x1 x2 x2 x3] 242 consistencyCheck .tv 243 .tv children newfirstone 244} -result [list x1 x2 x3] 245 246test treeview-3.16 "Insert child after self" -body { 247 .tv move x2 newfirstone 1 248 consistencyCheck .tv 249 .tv children newfirstone 250} -result [list x1 x2 x3] 251 252test treeview-3.17 "Insert last child after self" -body { 253 .tv move x3 newfirstone 2 254 consistencyCheck .tv 255 .tv children newfirstone 256} -result [list x1 x2 x3] 257 258test treeview-3.18 "Insert last child after end" -body { 259 .tv move x3 newfirstone 3 260 consistencyCheck .tv 261 .tv children newfirstone 262} -result [list x1 x2 x3] 263 264test treeview-4.1 "opened - initial state" -body { 265 .tv item newnode -open 266} -result 0 267test treeview-4.2 "opened - open node" -body { 268 .tv item newnode -open 1 269 .tv item newnode -open 270} -result 1 271test treeview-4.3 "opened - closed node" -body { 272 .tv item newnode -open 0 273 .tv item newnode -open 274} -result 0 275 276test treeview-5.1 "item -- error checks" -body { 277 .tv item newnode -text "Bad values" -values "{bad}list" 278} -returnCodes error -result "list element in braces followed by*" -match glob 279 280test treeview-5.2 "item -- error leaves options unchanged " -body { 281 .tv item newnode -text 282} -result "New node" 283 284test treeview-5.3 "Heading" -body { 285 .tv heading #0 -text "Heading" 286} 287 288test treeview-5.4 "get cell" -body { 289 set l [list a b c] 290 .tv item newnode -values $l 291 .tv set newnode 1 292} -result b 293 294test treeview-5.5 "set cell" -body { 295 .tv set newnode 1 XXX 296 .tv item newnode -values 297} -result [list a XXX c] 298 299test treeview-5.6 "set illegal cell" -body { 300 .tv set newnode #0 YYY 301} -returnCodes error -result "Display column #0 cannot be set" 302 303test treeview-5.7 "set illegal cell" -body { 304 .tv set newnode 3 YY ;# 3 == current #columns 305} -returnCodes error -result "Column index 3 out of bounds" 306 307test treeview-5.8 "set display columns" -body { 308 .tv configure -displaycolumns [list 2 1 0] 309 .tv set newnode #1 X 310 .tv set newnode #2 Y 311 .tv set newnode #3 Z 312 .tv item newnode -values 313} -result [list Z Y X] 314 315test treeview-5.9 "display columns part 2" -body { 316 list [.tv column #1 -id] [.tv column #2 -id] [.tv column #3 -id] 317} -result [list c b a] 318 319test treeview-5.10 "cannot set column -id" -body { 320 .tv column #1 -id X 321} -returnCodes error -result "Attempt to change read-only option" 322 323test treeview-5.11 "get" -body { 324 .tv set newnode #1 325} -result X 326 327test treeview-5.12 "get dictionary" -body { 328 .tv set newnode 329} -result [list a Z b Y c X] 330 331test treeview-5.13 "get, no value" -body { 332 set newitem [.tv insert {} end] 333 set result [.tv set $newitem #1] 334 .tv delete $newitem 335 set result 336} -result {} 337 338 339test treeview-6.1 "deletion - setup" -body { 340 .tv insert {} end -id dtest 341 foreach id [list a b c d e] { 342 .tv insert dtest end -id $id 343 } 344 .tv children dtest 345} -result [list a b c d e] 346 347test treeview-6.1.1 "delete" -body { 348 .tv delete b 349 consistencyCheck .tv 350 list [.tv exists b] [.tv children dtest] 351} -result [list 0 [list a c d e]] 352 353consistencyCheck .tv 354 355test treeview-6.2 "delete - duplicate items in list" -body { 356 .tv delete [list a e a e] 357 consistencyCheck .tv 358 .tv children dtest 359} -result [list c d] 360 361test treeview-6.3 "delete - descendants removed" -body { 362 .tv insert c end -id c1 363 .tv insert c end -id c2 364 .tv insert c1 end -id c11 365 consistencyCheck .tv 366 .tv delete c 367 consistencyCheck .tv 368 list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11] 369} -result [list 0 0 0 0] 370 371test treeview-6.4 "delete - delete parent and descendants" -body { 372 .tv insert dtest end -id c 373 .tv insert c end -id c1 374 .tv insert c end -id c2 375 .tv insert c1 end -id c11 376 consistencyCheck .tv 377 .tv delete [list c c1 c2 c11] 378 consistencyCheck .tv 379 list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11] 380} -result [list 0 0 0 0] 381 382test treeview-6.5 "delete - delete descendants and parent" -body { 383 .tv insert dtest end -id c 384 .tv insert c end -id c1 385 .tv insert c end -id c2 386 .tv insert c1 end -id c11 387 consistencyCheck .tv 388 .tv delete [list c11 c1 c2 c] 389 consistencyCheck .tv 390 list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11] 391} -result [list 0 0 0 0] 392 393test treeview-6.6 "delete - end" -body { 394 consistencyCheck .tv 395 .tv children dtest 396} -result [list d] 397 398test treeview-7.1 "move" -body { 399 .tv insert d end -id d1 400 .tv insert d end -id d2 401 .tv insert d end -id d3 402 .tv move d3 d 0 403 consistencyCheck .tv 404 .tv children d 405} -result [list d3 d1 d2] 406 407test treeview-7.2 "illegal move" -body { 408 .tv move d d2 end 409} -returnCodes error -result "Cannot insert d as descendant of d2" 410 411test treeview-7.3 "illegal move has no effect" -body { 412 consistencyCheck .tv 413 .tv children d 414} -result [list d3 d1 d2] 415 416test treeview-7.4 "Replace children" -body { 417 .tv children d [list d3 d2 d1] 418 consistencyCheck .tv 419 .tv children d 420} -result [list d3 d2 d1] 421 422test treeview-7.5 "replace children - precondition" -body { 423 # Just check to make sure the test suite so far has left 424 # us in the state we expect to be in: 425 list [.tv parent newnode] [.tv children newnode] 426} -result [list {} [list newnode.n1 newnode.n2 newnode.n3]] 427 428test treeview-7.6 "Replace children - illegal move" -body { 429 .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3] 430} -returnCodes error -result "Cannot insert newnode.n1 as descendant of newnode.n1" 431 432consistencyCheck .tv 433 434test treeview-8.0 "Selection set" -body { 435 .tv selection set [list newnode.n1 newnode.n3 newnode.n2] 436 .tv selection 437} -result [list newnode.n1 newnode.n2 newnode.n3] 438 439test treeview-8.1 "Selection add" -body { 440 .tv selection add [list newnode] 441 .tv selection 442} -result [list newnode newnode.n1 newnode.n2 newnode.n3] 443 444test treeview-8.2 "Selection toggle" -body { 445 .tv selection toggle [list newnode.n2 d3] 446 .tv selection 447} -result [list newnode newnode.n1 newnode.n3 d3] 448 449test treeview-8.3 "Selection remove" -body { 450 .tv selection remove [list newnode.n2 d3] 451 .tv selection 452} -result [list newnode newnode.n1 newnode.n3] 453 454test treeview-8.4 "Selection - clear" -body { 455 .tv selection set {} 456 .tv selection 457} -result {} 458 459test treeview-8.5 "Selection - bad operation" -body { 460 .tv selection badop foo 461} -returnCodes error -match glob -result {bad selection operation "badop": must be *} 462 463test treeview-8.6 "Selection - <<TreeviewSelect>> on selection add" -body { 464 .tv selection set {} 465 bind .tv <<TreeviewSelect>> {set res 1} 466 set res 0 467 .tv selection add newnode.n1 468 update 469 set res 470} -result 1 471 472test treeview-8.7 "<<TreeviewSelect>> on selected item deletion" -body { 473 .tv selection set {} 474 .tv insert "" end -id selectedDoomed -text DeadItem 475 .tv insert "" end -id doomed -text AlsoDead 476 .tv selection add selectedDoomed 477 update 478 bind .tv <<TreeviewSelect>> {lappend res 1} 479 set res 0 480 .tv delete doomed 481 update 482 set res [expr {$res == 0}] 483 .tv delete selectedDoomed 484 update 485 set res 486} -result {1 1} 487 488### NEED: more tests for see/yview/scrolling 489 490proc scrollcallback {args} { 491 set ::scrolldata $args 492} 493test treeview-9.0 "scroll callback - empty tree" -body { 494 .tv configure -yscrollcommand scrollcallback 495 .tv delete [.tv children {}] 496 update 497 set ::scrolldata 498} -result [list 0.0 1.0] 499 500test treeview-9.1 "scrolling" -setup { 501 pack [ttk::treeview .tree -show tree] -fill y 502 for {set i 1} {$i < 100} {incr i} { 503 .tree insert {} end -text $i 504 } 505} -body { 506 .tree yview scroll 5 units 507 .tree identify item 2 2 508} -cleanup { 509 destroy .tree 510} -result {I006} 511 512test treeview-9.2 {scrolling on see command - bug [14188104c3]} -setup { 513 toplevel .top 514 ttk::treeview .top.tree -show {} -height 10 -columns {label} \ 515 -yscrollcommand [list .top.vs set] 516 ttk::scrollbar .top.vs -command {.top.tree yview} 517 grid .top.tree -row 0 -column 0 -sticky ns 518 grid .top.vs -row 0 -column 1 -sticky ns 519 update 520 proc setrows {n} { 521 .top.tree delete [.top.tree children {}] 522 for {set i 1} {$i <= $n} {incr i} { 523 .top.tree insert {} end -id row$i \ 524 -values [list [format "Row %2.2d" $i]] 525 } 526 .top.tree see row1 527 update idletasks 528 } 529} -body { 530 setrows 10 531 set res [.top.vs get] 532 setrows 20 533 lappend res [expr [lindex [.top.vs get] 1] < 1] 534} -cleanup { 535 destroy .top 536} -result {0.0 1.0 1} 537 538test treeview-9.3 {scrolling on see command, requested item is closed} -setup { 539 toplevel .top 540 ttk::treeview .top.tree -show tree -height 10 -columns {label} \ 541 -yscrollcommand [list .top.vs set] 542 ttk::scrollbar .top.vs -command {.top.tree yview} 543 grid .top.tree -row 0 -column 0 -sticky ns 544 grid .top.vs -row 0 -column 1 -sticky ns 545 546 .top.tree insert {} end -id a -text a 547 .top.tree insert a end -id b -text b 548 .top.tree insert b end -id c -text c 549 .top.tree insert c end -id d -text d 550 .top.tree insert d end -id e -text e 551 for {set i 6} {$i <= 15} {incr i} { 552 .top.tree insert {} end -id row$i \ 553 -values [list [format "Row %2.2d" $i]] 554 } 555 update 556} -body { 557 set before [lindex [.top.vs get] 1] 558 .top.tree see e 559 update idletasks 560 set after [lindex [.top.vs get] 1] 561 expr $after < $before 562} -cleanup { 563 destroy .top 564} -result 1 565 566### identify tests: 567# 568proc identify* {tv comps args} { 569 foreach {x y} $args { 570 foreach comp $comps { 571 lappend result [$tv identify $comp $x $y] 572 } 573 } 574 return $result 575} 576 577# get list of column IDs from list of display column ids. 578# 579proc columnids {tv dcols} { 580 set result [list] 581 foreach dcol $dcols { 582 if {[catch { 583 lappend result [$tv column $dcol -id] 584 }]} { 585 lappend result ERROR 586 } 587 } 588 return $result 589} 590 591test treeview-identify-setup "identify series - setup" -body { 592 destroy .tv 593 ttk::setTheme default 594 ttk::treeview .tv -columns [list A B C] 595 .tv insert {} end -id branch -text branch -open true 596 .tv insert branch end -id item1 -text item1 597 .tv insert branch end -id item2 -text item2 598 .tv insert branch end -id item3 -text item3 599 600 .tv column #0 -width 50 ;# 0-50 601 .tv column A -width 50 ;# 50-100 602 .tv column B -width 50 ;# 100-150 603 .tv column C -width 50 ;# 150-200 (plus slop for margins) 604 605 wm geometry . {} ; pack .tv ; update 606} 607 608test treeview-identify-1 "identify heading" -body { 609 .tv configure -show {headings tree} 610 update idletasks 611 identify* .tv {region column} 10 10 612} -result [list heading #0] 613 614test treeview-identify-2 "identify columns" -body { 615 .tv configure -displaycolumns #all 616 update idletasks 617 columnids .tv [identify* .tv column 25 10 75 10 125 10 175 10] 618} -result [list {} A B C] 619 620test treeview-identify-3 "reordered columns" -body { 621 .tv configure -displaycolumns {B A C} 622 update idletasks 623 columnids .tv [identify* .tv column 25 10 75 10 125 10 175 10] 624} -result [list {} B A C] 625 626test treeview-identify-4 "no tree column" -body { 627 .tv configure -displaycolumns #all -show {headings} 628 update idletasks 629 identify* .tv {region column} 25 10 75 10 125 10 175 10 630} -result [list heading #1 heading #2 heading #3 nothing {}] 631 632# Item height in default theme is 20px 633test treeview-identify-5 "vertical scan - no headings" -body { 634 .tv configure -displaycolumns #all -show {tree} 635 update idletasks 636 identify* .tv {region item} 25 10 25 30 25 50 25 70 25 90 637} -result [list tree branch tree item1 tree item2 tree item3 nothing {}] 638 639test treeview-identify-6 "vertical scan - with headings" -body { 640 .tv configure -displaycolumns #all -show {tree headings} 641 update idletasks 642 identify* .tv {region item} 25 10 25 30 25 50 25 70 25 90 643} -result [list heading {} tree branch tree item1 tree item2 tree item3] 644 645test treeview-identify-7 "vertical scan - headings, no tree" -body { 646 .tv configure -displaycolumns #all -show {headings} 647 update idletasks 648 identify* .tv {region item} 25 10 25 30 25 50 25 70 25 90 649} -result [list heading {} cell branch cell item1 cell item2 cell item3] 650 651# In default theme, -indent and -itemheight both 20px 652# Disclosure element name is "Treeitem.indicator" 653set disclosure "*.indicator" 654test treeview-identify-8 "identify element" -body { 655 .tv configure -show {tree} 656 .tv insert branch 0 -id branch2 -open true 657 .tv insert branch2 0 -id branch3 -open true 658 .tv insert branch3 0 -id leaf3 659 update idletasks; 660 identify* .tv {item element} 10 10 30 30 50 50 661} -match glob -result [list \ 662 branch $disclosure branch2 $disclosure branch3 $disclosure] 663 664# See #2381555 665test treeview-identify-9 "identify works when horizontally scrolled" -setup { 666 .tv configure -show {tree headings} 667 foreach column {#0 A B C} { 668 .tv column $column -stretch 0 -width 50 669 } 670 place .tv -x 0 -y 0 -width 100 671} -body { 672 set result [list] 673 foreach xoffs {0 50 100} { 674 .tv xview $xoffs ; update 675 lappend result [identify* .tv {region column} 10 10 60 10] 676 } 677 set result 678} -result [list \ 679 [list heading #0 heading #1] \ 680 [list heading #1 heading #2] \ 681 [list heading #2 heading #3] ] 682 683test treeview-identify-cleanup "identify - cleanup" -body { 684 destroy .tv 685} 686 687### NEED: tests for focus item, selection 688 689### Misc. tests: 690 691destroy .tv 692test treeview-10.1 "Root node properly initialized (#1541739)" -setup { 693 ttk::treeview .tv 694 .tv insert {} end -id a 695 .tv see a 696} -cleanup { 697 destroy .tv 698} 699 700test treeview-3006842 "Null bindings" -setup { 701 ttk::treeview .tv -show tree 702} -body { 703 .tv tag bind empty <Button-1> {} 704 .tv insert {} end -text "Click me" -tags empty 705 event generate .tv <Button-1> -x 10 -y 10 706 .tv tag bind empty 707} -result {} -cleanup { 708 destroy .tv 709} 710 711test treeview-3085489-1 "tag add, no -tags" -setup { 712 ttk::treeview .tv 713} -body { 714 set item [.tv insert {} end] 715 .tv tag add foo $item 716 .tv item $item -tags 717} -cleanup { 718 destroy .tv 719} -result [list foo] 720 721test treeview-3085489-2 "tag remove, no -tags" -setup { 722 ttk::treeview .tv 723} -body { 724 set item [.tv insert {} end] 725 .tv tag remove foo $item 726 .tv item $item -tags 727} -cleanup { 728 destroy .tv 729} -result [list] 730 731test treeview-368fa4561e "indicators cannot be clicked on leafs" -setup { 732 pack [ttk::treeview .tv] 733 .tv insert {} end -id foo -text "<-- (1) Click the blank space to my left" 734 update 735} -body { 736 foreach {x y w h} [.tv bbox foo #0] {} 737 set res [.tv item foo -open] 738 # using $h even for x computation is intentional here in order to simulate 739 # a mouse click on the (invisible since we're on a leaf) indicator 740 event generate .tv <Button-1> \ 741 -x [expr {$x + $h / 2}] \ 742 -y [expr {$y + $h / 2}] 743 lappend res [.tv item foo -open] 744 .tv insert foo end -text "sub" 745 lappend res [.tv item foo -open] 746} -cleanup { 747 destroy .tv 748} -result {0 0 0} 749 750test treeview-ce470f20fd-1 "dragging further than the right edge of the treeview is allowed" -setup { 751 pack [ttk::treeview .tv] 752 .tv heading #0 -text "Drag my right edge -->" 753 update 754} -body { 755 set res [.tv column #0 -width] 756 .tv drag #0 400 757 lappend res [expr {[.tv column #0 -width] > $res}] 758} -cleanup { 759 destroy .tv 760} -result {200 1} 761 762proc nostretch {tv} { 763 foreach col [$tv cget -columns] { 764 $tv column $col -stretch 0 765 } 766 $tv column #0 -stretch 0 767 update idletasks ; # redisplay $tv 768} 769 770test treeview-ce470f20fd-2 "changing -stretch resizes columns" -setup { 771 pack [ttk::treeview .tv -columns {bar colA colB colC foo}] 772 foreach col [.tv cget -columns] { 773 .tv heading $col -text $col 774 } 775 nostretch .tv 776 .tv column colA -width 50 ; .tv column colB -width 50 ; # slack created 777 update idletasks ; # redisplay treeview 778} -body { 779 # when no column is stretchable and one of them becomes stretchable 780 # the stretchable column takes the slack and the widget is redisplayed 781 # automatically at idle time 782 set res [.tv column colA -width] 783 .tv column colA -stretch 1 784 update idletasks ; # no slack anymore, widget redisplayed 785 lappend res [expr {[.tv column colA -width] > $res}] 786} -cleanup { 787 destroy .tv 788} -result {50 1} 789 790test treeview-ce470f20fd-3 "changing -stretch resizes columns" -setup { 791 pack [ttk::treeview .tv -columns {bar colA colB colC foo}] 792 foreach col [.tv cget -columns] { 793 .tv heading $col -text $col 794 } 795 .tv configure -displaycolumns {colB colA colC} 796 nostretch .tv 797 .tv column colA -width 50 ; .tv column colB -width 50 ; # slack created 798 update idletasks ; # redisplay treeview 799} -body { 800 # only some columns are displayed (and in a different order than declared 801 # in -columns), a displayed column becomes stretchable --> the stretchable 802 # column expands 803 set res [.tv column colA -width] 804 .tv column colA -stretch 1 805 update idletasks ; # no slack anymore, widget redisplayed 806 lappend res [expr {[.tv column colA -width] > $res}] 807} -cleanup { 808 destroy .tv 809} -result {50 1} 810 811test treeview-ce470f20fd-4 "changing -stretch resizes columns" -setup { 812 pack [ttk::treeview .tv -columns {bar colA colB colC foo}] 813 foreach col [.tv cget -columns] { 814 .tv heading $col -text $col 815 } 816 .tv configure -displaycolumns {colB colA colC} 817 nostretch .tv 818 .tv column colA -width 50 ; .tv column bar -width 60 ; # slack created 819 update idletasks ; # redisplay treeview 820} -body { 821 # only some columns are displayed (and in a different order than declared 822 # in -columns), a non-displayed column becomes stretchable --> nothing 823 # happens 824 set origTreeWidth [winfo width .tv] 825 set res [list [.tv column bar -width] [.tv column colA -width]] 826 .tv column bar -stretch 1 827 update idletasks ; # no change, widget redisplayed 828 lappend res [.tv column bar -width] [.tv column colA -width] 829 # this column becomes visible --> widget resizes 830 .tv configure -displaycolumns {bar colC colA colB} 831 update idletasks ; # no slack anymore because the widget resizes (shrinks) 832 lappend res [.tv column bar -width] [.tv column colA -width] \ 833 [expr {[winfo width .tv] < $origTreeWidth}] 834} -cleanup { 835 destroy .tv 836} -result {60 50 60 50 60 50 1} 837 838test treeview-11.1 "style command" -body { 839 ttk::treeview .w 840 list [.w cget -style] [.w style] [winfo class .w] 841} -cleanup { 842 destroy .w 843} -result {{} Treeview Treeview} 844test treeview-11.2 "style command" -body { 845 ttk::style configure customStyle.Treeview 846 ttk::treeview .w -style customStyle.Treeview 847 list [.w cget -style] [.w style] [winfo class .w] 848} -cleanup { 849 destroy .w 850} -result {customStyle.Treeview customStyle.Treeview Treeview} 851 852tcltest::cleanupTests 853