1# This file is a Tcl script to test out the "frame", "labelframe" and 2# "toplevel" commands of Tk. It is organized in the standard fashion for Tcl 3# tests. 4# 5# Copyright © 1994 The Regents of the University of California. 6# Copyright © 1994-1996 Sun Microsystems, Inc. 7# Copyright © 1998-1999 Scriptics Corporation. 8# All rights reserved. 9 10package require tcltest 2.2 11namespace import ::tcltest::* 12tcltest::configure {*}$argv 13tcltest::loadTestedCommands 14 15tcltest::testConstraint x11 [expr {[tk windowingsystem] eq "x11"}] 16 17# eatColors -- 18# Creates a toplevel window and allocates enough colors in it to use up all 19# the slots in an 8-bit colormap. 20# 21# Arguments: 22# w - Name of toplevel window to create. 23 24proc eatColors {w} { 25 catch {destroy $w} 26 toplevel $w 27 wm geom $w +0+0 28 canvas $w.c -width 400 -height 200 -bd 0 29 pack $w.c 30 for {set y 0} {$y < 8} {incr y} { 31 for {set x 0} {$x < 40} {incr x} { 32 set color [format #%02x%02x%02x [expr {$x*6}] [expr {$y*30}] 0] 33 $w.c create rectangle [expr {10*$x}] [expr {20*$y}] \ 34 [expr {10*$x + 10}] [expr {20*$y + 20}] -outline {} \ 35 -fill $color 36 } 37 } 38 update 39} 40 41# colorsFree -- 42# 43# Returns 1 if there appear to be free colormap entries in a window, 0 44# otherwise. 45# 46# Arguments: 47# w - Name of window in which to check. 48# red, green, blue - Intensities to use in a trial color allocation 49# to see if there are colormap entries free. 50 51proc colorsFree {w {red 31} {green 245} {blue 192}} { 52 lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] r g b 53 expr {($r/256 == $red) && ($g/256 == $green) && ($b/256 == $blue)} 54} 55 56# uniq -- 57# 58# Returns the unique items of a list in the order they first appear. 59# 60# Arguments: 61# list - The list to uniq-ify. 62proc uniq {list} { 63 set d {} 64 foreach item $list { 65 dict set d $item {} 66 } 67 return [dict keys $d] 68} 69 70# optnames -- 71# 72# Returns the option names out of a list of option details. 73# 74# Arguments: 75# options - The option detail list. 76proc optnames {options} { 77 lsort [lmap desc $options {lindex $desc 0}] 78} 79 80test frame-1.1 {frame configuration options} -setup { 81 deleteWindows 82} -body { 83 frame .f -class NewFrame 84 .f configure -class 85} -cleanup { 86 deleteWindows 87} -result {-class class Class Frame NewFrame} 88test frame-1.2 {frame configuration options} -setup { 89 deleteWindows 90} -body { 91 frame .f -class NewFrame 92 .f configure -class Different 93} -returnCodes error -cleanup { 94 deleteWindows 95} -result {can't modify -class option after widget is created} 96test frame-1.3 {frame configuration options} -setup { 97 deleteWindows 98} -body { 99 frame .f -colormap new 100 .f configure -colormap 101} -cleanup { 102 deleteWindows 103} -result {-colormap colormap Colormap {} new} 104test frame-1.4 {frame configuration options} -setup { 105 deleteWindows 106} -body { 107 frame .f -colormap new 108 .f configure -colormap . 109} -returnCodes error -cleanup { 110 deleteWindows 111} -result {can't modify -colormap option after widget is created} 112test frame-1.5 {frame configuration options} -setup { 113 deleteWindows 114} -body { 115 frame .f -visual default 116 .f configure -visual 117} -cleanup { 118 deleteWindows 119} -result {-visual visual Visual {} default} 120test frame-1.6 {frame configuration options} -setup { 121 deleteWindows 122} -body { 123 frame .f -visual default 124 .f configure -visual best 125} -returnCodes error -cleanup { 126 deleteWindows 127} -result {can't modify -visual option after widget is created} 128test frame-1.7 {frame configuration options} -setup { 129 deleteWindows 130} -body { 131 frame .f -screen bogus 132} -cleanup { 133 deleteWindows 134} -returnCodes error -result {unknown option "-screen"} 135test frame-1.8 {frame configuration options} -setup { 136 deleteWindows 137} -body { 138 frame .f -container true 139} -cleanup { 140 deleteWindows 141} -result {.f} 142test frame-1.9 {frame configuration options} -setup { 143 deleteWindows 144} -body { 145 frame .f -container true 146 .f configure -container 147} -cleanup { 148 deleteWindows 149} -result {-container container Container 0 1} 150test frame-1.10 {frame configuration options} -setup { 151 deleteWindows 152} -body { 153 frame .f -container bogus 154} -cleanup { 155 deleteWindows 156} -returnCodes error -result {expected boolean value but got "bogus"} 157test frame-1.11 {frame configuration options} -setup { 158 deleteWindows 159} -body { 160 frame .f 161 .f configure -container 1 162} -returnCodes error -cleanup { 163 deleteWindows 164} -result {can't modify -container option after widget is created} 165test frame-1.12 {frame configuration options} -setup { 166 deleteWindows 167} -body { 168 # Make sure all options can be set to the default value 169 frame .f 170 set opts {} 171 foreach opt [.f configure] { 172 if {[llength $opt] == 5} { 173 lappend opts [lindex $opt 0] [lindex $opt 4] 174 } 175 } 176 frame .g {*}$opts 177} -cleanup { 178 destroy .f .g 179 deleteWindows 180} -result .g 181 182destroy .f 183frame .f 184test frame-1.13 {frame configuration options} -body { 185 .f configure -background #ff0000 186 lindex [.f configure -background] 4 187} -cleanup { 188 .f configure -background [lindex [.f configure -background] 3] 189} -result "#ff0000" 190test frame-1.14 {frame configuration options} -body { 191 .f configure -background non-existent 192} -returnCodes error -result {unknown color name "non-existent"} 193test frame-1.15 {frame configuration options} -body { 194 .f configure -bd 4 195 lindex [.f configure -bd] 4 196} -cleanup { 197 .f configure -bd [lindex [.f configure -bd] 3] 198} -result 4 199test frame-1.16 {frame configuration options} -body { 200 .f configure -bd badValue 201} -returnCodes error -result {bad screen distance "badValue"} 202test frame-1.17 {frame configuration options} -body { 203 .f configure -bg #00ff00 204 lindex [.f configure -bg] 4 205} -cleanup { 206 .f configure -bg [lindex [.f configure -bg] 3] 207} -result "#00ff00" 208test frame-1.18 {frame configuration options} -body { 209 .f configure -bg non-existent 210} -returnCodes error -result {unknown color name "non-existent"} 211test frame-1.19 {frame configuration options} -body { 212 .f configure -borderwidth 1.3 213 lindex [.f configure -borderwidth] 4 214} -cleanup { 215 .f configure -borderwidth [lindex [.f configure -borderwidth] 3] 216} -result 1 217test frame-1.20 {frame configuration options} -body { 218 .f configure -borderwidth badValue 219} -returnCodes error -result {bad screen distance "badValue"} 220test frame-1.21 {frame configuration options} -body { 221 .f configure -cursor arrow 222 lindex [.f configure -cursor] 4 223} -cleanup { 224 .f configure -cursor [lindex [.f configure -cursor] 3] 225} -result {arrow} 226test frame-1.22 {frame configuration options} -body { 227 .f configure -cursor badValue 228} -returnCodes error -result {bad cursor spec "badValue"} 229test frame-1.23 {frame configuration options} -body { 230 .f configure -height 100 231 lindex [.f configure -height] 4 232} -cleanup { 233 .f configure -height [lindex [.f configure -height] 3] 234} -result 100 235test frame-1.24 {frame configuration options} -body { 236 .f configure -height not_a_number 237} -returnCodes error -result {bad screen distance "not_a_number"} 238test frame-1.25 {frame configuration options} -body { 239 .f configure -highlightbackground #112233 240 lindex [.f configure -highlightbackground] 4 241} -cleanup { 242 .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3] 243} -result "#112233" 244test frame-1.26 {frame configuration options} -body { 245 .f configure -highlightbackground ugly 246} -returnCodes error -result {unknown color name "ugly"} 247test frame-1.27 {frame configuration options} -body { 248 .f configure -highlightcolor #123456 249 lindex [.f configure -highlightcolor] 4 250} -cleanup { 251 .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3] 252} -result "#123456" 253test frame-1.28 {frame configuration options} -body { 254 .f configure -highlightcolor non-existent 255} -returnCodes error -result {unknown color name "non-existent"} 256test frame-1.29 {frame configuration options} -body { 257 .f configure -highlightthickness 6 258 lindex [.f configure -highlightthickness] 4 259} -cleanup { 260 .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3] 261} -result 6 262test frame-1.30 {frame configuration options} -body { 263 .f configure -highlightthickness badValue 264} -returnCodes error -result {bad screen distance "badValue"} 265test frame-1.31 {frame configuration options} -body { 266 .f configure -padx 3 267 lindex [.f configure -padx] 4 268} -cleanup { 269 .f configure -padx [lindex [.f configure -padx] 3] 270} -result 3 271test frame-1.32 {frame configuration options} -body { 272 .f configure -padx badValue 273} -returnCodes error -result {bad screen distance "badValue"} 274test frame-1.33 {frame configuration options} -body { 275 .f configure -pady 4 276 lindex [.f configure -pady] 4 277} -cleanup { 278 .f configure -pady [lindex [.f configure -pady] 3] 279} -result 4 280test frame-1.34 {frame configuration options} -body { 281 .f configure -pady badValue 282} -returnCodes error -result {bad screen distance "badValue"} 283test frame-1.35 {frame configuration options} -body { 284 .f configure -relief ridge 285 lindex [.f configure -relief] 4 286} -cleanup { 287 .f configure -relief [lindex [.f configure -relief] 3] 288} -result {ridge} 289test frame-1.36 {frame configuration options} -returnCodes error -body { 290 .f configure -relief badValue 291} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} 292test frame-1.37 {frame configuration options} -body { 293 .f configure -takefocus {any string} 294 lindex [.f configure -takefocus] 4 295} -cleanup { 296 .f configure -takefocus [lindex [.f configure -takefocus] 3] 297} -result {any string} 298test frame-1.38 {frame configuration options} -body { 299 .f configure -width 32 300 lindex [.f configure -width] 4 301} -cleanup { 302 .f configure -width [lindex [.f configure -width] 3] 303} -result 32 304test frame-1.39 {frame configuration options} -body { 305 .f configure -width badValue 306} -returnCodes error -result {bad screen distance "badValue"} 307destroy .f 308 309test frame-2.1 {toplevel configuration options} -setup { 310 deleteWindows 311} -body { 312 toplevel .t -width 200 -height 100 -class NewClass 313 wm geometry .t +0+0 314 .t configure -class 315} -cleanup { 316 deleteWindows 317} -result {-class class Class Toplevel NewClass} 318test frame-2.2 {toplevel configuration options} -setup { 319 deleteWindows 320} -body { 321 toplevel .t -width 200 -height 100 -class NewClass 322 wm geometry .t +0+0 323 .t configure -class Another 324} -returnCodes error -cleanup { 325 deleteWindows 326} -result {can't modify -class option after widget is created} 327test frame-2.3 {toplevel configuration options} -setup { 328 deleteWindows 329} -body { 330 toplevel .t -width 200 -height 100 -colormap new 331 wm geometry .t +0+0 332 .t configure -colormap 333} -cleanup { 334 deleteWindows 335} -result {-colormap colormap Colormap {} new} 336test frame-2.4 {toplevel configuration options} -setup { 337 deleteWindows 338} -body { 339 toplevel .t -width 200 -height 100 -colormap new 340 wm geometry .t +0+0 341 .t configure -colormap . 342} -returnCodes error -cleanup { 343 deleteWindows 344} -result {can't modify -colormap option after widget is created} 345test frame-2.5 {toplevel configuration options} -setup { 346 deleteWindows 347} -body { 348 toplevel .t -width 200 -height 100 349 wm geometry .t +0+0 350 .t configure -container 1 351} -returnCodes error -cleanup { 352 deleteWindows 353} -result {can't modify -container option after widget is created} 354test frame-2.6 {toplevel configuration options} -setup { 355 deleteWindows 356} -body { 357 toplevel .t -width 200 -height 100 358 wm geometry .t +0+0 359 catch {.t configure -container 1} 360 .t configure -container 361} -cleanup { 362 deleteWindows 363} -result {-container container Container 0 0} 364test frame-2.7 {toplevel configuration options} -setup { 365 deleteWindows 366} -body { 367 toplevel .t -width 200 -height 100 -colormap bogus 368} -cleanup { 369 deleteWindows 370} -returnCodes error -result {bad window path name "bogus"} 371test frame-2.8 {toplevel configuration options} -constraints win -setup { 372 deleteWindows 373} -body { 374 toplevel .t -width 200 -height 100 375 wm geometry .t +0+0 376 .t configure -use 0x44022 377} -cleanup { 378 deleteWindows 379} -returnCodes error -result {window "0x44022" doesn't exist} 380test frame-2.9 {toplevel configuration options} -constraints win -setup { 381 deleteWindows 382} -body { 383 toplevel .t -width 200 -height 100 384 wm geometry .t +0+0 385 catch {.t configure -use 0x44022} 386 .t configure -use 387} -cleanup { 388 deleteWindows 389} -result {-use use Use {} {}} 390test frame-2.10 {toplevel configuration options} -constraints nonwin -setup { 391 deleteWindows 392} -body { 393 toplevel .t -width 200 -height 100 394 wm geometry .t +0+0 395 .t configure -use 0x44022 396} -cleanup { 397 deleteWindows 398} -returnCodes error -result {can't modify -use option after widget is created} 399test frame-2.11 {toplevel configuration options} -constraints nonwin -setup { 400 deleteWindows 401} -body { 402 toplevel .t -width 200 -height 100 403 wm geometry .t +0+0 404 catch {.t configure -use 0x44022} 405 .t configure -use 406} -cleanup { 407 deleteWindows 408} -result {-use use Use {} {}} 409test frame-2.12 {toplevel configuration options} -setup { 410 deleteWindows 411} -body { 412 toplevel .t -width 200 -height 100 -visual default 413 wm geometry .t +0+0 414 .t configure -visual 415} -cleanup { 416 deleteWindows 417} -result {-visual visual Visual {} default} 418test frame-2.13 {toplevel configuration options} -setup { 419 deleteWindows 420} -body { 421 toplevel .t -width 200 -height 100 -visual default 422 wm geometry .t +0+0 423 .t configure -visual best 424} -returnCodes error -cleanup { 425 deleteWindows 426} -result {can't modify -visual option after widget is created} 427test frame-2.14 {toplevel configuration options} -setup { 428 deleteWindows 429} -body { 430 toplevel .t -width 200 -height 100 -visual who_knows? 431} -returnCodes error -cleanup { 432 deleteWindows 433} -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default} 434set expectedScreen "" 435if {[tcltest::testConstraint haveDISPLAY]} { 436 set expectedScreen [list -screen screen Screen {} $env(DISPLAY)] 437} 438test frame-2.15 {toplevel configuration options} -constraints {x11 haveDISPLAY} -setup { 439 deleteWindows 440} -body { 441 toplevel .t -width 200 -height 100 -screen $env(DISPLAY) 442 wm geometry .t +0+0 443 .t configure -screen 444} -cleanup { 445 deleteWindows 446} -result $expectedScreen 447test frame-2.16 {toplevel configuration options} -constraints {x11 haveDISPLAY} -setup { 448 deleteWindows 449} -body { 450 toplevel .t -width 200 -height 100 -screen $env(DISPLAY) 451 wm geometry .t +0+0 452 .t configure -screen another 453} -returnCodes error -cleanup { 454 deleteWindows 455} -result {can't modify -screen option after widget is created} 456test frame-2.17 {toplevel configuration options} -setup { 457 deleteWindows 458} -body { 459 toplevel .t -width 200 -height 100 -screen bogus 460} -cleanup { 461 deleteWindows 462} -returnCodes error -result {couldn't connect to display "bogus"} 463test frame-2.18 {toplevel configuration options} -setup { 464 deleteWindows 465} -body { 466 toplevel .t -container 1 -width 300 -height 120 467 wm geometry .t +0+0 468 toplevel .x -container 1 -use [winfo id .t] 469} -returnCodes error -cleanup { 470 deleteWindows 471} -result {windows cannot have both the -use and the -container option set} 472test frame-2.19 {toplevel configuration options} -setup { 473 deleteWindows 474 set opts {} 475} -body { 476 # Make sure all options can be set to the default value 477 toplevel .f 478 foreach opt [.f configure] { 479 if {[llength $opt] == 5} { 480 lappend opts [lindex $opt 0] [lindex $opt 4] 481 } 482 } 483 toplevel .g {*}$opts 484} -cleanup { 485 destroy .f .g 486 deleteWindows 487} -result .g 488 489destroy .t 490toplevel .t -width 300 -height 150 491wm geometry .t +0+0 492update 493test frame-2.20 {toplevel configuration options} -body { 494 .t configure -background #ff0000 495 lindex [.t configure -background] 4 496} -result "#ff0000" 497test frame-2.21 {toplevel configuration options} -body { 498 .t configure -background non-existent 499} -returnCodes error -result {unknown color name "non-existent"} 500test frame-2.22 {toplevel configuration options} -body { 501 .t configure -bd 4 502 lindex [.t configure -bd] 4 503} -result 4 504test frame-2.23 {toplevel configuration options} -body { 505 .t configure -bd badValue 506} -returnCodes error -result {bad screen distance "badValue"} 507test frame-2.24 {toplevel configuration options} -body { 508 .t configure -bg #00ff00 509 lindex [.t configure -bg] 4 510} -result "#00ff00" 511test frame-2.25 {toplevel configuration options} -body { 512 .t configure -bg non-existent 513} -returnCodes error -result {unknown color name "non-existent"} 514test frame-2.26 {toplevel configuration options} -body { 515 .t configure -borderwidth 1.3 516 lindex [.t configure -borderwidth] 4 517} -result 1 518test frame-2.27 {toplevel configuration options} -body { 519 .t configure -borderwidth badValue 520} -returnCodes error -result {bad screen distance "badValue"} 521test frame-2.28 {toplevel configuration options} -body { 522 .t configure -cursor arrow 523 lindex [.t configure -cursor] 4 524} -result {arrow} 525test frame-2.29 {toplevel configuration options} -body { 526 .t configure -cursor badValue 527} -returnCodes error -result {bad cursor spec "badValue"} 528test frame-2.30 {toplevel configuration options} -body { 529 .t configure -height 100 530 lindex [.t configure -height] 4 531} -result 100 532test frame-2.31 {toplevel configuration options} -body { 533 .t configure -height not_a_number 534} -returnCodes error -result {bad screen distance "not_a_number"} 535test frame-2.32 {toplevel configuration options} -body { 536 .t configure -highlightcolor #123456 537 lindex [.t configure -highlightcolor] 4 538} -result "#123456" 539test frame-2.33 {toplevel configuration options} -body { 540 .t configure -highlightcolor non-existent 541} -returnCodes error -result {unknown color name "non-existent"} 542test frame-2.34 {toplevel configuration options} -body { 543 .t configure -highlightthickness 3 544 lindex [.t configure -highlightthickness] 4 545} -result 3 546test frame-2.35 {toplevel configuration options} -body { 547 .t configure -highlightthickness badValue 548} -returnCodes error -result {bad screen distance "badValue"} 549test frame-2.36 {toplevel configuration options} -body { 550 .t configure -padx 3 551 lindex [.t configure -padx] 4 552} -result 3 553test frame-2.37 {toplevel configuration options} -body { 554 .t configure -padx badValue 555} -returnCodes error -result {bad screen distance "badValue"} 556test frame-2.38 {toplevel configuration options} -body { 557 .t configure -pady 4 558 lindex [.t configure -pady] 4 559} -result 4 560test frame-2.39 {toplevel configuration options} -body { 561 .t configure -pady badValue 562} -returnCodes error -result {bad screen distance "badValue"} 563test frame-2.40 {toplevel configuration options} -body { 564 .t configure -relief ridge 565 lindex [.t configure -relief] 4 566} -result {ridge} 567test frame-2.41 {toplevel configuration options} -returnCodes error -body { 568 .t configure -relief badValue 569} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} 570test frame-2.42 {toplevel configuration options} -body { 571 .t configure -width 32 572 lindex [.t configure -width] 4 573} -result 32 574test frame-2.43 {toplevel configuration options} -body { 575 .t configure -width badValue 576} -returnCodes error -result {bad screen distance "badValue"} 577destroy .t 578 579test frame-3.1 {TkCreateFrame procedure} -returnCodes error -body { 580 frame 581} -result {wrong # args: should be "frame pathName ?-option value ...?"} 582test frame-3.2 {TkCreateFrame procedure} -setup { 583 deleteWindows 584 frame .f 585} -body { 586 .f configure -class 587} -cleanup { 588 deleteWindows 589} -result {-class class Class Frame Frame} 590test frame-3.3 {TkCreateFrame procedure} -setup { 591 deleteWindows 592 toplevel .t 593 wm geometry .t +0+0 594} -body { 595 .t configure -class 596} -cleanup { 597 deleteWindows 598} -result {-class class Class Toplevel Toplevel} 599test frame-3.4 {TkCreateFrame procedure} -setup { 600 deleteWindows 601} -body { 602 toplevel .t -width 350 -class NewClass -bg black -visual default -height 90 603 wm geometry .t +0+0 604 update 605 list [lindex [.t configure -width] 4] \ 606 [lindex [.t configure -background] 4] \ 607 [lindex [.t configure -height] 4] 608} -cleanup { 609 deleteWindows 610} -result {350 black 90} 611# Be sure that the -class, -colormap, and -visual options are processed 612# before configuring the widget. 613test frame-3.5 {TkCreateFrame procedure} -setup { 614 deleteWindows 615} -body { 616 option add *NewFrame.background #123456 617 frame .f -class NewFrame 618 lindex [.f configure -background] 4 619} -cleanup { 620 deleteWindows 621 option clear 622} -result {#123456} 623test frame-3.7 {TkCreateFrame procedure} -setup { 624 deleteWindows 625} -body { 626 option add *NewFrame.background #332211 627 option add *f.class NewFrame 628 frame .f 629 list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4] 630} -cleanup { 631 deleteWindows 632 option clear 633} -result {NewFrame #332211} 634test frame-3.8 {TkCreateFrame procedure} -setup { 635 deleteWindows 636} -body { 637 option add *Silly.background #122334 638 option add *f.Class Silly 639 frame .f 640 list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4] 641} -cleanup { 642 deleteWindows 643 option clear 644} -result {Silly #122334} 645test frame-3.9 {TkCreateFrame procedure, -use option} -constraints { 646 unix 647} -setup { 648 deleteWindows 649} -body { 650 toplevel .t -container 1 -width 300 -height 120 651 wm geometry .t +0+0 652 toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green 653 tkwait visibility .x 654 list [expr {[winfo rootx .x] - [winfo rootx .t]}] \ 655 [expr {[winfo rooty .x] - [winfo rooty .t]}] \ 656 [winfo width .t] [winfo height .t] 657} -cleanup { 658 # This call to update idletasks was added to prevent a crash that was 659 # observed on OSX 10.12 (Sierra) only. Any change, such as using the 660 # Development version to make debugging symbols available, adding a print 661 # statement, or calling update idletasks here, would make the test pass 662 # with no segfault. 663 update idletasks 664 deleteWindows 665} -result {0 0 140 300} 666test frame-3.10 {TkCreateFrame procedure, -use option} -constraints { 667 unix 668} -setup { 669 deleteWindows 670} -body { 671 toplevel .t -container 1 -width 300 -height 120 672 wm geometry .t +0+0 673 if {[tk windowingsystem] eq "aqua"} { 674 update idletasks 675 } else { 676 update 677 } 678 option add *x.use [winfo id .t] 679 toplevel .x -width 140 -height 300 -bg green 680 if {[tk windowingsystem] eq "aqua"} { 681 update idletasks 682 } else { 683 tkwait visibility .x 684 update 685 } 686 list [expr {[winfo rootx .x] - [winfo rootx .t]}] \ 687 [expr {[winfo rooty .x] - [winfo rooty .t]}] \ 688 [winfo width .t] [winfo height .t] 689} -cleanup { 690 destroy .t 691 option clear 692} -result {0 0 140 300} 693# The tests below require specific display characteristics (i.e. that they are 694# run on a pseudocolor display of depth 8). Even so, they are non-portable: 695# some machines don't seem to ever run out of colors. 696if {[testConstraint defaultPseudocolor8]} { 697 eatColors .t1 698} 699test frame-3.11 {TkCreateFrame procedure} -constraints { 700 defaultPseudocolor8 nonPortable 701} -setup { 702 destroy .t 703} -body { 704 toplevel .t -width 300 -height 200 -bg #475601 705 wm geometry .t +0+0 706 update 707 colorsFree .t 708} -cleanup { 709 destroy .t 710} -result 0 711test frame-3.12 {TkCreateFrame procedure} -constraints { 712 defaultPseudocolor8 nonPortable 713} -setup { 714 destroy .t 715} -body { 716 toplevel .t -width 300 -height 200 -bg #475601 -colormap new 717 wm geometry .t +0+0 718 update 719 colorsFree .t 720} -cleanup { 721 destroy .t 722} -result 1 723test frame-3.13 {TkCreateFrame procedure} -constraints { 724 defaultPseudocolor8 nonPortable 725} -setup { 726 destroy .t 727} -body { 728 option add *t.class Toplevel2 729 option add *Toplevel2.colormap new 730 toplevel .t -width 300 -height 200 -bg #475601 731 wm geometry .t +0+0 732 update 733 option clear 734 colorsFree .t 735} -cleanup { 736 destroy .t 737} -result 1 738test frame-3.14 {TkCreateFrame procedure} -constraints { 739 defaultPseudocolor8 nonPortable 740} -setup { 741 destroy .t 742} -body { 743 option add *t.class Toplevel3 744 option add *Toplevel3.Colormap new 745 toplevel .t -width 300 -height 200 -bg #475601 -colormap new 746 wm geometry .t +0+0 747 update 748 option clear 749 colorsFree .t 750} -cleanup { 751 destroy .t 752} -result 1 753test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints { 754 defaultPseudocolor8 unix nonPortable 755} -setup { 756 destroy .t 757} -body { 758 toplevel .t -container 1 -width 300 -height 120 759 wm geometry .t +0+0 760 toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new 761 tkwait visibility .x 762 list [colorsFree .t] [colorsFree .x] 763} -cleanup { 764 destroy .t 765} -result {0 1} 766test frame-3.16 {TkCreateFrame procedure} -constraints { 767 defaultPseudocolor8 nonPortable 768} -setup { 769 destroy .t 770} -body { 771 toplevel .t -width 300 -height 200 -bg #475601 -visual default 772 wm geometry .t +0+0 773 update 774 colorsFree .t 775} -cleanup { 776 destroy .t 777} -result 0 778test frame-3.17 {TkCreateFrame procedure} -constraints { 779 defaultPseudocolor8 nonPortable 780} -setup { 781 destroy .t 782} -body { 783 toplevel .t -width 300 -height 200 -bg #475601 -visual default \ 784 -colormap new 785 wm geometry .t +0+0 786 update 787 colorsFree .t 788} -cleanup { 789 destroy .t 790} -result 1 791test frame-3.18 {TkCreateFrame procedure} -constraints { 792 defaultPseudocolor8 haveGrayscale8 nonPortable 793} -setup { 794 destroy .t 795} -body { 796 toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 797 wm geometry .t +0+0 798 update 799 colorsFree .t 131 131 131 800} -cleanup { 801 destroy .t 802} -result 1 803test frame-3.19 {TkCreateFrame procedure} -constraints { 804 defaultPseudocolor8 haveGrayscale8 nonPortable 805} -setup { 806 destroy .t 807} -body { 808 option add *t.class T4 809 option add *T4.visual {grayscale 8} 810 toplevel .t -width 300 -height 200 -bg #434343 811 wm geometry .t +0+0 812 update 813 option clear 814 list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4] 815} -cleanup { 816 destroy .t 817} -result {1 {grayscale 8}} 818test frame-3.20 {TkCreateFrame procedure} -constraints { 819 defaultPseudocolor8 haveGrayscale8 nonPortable 820} -setup { 821 destroy .t 822} -body { 823 option add *t.class T5 824 option add *T5.Visual {grayscale 8} 825 toplevel .t -width 300 -height 200 -bg #434343 826 wm geometry .t +0+0 827 update 828 option clear 829 list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4] 830} -cleanup { 831 destroy .t 832} -result {1 {grayscale 8}} 833test frame-3.21 {TkCreateFrame procedure} -constraints { 834 defaultPseudocolor8 haveGrayscale8 nonPortable 835} -setup { 836 destroy .t 837} -body { 838 toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 839 wm geometry .t +0+0 840 update 841 colorsFree .t 131 131 131 842} -cleanup { 843 destroy .t 844} -result 1 845if {[testConstraint defaultPseudocolor8]} { 846 destroy .t1 847} 848test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup { 849 deleteWindows 850} -body { 851 toplevel .t 852 wm geometry .t +0+0 853 update 854 set result "[winfo reqwidth .t] [winfo reqheight .t]" 855 frame .t.f -bg red 856 pack .t.f 857 update 858 lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f] 859} -cleanup { 860 deleteWindows 861} -result {200 200 1 1} 862test frame-3.23 {TkCreateFrame procedure} -setup { 863 deleteWindows 864} -body { 865 frame .f -gorp glob 866} -returnCodes error -result {unknown option "-gorp"} 867test frame-3.24 {TkCreateFrame procedure} -setup { 868 deleteWindows 869} -body { 870 toplevel .t -width 300 -height 200 -colormap new -bogus option 871 wm geometry .t +0+0 872} -returnCodes error -result {unknown option "-bogus"} 873 874test frame-4.1 {TkCreateFrame procedure} -setup { 875 deleteWindows 876} -body { 877 catch {frame .f -gorp glob} 878 winfo exists .f 879} -result 0 880test frame-4.2 {TkCreateFrame procedure} -setup { 881 deleteWindows 882} -body { 883 list [frame .f -width 200 -height 100] [winfo exists .f] 884} -cleanup { 885 deleteWindows 886} -result {.f 1} 887 888frame .f -highlightcolor black 889test frame-5.1 {FrameWidgetCommand procedure} -body { 890 .f 891} -returnCodes error -result {wrong # args: should be ".f option ?arg ...?"} 892test frame-5.2 {FrameWidgetCommand procedure, cget option} -body { 893 .f cget 894} -returnCodes error -result {wrong # args: should be ".f cget option"} 895test frame-5.3 {FrameWidgetCommand procedure, cget option} -body { 896 .f cget a b 897} -returnCodes error -result {wrong # args: should be ".f cget option"} 898test frame-5.4 {FrameWidgetCommand procedure, cget option} -body { 899 .f cget -gorp 900} -returnCodes error -result {unknown option "-gorp"} 901test frame-5.5 {FrameWidgetCommand procedure, cget option} -body { 902 .f cget -highlightcolor 903} -result {black} 904test frame-5.6 {FrameWidgetCommand procedure, cget option} -body { 905 .f cget -screen 906} -returnCodes error -result {unknown option "-screen"} 907test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup { 908 destroy .t 909} -body { 910 toplevel .t 911 .t cget -screen 912} -cleanup { 913 destroy .t 914} -returnCodes ok -match glob -result * 915test frame-5.8 {FrameWidgetCommand procedure, configure option} -body { 916 optnames [.f configure] 917} -result {-background -backgroundimage -bd -bg -bgimg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -padx -pady -relief -takefocus -tile -visual -width} 918test frame-5.9 {FrameWidgetCommand procedure, configure option} -body { 919 .f configure -gorp 920} -returnCodes error -result {unknown option "-gorp"} 921test frame-5.10 {FrameWidgetCommand procedure, configure option} -body { 922 .f configure -gorp bogus 923} -returnCodes error -result {unknown option "-gorp"} 924test frame-5.11 {FrameWidgetCommand procedure, configure option} -body { 925 .f configure -width 200 -height 926} -returnCodes error -result {value for "-height" missing} 927test frame-5.12 {FrameWidgetCommand procedure} -body { 928 .f swizzle 929} -returnCodes error -result {bad option "swizzle": must be cget or configure} 930test frame-5.13 {FrameWidgetCommand procedure, configure option} -body { 931 optnames [. configure] 932} -result {-background -backgroundimage -bd -bg -bgimg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -menu -padx -pady -relief -screen -takefocus -tile -use -visual -width} 933destroy .f 934 935test frame-6.1 {ConfigureFrame procedure} -setup { 936 deleteWindows 937} -body { 938 frame .f -width 150 939 list [winfo reqwidth .f] [winfo reqheight .f] 940} -cleanup { 941 deleteWindows 942} -result {150 1} 943test frame-6.2 {ConfigureFrame procedure} -setup { 944 deleteWindows 945} -body { 946 frame .f -height 97 947 list [winfo reqwidth .f] [winfo reqheight .f] 948} -cleanup { 949 deleteWindows 950} -result {1 97} 951test frame-6.3 {ConfigureFrame procedure} -setup { 952 deleteWindows 953} -body { 954 frame .f 955 set result {} 956 lappend result [winfo reqwidth .f] [winfo reqheight .f] 957 .f configure -width 100 -height 180 958 lappend result [winfo reqwidth .f] [winfo reqheight .f] 959 .f configure -width 0 -height 0 960 lappend result [winfo reqwidth .f] [winfo reqheight .f] 961} -cleanup { 962 deleteWindows 963} -result {1 1 100 180 100 180} 964 965test frame-7.1 {FrameEventProc procedure} -setup { 966 deleteWindows 967} -body { 968 frame .frame2 969 set result [info commands .frame2] 970 destroy .frame2 971 lappend result [info commands .frame2] 972} -result {.frame2 {}} 973test frame-7.2 {FrameEventProc procedure} -setup { 974 deleteWindows 975 set x {} 976} -body { 977 frame .f1 -bg #543210 978 rename .f1 .f2 979 lappend x [winfo children .] 980 lappend x [.f2 cget -bg] 981 destroy .f1 982 lappend x [info command .f*] [winfo children .] 983} -cleanup { 984 deleteWindows 985} -result {.f1 #543210 {} {}} 986 987test frame-8.1 {FrameCmdDeletedProc procedure} -setup { 988 deleteWindows 989} -body { 990 frame .f1 991 rename .f1 {} 992 list [info command .f*] [winfo children .] 993} -cleanup { 994 deleteWindows 995} -result {{} {}} 996test frame-8.2 {FrameCmdDeletedProc procedure} -setup { 997 deleteWindows 998} -body { 999 toplevel .f1 -menu .m 1000 wm geometry .f1 +0+0 1001 update 1002 rename .f1 {} 1003 update 1004 list [info command .f*] [winfo children .] 1005} -cleanup { 1006 deleteWindows 1007} -result {{} {}} 1008# 1009# This one fails with the dash-patch!!!! Still don't know why :-( 1010# 1011#test frame-8.3 {FrameCmdDeletedProc procedure} -setup { 1012# deleteWindows 1013#} -body { 1014# toplevel .f1 -menu .m 1015# wm geometry .f1 +0+0 1016# menu .m 1017# update 1018# rename .f1 {} 1019# update 1020# list [info command .f*] [winfo children .] 1021#} -cleanup { 1022# deleteWindows 1023#} -result {{} .m} 1024 1025test frame-9.1 {MapFrame procedure} -setup { 1026 deleteWindows 1027} -body { 1028 toplevel .t -width 100 -height 400 1029 wm geometry .t +0+0 1030 set result [winfo ismapped .t] 1031 update idletasks 1032 lappend result [winfo ismapped .t] 1033} -cleanup { 1034 deleteWindows 1035} -result {0 1} 1036test frame-9.2 {MapFrame procedure} -setup { 1037 deleteWindows 1038} -body { 1039 toplevel .t -width 100 -height 400 1040 wm geometry .t +0+0 1041 destroy .t 1042 update 1043 winfo exists .t 1044} -result 0 1045test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup { 1046 deleteWindows 1047} -body { 1048 toplevel .t2 -width 200 -height 200 1049 wm geometry .t2 +0+0 1050 tkwait visibility .t2 1051 toplevel .t -width 100 -height 400 1052 wm geometry .t +0+0 1053 frame .t2.f -width 50 -height 50 1054 bind .t2.f <Configure> {destroy .t} 1055 pack .t2.f -side top 1056 update idletasks 1057 winfo exists .t 1058} -cleanup { 1059 deleteWindows 1060} -result 0 1061 1062test frame-10.1 {frame widget vs hidden commands} -setup { 1063 deleteWindows 1064} -body { 1065 frame .t 1066 interp hide {} .t 1067 destroy .t 1068 list [winfo children .] [lsort [interp hidden]] 1069} -result [list {} [lsort [interp hidden]]] 1070 1071test frame-11.1 {TkInstallFrameMenu} -setup { 1072 deleteWindows 1073} -body { 1074 menu .m1 1075 .m1 add cascade -menu .m1.system 1076 menu .m1.system -tearoff 0 1077 .m1.system add command -label foo 1078 toplevel .t -menu .m1 1079} -cleanup { 1080 deleteWindows 1081} -result {.t} 1082test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup { 1083 deleteWindows 1084 catch {rename foo {}} 1085} -body { 1086 menu .m1 1087 .m1 add cascade -menu .m1.system 1088 menu .m1.system -tearoff 0 1089 .m1.system add command -label foo 1090 toplevel .t 1091 rename .t foo 1092} -cleanup { 1093 deleteWindows 1094} -result {} 1095 1096test frame-12.1 {FrameWorldChanged procedure} -setup { 1097 deleteWindows 1098} -body { 1099 # Test -bd -padx and -pady 1100 frame .f -borderwidth 2 -padx 3 -pady 4 1101 place .f -x 0 -y 0 -width 40 -height 40 1102 pack [frame .f.f] -fill both -expand 1 1103 update 1104 list [winfo x .f.f] [winfo y .f.f] [winfo width .f.f] [winfo height .f.f] 1105} -cleanup { 1106 deleteWindows 1107} -result {5 6 30 28} 1108test frame-12.2 {FrameWorldChanged procedure} -setup { 1109 deleteWindows 1110} -body { 1111 # Test all -labelanchor positions 1112 set font {helvetica 12} 1113 labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \ 1114 -text "Mupp" 1115 set fh [expr {max([font metrics $font -linespace] + 2 - 3, 0)}] 1116 set fw [expr {max([font measure $font "Mupp"] + 2 - 3, 0)}] 1117 place .f -x 0 -y 0 -width 100 -height 100 1118 pack [frame .f.f] -fill both -expand 1 1119 set result {} 1120 foreach lp {nw n ne en e es se s sw ws w wn} { 1121 .f configure -labelanchor $lp 1122 update 1123 set expx 5 1124 set expy 6 1125 set expw 90 1126 set exph 88 1127 switch -glob $lp { 1128 n* {incr expy $fh ; incr exph -$fh} 1129 s* {incr exph -$fh} 1130 w* {incr expx $fw ; incr expw -$fw} 1131 e* {incr expw -$fw} 1132 } 1133 lappend result [expr { 1134 [winfo x .f.f] == $expx && [winfo y .f.f] == $expy && 1135 [winfo width .f.f] == $expw && [winfo height .f.f] == $exph 1136 }] 1137 } 1138 return $result 1139} -cleanup { 1140 deleteWindows 1141} -result {1 1 1 1 1 1 1 1 1 1 1 1} 1142test frame-12.3 {FrameWorldChanged procedure} -setup { 1143 deleteWindows 1144 update idletasks 1145} -body { 1146 # Check reaction on font change 1147 font create myfont -family courier -size 10 1148 labelframe .f -font myfont -text Mupp 1149 place .f -x 0 -y 0 -width 40 -height 40 1150 pack [frame .f.f] -fill both -expand 1 1151 if {[tk windowingsystem] eq "aqua"} { 1152 update idletasks 1153 } else { 1154 update 1155 } 1156 set h1 [font metrics myfont -linespace] 1157 set y1 [winfo y .f.f] 1158 font configure myfont -size 20 1159 if {[tk windowingsystem] eq "aqua"} { 1160 update idletasks 1161 } else { 1162 update 1163 } 1164 set h2 [font metrics myfont -linespace] 1165 set y2 [winfo y .f.f] 1166 expr {($h2 - $h1) - ($y2 - $y1)} 1167} -cleanup { 1168 deleteWindows 1169 font delete myfont 1170} -result 0 1171 1172test frame-13.1 {labelframe configuration options} -setup { 1173 deleteWindows 1174} -body { 1175 labelframe .f -class NewFrame 1176 .f configure -class 1177} -cleanup { 1178 deleteWindows 1179} -result {-class class Class Labelframe NewFrame} 1180test frame-13.2 {labelframe configuration options} -setup { 1181 deleteWindows 1182} -body { 1183 labelframe .f -class NewFrame 1184 .f configure -class Different 1185} -returnCodes error -cleanup { 1186 deleteWindows 1187} -result {can't modify -class option after widget is created} 1188test frame-13.3 {labelframe configuration options} -setup { 1189 deleteWindows 1190} -body { 1191 labelframe .f -colormap new 1192} -cleanup { 1193 deleteWindows 1194} -result {.f} 1195test frame-13.4 {labelframe configuration options} -setup { 1196 deleteWindows 1197} -body { 1198 labelframe .f -visual default 1199} -cleanup { 1200 deleteWindows 1201} -result {.f} 1202test frame-13.5 {labelframe configuration options} -setup { 1203 deleteWindows 1204} -body { 1205 labelframe .f -screen bogus 1206} -cleanup { 1207 deleteWindows 1208} -returnCodes error -result {unknown option "-screen"} 1209test frame-13.6 {labelframe configuration options} -setup { 1210 deleteWindows 1211} -body { 1212 labelframe .f -container true 1213} -cleanup { 1214 deleteWindows 1215} -result {.f} 1216test frame-13.7 {labelframe configuration options} -setup { 1217 deleteWindows 1218} -body { 1219 labelframe .f -container true 1220 .f configure -container 1221} -cleanup { 1222 deleteWindows 1223} -result {-container container Container 0 1} 1224test frame-13.8 {labelframe configuration options} -setup { 1225 deleteWindows 1226} -body { 1227 labelframe .f -container bogus 1228} -cleanup { 1229 deleteWindows 1230} -returnCodes error -result {expected boolean value but got "bogus"} 1231test frame-13.9 {labelframe configuration options} -setup { 1232 deleteWindows 1233} -body { 1234 labelframe .f 1235 .f configure -container 1 1236} -returnCodes error -cleanup { 1237 deleteWindows 1238} -result {can't modify -container option after widget is created} 1239destroy .f 1240labelframe .f 1241test frame-13.10 {labelframe configuration options} -body { 1242 .f configure -background #ff0000 1243 lindex [.f configure -background] 4 1244} -cleanup { 1245 .f configure -background [lindex [.f configure -background] 3] 1246} -result "#ff0000" 1247test frame-13.11 {labelframe configuration options} -body { 1248 .f configure -background non-existent 1249} -returnCodes error -result {unknown color name "non-existent"} 1250test frame-13.12 {labelframe configuration options} -body { 1251 .f configure -bd 4 1252 lindex [.f configure -bd] 4 1253} -cleanup { 1254 .f configure -bd [lindex [.f configure -bd] 3] 1255} -result 4 1256test frame-13.13 {labelframe configuration options} -body { 1257 .f configure -bd badValue 1258} -returnCodes error -result {bad screen distance "badValue"} 1259test frame-13.14 {labelframe configuration options} -body { 1260 .f configure -bg #00ff00 1261 lindex [.f configure -bg] 4 1262} -cleanup { 1263 .f configure -bg [lindex [.f configure -bg] 3] 1264} -result "#00ff00" 1265test frame-13.15 {labelframe configuration options} -body { 1266 .f configure -bg non-existent 1267} -returnCodes error -result {unknown color name "non-existent"} 1268test frame-13.16 {labelframe configuration options} -body { 1269 .f configure -borderwidth 1.3 1270 lindex [.f configure -borderwidth] 4 1271} -cleanup { 1272 .f configure -borderwidth [lindex [.f configure -borderwidth] 3] 1273} -result 1 1274test frame-13.17 {labelframe configuration options} -body { 1275 .f configure -borderwidth badValue 1276} -returnCodes error -result {bad screen distance "badValue"} 1277test frame-13.18 {labelframe configuration options} -body { 1278 .f configure -cursor arrow 1279 lindex [.f configure -cursor] 4 1280} -cleanup { 1281 .f configure -cursor [lindex [.f configure -cursor] 3] 1282} -result {arrow} 1283test frame-13.19 {labelframe configuration options} -body { 1284 .f configure -cursor badValue 1285} -returnCodes error -result {bad cursor spec "badValue"} 1286test frame-13.20 {labelframe configuration options} -body { 1287 .f configure -fg #0000ff 1288 lindex [.f configure -fg] 4 1289} -cleanup { 1290 .f configure -fg [lindex [.f configure -fg] 3] 1291} -result "#0000ff" 1292test frame-13.21 {labelframe configuration options} -body { 1293 .f configure -fg non-existent 1294} -returnCodes error -result {unknown color name "non-existent"} 1295test frame-13.22 {labelframe configuration options} -body { 1296 .f configure -font {courier 8} 1297 lindex [.f configure -font] 4 1298} -cleanup { 1299 .f configure -font [lindex [.f configure -font] 3] 1300} -result {courier 8} 1301test frame-13.23 {labelframe configuration options} -body { 1302 .f configure -foreground #ff0000 1303 lindex [.f configure -foreground] 4 1304} -cleanup { 1305 .f configure -foreground [lindex [.f configure -foreground] 3] 1306} -result "#ff0000" 1307test frame-13.24 {labelframe configuration options} -body { 1308 .f configure -foreground non-existent 1309} -returnCodes error -result {unknown color name "non-existent"} 1310test frame-13.25 {labelframe configuration options} -body { 1311 .f configure -height 100 1312 lindex [.f configure -height] 4 1313} -cleanup { 1314 .f configure -height [lindex [.f configure -height] 3] 1315} -result 100 1316test frame-13.26 {labelframe configuration options} -body { 1317 .f configure -height not_a_number 1318} -returnCodes error -result {bad screen distance "not_a_number"} 1319test frame-13.27 {labelframe configuration options} -body { 1320 .f configure -highlightbackground #112233 1321 lindex [.f configure -highlightbackground] 4 1322} -cleanup { 1323 .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3] 1324} -result "#112233" 1325test frame-13.28 {labelframe configuration options} -body { 1326 .f configure -highlightbackground ugly 1327} -returnCodes error -result {unknown color name "ugly"} 1328test frame-13.29 {labelframe configuration options} -body { 1329 .f configure -highlightcolor #123456 1330 lindex [.f configure -highlightcolor] 4 1331} -cleanup { 1332 .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3] 1333} -result "#123456" 1334test frame-13.30 {labelframe configuration options} -body { 1335 .f configure -highlightcolor non-existent 1336} -returnCodes error -result {unknown color name "non-existent"} 1337test frame-13.31 {labelframe configuration options} -body { 1338 .f configure -highlightthickness 6 1339 lindex [.f configure -highlightthickness] 4 1340} -cleanup { 1341 .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3] 1342} -result 6 1343test frame-13.32 {labelframe configuration options} -body { 1344 .f configure -highlightthickness badValue 1345} -returnCodes error -result {bad screen distance "badValue"} 1346test frame-13.33 {labelframe configuration options} -body { 1347 .f configure -labelanchor se 1348 lindex [.f configure -labelanchor] 4 1349} -cleanup { 1350 .f configure -labelanchor [lindex [.f configure -labelanchor] 3] 1351} -result {se} 1352test frame-13.34 {labelframe configuration options} -returnCodes error -body { 1353 .f configure -labelanchor badValue 1354} -result {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws} 1355test frame-13.35 {labelframe configuration options} -body { 1356 .f configure -padx 3 1357 lindex [.f configure -padx] 4 1358} -cleanup { 1359 .f configure -padx [lindex [.f configure -padx] 3] 1360} -result 3 1361test frame-13.36 {labelframe configuration options} -body { 1362 .f configure -padx badValue 1363} -returnCodes error -result {bad screen distance "badValue"} 1364test frame-13.37 {labelframe configuration options} -body { 1365 .f configure -pady 4 1366 lindex [.f configure -pady] 4 1367} -cleanup { 1368 .f configure -pady [lindex [.f configure -pady] 3] 1369} -result 4 1370test frame-13.38 {labelframe configuration options} -body { 1371 .f configure -pady badValue 1372} -returnCodes error -result {bad screen distance "badValue"} 1373test frame-13.39 {labelframe configuration options} -body { 1374 .f configure -relief ridge 1375 lindex [.f configure -relief] 4 1376} -cleanup { 1377 .f configure -relief [lindex [.f configure -relief] 3] 1378} -result {ridge} 1379test frame-13.40 {labelframe configuration options} -returnCodes error -body { 1380 .f configure -relief badValue 1381} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} 1382test frame-13.41 {labelframe configuration options} -body { 1383 .f configure -takefocus {any string} 1384 lindex [.f configure -takefocus] 4 1385} -cleanup { 1386 .f configure -takefocus [lindex [.f configure -takefocus] 3] 1387} -result {any string} 1388test frame-13.42 {labelframe configuration options} -body { 1389 .f configure -text {any string} 1390 lindex [.f configure -text] 4 1391} -cleanup { 1392 .f configure -text [lindex [.f configure -text] 3] 1393} -result {any string} 1394test frame-13.43 {labelframe configuration options} -body { 1395 .f configure -width 32 1396 lindex [.f configure -width] 4 1397} -cleanup { 1398 .f configure -width [lindex [.f configure -width] 3] 1399} -result 32 1400test frame-13.44 {labelframe configuration options} -body { 1401 .f configure -width badValue 1402} -returnCodes error -result {bad screen distance "badValue"} 1403destroy .f 1404 1405test frame-14.1 {labelframe labelwidget option} -setup { 1406 deleteWindows 1407} -body { 1408 # Test that label is moved in stacking order 1409 label .l -text Mupp -font {helvetica 8} 1410 labelframe .f -labelwidget .l 1411 pack .f 1412 frame .f.f -width 50 -height 50 1413 pack .f.f 1414 update 1415 list [winfo children .] [winfo width .f] \ 1416 [expr {[winfo height .f] - [winfo height .l]}] 1417} -cleanup { 1418 deleteWindows 1419} -result {{.f .l} 54 52} 1420test frame-14.2 {labelframe labelwidget option} -setup { 1421 deleteWindows 1422} -body { 1423 # Test the labelframe's reaction if the label is destroyed 1424 label .l -text Aratherlonglabel 1425 labelframe .f -labelwidget .l 1426 pack .f 1427 label .f.l -text Mupp 1428 pack .f.l 1429 update 1430 set res [list [.f cget -labelwidget]] 1431 lappend res [expr {[winfo width .f] - [winfo width .l]}] 1432 destroy .l 1433 lappend res [.f cget -labelwidget] 1434 update 1435 lappend res [expr {[winfo width .f] - [winfo width .f.l]}] 1436} -cleanup { 1437 deleteWindows 1438} -result {.l 12 {} 4} 1439test frame-14.3 {labelframe labelwidget option} -setup { 1440 deleteWindows 1441} -body { 1442 # Test the labelframe's reaction if the label is stolen 1443 label .l -text Aratherlonglabel 1444 labelframe .f -labelwidget .l 1445 pack .f 1446 label .f.l -text Mupp 1447 pack .f.l 1448 update 1449 set res [list [.f cget -labelwidget]] 1450 lappend res [expr {[winfo width .f] - [winfo width .l]}] 1451 pack .l 1452 lappend res [.f cget -labelwidget] 1453 update 1454 lappend res [expr {[winfo width .f] - [winfo width .f.l]}] 1455} -cleanup { 1456 deleteWindows 1457} -result {.l 12 {} 4} 1458test frame-14.4 {labelframe labelwidget option} -setup { 1459 deleteWindows 1460} -body { 1461 # Test the label's reaction if the labelframe is destroyed 1462 label .l -text Mupp 1463 labelframe .f -labelwidget .l 1464 pack .f 1465 update 1466 set res [list [winfo manager .l]] 1467 destroy .f 1468 lappend res [winfo manager .l] 1469} -cleanup { 1470 deleteWindows 1471} -result {labelframe {}} 1472test frame-14.5 {labelframe labelwidget option} -setup { 1473 deleteWindows 1474} -body { 1475 # Test that the labelframe reacts on changes in label 1476 label .l -text Aratherlonglabel 1477 labelframe .f -labelwidget .l 1478 pack .f 1479 label .f.l -text Mupp 1480 pack .f.l 1481 update 1482 set first [winfo width .f] 1483 set res [expr {[winfo width .f] - [winfo width .l]}] 1484 .l configure -text Shorter 1485 update 1486 lappend res [expr {[winfo width .f] - [winfo width .l]}] 1487 lappend res [expr {[winfo width .f] < $first}] 1488 .l configure -text Alotlongerthananytimebefore 1489 update 1490 lappend res [expr {[winfo width .f] - [winfo width .l]}] 1491 lappend res [expr {[winfo width .f] > $first}] 1492} -cleanup { 1493 deleteWindows 1494} -result {12 12 1 12 1} 1495test frame-14.6 {labelframe labelwidget option} -setup { 1496 deleteWindows 1497} -body { 1498 # Destroying a labelframe with a child label caused a crash when not 1499 # handling mapping of the label correctly. 1500 # This test does not test anything directly, it's just ment to catch if 1501 # the same mistake is made again. 1502 labelframe .f 1503 pack .f 1504 label .f.l -text Mupp 1505 .f configure -labelwidget .f.l 1506 update 1507} -cleanup { 1508 deleteWindows 1509} -result {} 1510 1511test frame-15.1 {TIP 262: frame background images} -setup { 1512 deleteWindows 1513 image create photo gorp -width 10 -height 10 1514 gorp put black -to 2 2 7 7 1515} -body { 1516 frame .f -width 100 -height 100 1517 pack .f 1518 list [image inuse gorp] [.f configure -backgroundimage gorp;update] \ 1519 [image inuse gorp] [winfo width .f] [winfo height .f] 1520} -cleanup { 1521 image delete gorp 1522 deleteWindows 1523} -result {0 {} 1 100 100} 1524test frame-15.2 {TIP 262: frame background images} -setup { 1525 deleteWindows 1526 catch {rename gorp ""} 1527} -body { 1528 frame .f -width 100 -height 100 1529 pack .f 1530 update 1531 .f configure -backgroundimage gorp 1532} -returnCodes error -cleanup { 1533 deleteWindows 1534} -result {image "gorp" doesn't exist} 1535test frame-15.3 {TIP 262: frame background images} -setup { 1536 deleteWindows 1537 image create photo gorp -width 10 -height 10 1538 gorp put black -to 2 2 7 7 1539} -body { 1540 frame .f -width 100 -height 100 -backgroundimage gorp 1541 pack .f 1542 .f configure -tile yes 1543 update 1544 list [.f cget -bgimg] [.f cget -tile] 1545} -cleanup { 1546 image delete gorp 1547 deleteWindows 1548} -result {gorp 1} 1549test frame-15.4 {TIP 262: frame background images} -setup { 1550 deleteWindows 1551 image create photo gorp -width 10 -height 10 1552 gorp put black -to 2 2 7 7 1553} -body { 1554 frame .f -width 100 -height 100 -backgroundimage gorp 1555 pack .f 1556 .f configure -tile yes 1557 update 1558 gorp put red -to 15 15 20 20 1559 update 1560 list [.f cget -bgimg] [.f cget -tile] 1561} -cleanup { 1562 image delete gorp 1563 deleteWindows 1564} -result {gorp 1} 1565test frame-15.5 {TIP 262: frame background images} -setup { 1566 deleteWindows 1567 image create photo gorp -width 10 -height 10 1568 gorp put black -to 2 2 7 7 1569 set result {} 1570} -body { 1571 frame .f -width 100 -height 100 -backgroundimage gorp 1572 pack .f 1573 .f configure -tile yes 1574 update 1575 image delete gorp 1576 update 1577 set result [list [.f cget -bgimg] [.f cget -tile]] 1578 image create photo gorp -width 250 -height 250 1579 update 1580 lappend result [.f cget -backgroundimage] 1581} -cleanup { 1582 catch {image delete gorp} 1583 deleteWindows 1584} -result {gorp 1 gorp} 1585test frame-15.6 {TIP 262: frame background images} -setup { 1586 deleteWindows 1587 set result {} 1588 . configure -width 200 -height 200 1589} -constraints testImageType -body { 1590 image create test gorp -variable result 1591 pack [frame .f -width 100 -height 100 -bgimg gorp] 1592 update idletasks; update 1593 return [uniq $result] 1594} -cleanup { 1595 deleteWindows 1596 catch {image delete gorp} 1597} -result {{gorp get} {gorp display 0 0 30 15}} 1598test frame-15.6a {TIP 262: frame background images (offsets)} -setup { 1599 deleteWindows 1600 set result {} 1601 . configure -width 200 -height 200 1602} -constraints testImageType -body { 1603 image create test gorp -variable result 1604 pack [frame .f -width 10 -height 10 -bgimg gorp] 1605 update idletasks; update 1606 # On MacOS must wait for the test image display procedure to run. 1607 set timer [after 300 {lappend result "timedout"}] 1608 while {"timedout" ni $result && 1609 "gorp display 10 2 10 10" ni $result} { 1610 vwait result 1611 } 1612 after cancel $timer 1613 update idletasks; update 1614 return [uniq $result] 1615} -cleanup { 1616 deleteWindows 1617 catch {image delete gorp} 1618} -result {{gorp get} {gorp display 10 2 10 10}} 1619test frame-15.7 {TIP 262: frame background images} -setup { 1620 deleteWindows 1621 set result {} 1622 . configure -width 200 -height 200 1623} -constraints testImageType -body { 1624 image create test gorp -variable result 1625 pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1] 1626 update idletasks; update 1627 # On MacOS must wait for the test image display procedure to run. 1628 set timer [after 300 {lappend result "timedout"}] 1629 while {"timedout" ni $result && 1630 "gorp display 0 0 20 10" ni $result} { 1631 vwait result 1632 } 1633 after cancel $timer 1634 if {[lindex $result end] eq "timedout"} { 1635 return [lreplace $result end end] 1636 } 1637 return [uniq $result] 1638} -cleanup { 1639 deleteWindows 1640 catch {image delete gorp} 1641} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}} 1642test frame-15.7a {TIP 262: frame background images (offsets)} -setup { 1643 deleteWindows 1644 set result {} 1645 . configure -width 200 -height 200 1646} -constraints testImageType -body { 1647 image create test gorp -variable result 1648 pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -highlightthick 1] 1649 update idletasks; update 1650 # On MacOS must wait for the test image display procedure to run. 1651 set timer [after 300 {lappend result "timedout"}] 1652 while {"timedout" ni $result && 1653 "gorp display 0 0 18 8" ni $result} { 1654 vwait result 1655 } 1656 after cancel $timer 1657 return [uniq $result] 1658} -cleanup { 1659 deleteWindows 1660 catch {image delete gorp} 1661} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 8} {gorp display 0 0 18 15} {gorp display 0 0 18 8}} 1662test frame-15.7b {TIP 262: frame background images (offsets)} -setup { 1663 deleteWindows 1664 set result {} 1665 . configure -width 200 -height 200 1666} -constraints testImageType -body { 1667 image create test gorp -variable result 1668 pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2] 1669 update idletasks; update 1670 return [uniq $result] 1671} -cleanup { 1672 deleteWindows 1673 catch {image delete gorp} 1674} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 6} {gorp display 0 0 16 15} {gorp display 0 0 16 6}} 1675test frame-15.7c {TIP 262: frame background images (offsets)} -setup { 1676 deleteWindows 1677 set result {} 1678 . configure -width 200 -height 200 1679} -constraints testImageType -body { 1680 image create test gorp -variable result 1681 pack [frame .f -width 50 -height 25 -bgimg gorp -tile 1 -bd 2 -highlightthick 1] 1682 update idletasks; update 1683 return [uniq $result] 1684} -cleanup { 1685 deleteWindows 1686 catch {image delete gorp} 1687} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 4} {gorp display 0 0 14 15} {gorp display 0 0 14 4}} 1688test frame-15.8 {TIP 262: toplevel background images} -setup { 1689 deleteWindows 1690 image create photo gorp -width 10 -height 10 1691 gorp put black -to 2 2 7 7 1692} -body { 1693 toplevel .t -width 100 -height 100 1694 update 1695 # Used to verify that setting a background image doesn't change the widget size 1696 set w [winfo width .t] 1697 set h [winfo height .t] 1698 list [image inuse gorp] [.t configure -backgroundimage gorp;update] \ 1699 [image inuse gorp] \ 1700 [expr {$w-[winfo width .t]}] [expr {$h-[winfo height .t]}] 1701} -cleanup { 1702 image delete gorp 1703 deleteWindows 1704} -result {0 {} 1 0 0} 1705test frame-15.9 {TIP 262: toplevel background images} -setup { 1706 deleteWindows 1707 catch {rename gorp ""} 1708} -body { 1709 toplevel .t -width 100 -height 100 1710 update 1711 .t configure -backgroundimage gorp 1712} -returnCodes error -cleanup { 1713 deleteWindows 1714} -result {image "gorp" doesn't exist} 1715test frame-15.10 {TIP 262: toplevel background images} -setup { 1716 deleteWindows 1717 image create photo gorp -width 10 -height 10 1718 gorp put black -to 2 2 7 7 1719} -body { 1720 toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes 1721 update 1722 list [.t cget -bgimg] [.t cget -tile] 1723} -cleanup { 1724 image delete gorp 1725 deleteWindows 1726} -result {gorp 1} 1727test frame-15.11 {TIP 262: toplevel background images} -setup { 1728 deleteWindows 1729 image create photo gorp -width 10 -height 10 1730 gorp put black -to 2 2 7 7 1731} -body { 1732 toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes 1733 update 1734 gorp put red -to 15 15 20 20 1735 update 1736 list [.t cget -bgimg] [.t cget -tile] 1737} -cleanup { 1738 image delete gorp 1739 deleteWindows 1740} -result {gorp 1} 1741test frame-15.12 {TIP 262: toplevel background images} -setup { 1742 deleteWindows 1743 image create photo gorp -width 10 -height 10 1744 gorp put black -to 2 2 7 7 1745 set result {} 1746} -body { 1747 toplevel .t -width 100 -height 100 -backgroundimage gorp -tile yes 1748 update 1749 image delete gorp 1750 update 1751 set result [list [.t cget -bgimg] [.t cget -tile]] 1752 image create photo gorp -width 250 -height 250 1753 update 1754 lappend result [.t cget -backgroundimage] 1755} -cleanup { 1756 catch {image delete gorp} 1757 deleteWindows 1758} -result {gorp 1 gorp} 1759test frame-15.13 {TIP 262: toplevel background images} -setup { 1760 deleteWindows 1761 set result {} 1762} -constraints testImageType -body { 1763 image create test gorp -variable result 1764 toplevel .t -width 100 -height 100 -bgimg gorp 1765 wm overrideredirect .t 1; # Reduce trouble from window managers 1766 update idletasks; update 1767 return [uniq $result] 1768} -cleanup { 1769 deleteWindows 1770 catch {image delete gorp} 1771} -result {{gorp get} {gorp display 0 0 30 15}} 1772test frame-15.14 {TIP 262: toplevel background images} -setup { 1773 deleteWindows 1774 set result {} 1775} -constraints testImageType -body { 1776 image create test gorp -variable result 1777 toplevel .t -width 50 -height 25 -bgimg gorp -tile 1 1778 wm overrideredirect .t 1; # Reduce trouble from window managers 1779 update idletasks; update 1780 # On MacOS must wait for the test image display procedure to run. 1781 set timer [after 300 {lappend result "timedout"}] 1782 while {"timedout" ni $result && 1783 "gorp display 0 0 20 10" ni $result} { 1784 vwait result 1785 } 1786 after cancel $timer 1787 return [uniq $result] 1788} -cleanup { 1789 deleteWindows 1790 catch {image delete gorp} 1791} -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}} 1792 1793# cleanup 1794deleteWindows 1795apply {cmds {foreach cmd $cmds {rename $cmd {}}}} { 1796 eatColors colorsFree uniq optnames 1797} 1798 1799cleanupTests 1800return 1801 1802# Local Variables: 1803# mode: tcl 1804# End: 1805