1# 2# $Id$ 3# 4 5package require Tk 8.5 6package require tcltest ; namespace import -force tcltest::* 7loadTestedCommands 8 9test notebook-1.0 "Setup" -body { 10 ttk::notebook .nb 11} -result .nb 12 13# 14# Error handling tests: 15# 16test notebook-1.1 "Cannot add ancestor" -body { 17 .nb add . 18} -returnCodes error -result "*" -match glob 19 20proc inoperative {args} {} 21 22inoperative test notebook-1.2 "Cannot add siblings" -body { 23 # This is legal now 24 .nb add [frame .sibling] 25} -returnCodes error -result "*" -match glob 26 27test notebook-1.3 "Cannot add toplevel" -body { 28 .nb add [toplevel .nb.t] 29} -cleanup { 30 destroy .t.nb 31} -returnCodes 1 -match glob -result "can't add .nb.t*" 32 33test notebook-1.4 "Try to select bad tab" -body { 34 .nb select @6000,6000 35} -returnCodes 1 -match glob -result "* not found" 36 37# 38# Now add stuff: 39# 40test notebook-2.0 "Add children" -body { 41 pack .nb -expand true -fill both 42 .nb add [frame .nb.foo] -text "Foo" 43 pack [label .nb.foo.l -text "Foo"] 44 45 .nb add [frame .nb.bar -relief raised -borderwidth 2] -text "Bar" 46 pack [label .nb.bar.l -text "Bar"] 47 48 .nb tabs 49} -result [list .nb.foo .nb.bar] 50 51test notebook-2.1 "select pane" -body { 52 .nb select .nb.foo 53 update 54 list [winfo viewable .nb.foo] [winfo viewable .nb.bar] [.nb index current] 55} -result [list 1 0 0] 56 57test notebook-2.2 "select another pane" -body { 58 .nb select 1 59 update 60 list [winfo viewable .nb.foo] [winfo viewable .nb.bar] [.nb index current] 61} -result [list 0 1 1] 62 63test notebook-2.3 "tab - get value" -body { 64 .nb tab .nb.foo -text 65} -result "Foo" 66 67test notebook-2.4 "tab - set value" -body { 68 .nb tab .nb.foo -text "Changed Foo" 69 .nb tab .nb.foo -text 70} -result "Changed Foo" 71 72test notebook-2.5 "tab - get all options" -body { 73 .nb tab .nb.foo 74} -result [list \ 75 -padding 0 -sticky nsew \ 76 -state normal -text "Changed Foo" -image "" -compound none -underline -1] 77 78test notebook-4.1 "Test .nb index end" -body { 79 .nb index end 80} -result 2 81 82test notebook-4.2 "'end' is not a selectable index" -body { 83 .nb select end 84} -returnCodes error -result "*" -match glob 85 86test notebook-4.3 "Select index out of range" -body { 87 .nb select 2 88} -returnCodes error -result "*" -match glob 89 90test notebook-4.4 "-padding option" -body { 91 .nb configure -padding "5 5 5 5" 92} 93 94test notebook-4.end "Cleanup test suite 1-4.*" -body { destroy .nb } 95 96test notebook-5.1 "Virtual events" -body { 97 toplevel .t 98 set ::events [list] 99 bind .t <<NotebookTabChanged>> { lappend events changed %W } 100 101 pack [set nb [ttk::notebook .t.nb]] -expand true -fill both; update 102 $nb add [frame $nb.f1] 103 $nb add [frame $nb.f2] 104 $nb add [frame $nb.f3] 105 106 $nb select $nb.f1 107 update; set events 108} -result [list changed .t.nb] 109 110test notebook-5.2 "Virtual events, continued" -body { 111 set events [list] 112 $nb select $nb.f3 113 update ; set events 114} -result [list changed .t.nb] 115# OR: [list deselected .t.nb.f1 selected .t.nb.f3 changed .t.nb] 116 117test notebook-5.3 "Disabled tabs" -body { 118 set events [list] 119 $nb tab $nb.f2 -state disabled 120 $nb select $nb.f2 121 update 122 list $events [$nb index current] 123} -result [list [list] 2] 124 125test notebook-5.4 "Reenable tab" -body { 126 set events [list] 127 $nb tab $nb.f2 -state normal 128 $nb select $nb.f2 129 update 130 list $events [$nb index current] 131} -result [list [list changed .t.nb] 1] 132 133test notebook-5.end "Virtual events, cleanup" -body { destroy .t } 134 135test notebook-6.0 "Select hidden tab" -setup { 136 set nb [ttk::notebook .nb] 137 $nb add [ttk::frame $nb.f1] 138 $nb add [ttk::frame $nb.f2] 139 $nb select $nb.f2 140} -cleanup { 141 destroy $nb 142} -body { 143 set result [list] 144 $nb tab $nb.f1 -state hidden 145 lappend result [$nb tab $nb.f1 -state] 146 $nb select $nb.f1 147 lappend result [$nb tab $nb.f1 -state] 148} -result [list hidden normal] 149 150test notebook-6.1 "Hide selected tab" -setup { 151 pack [set nb [ttk::notebook .nb]] ; update 152 $nb add [ttk::frame $nb.f1] 153 $nb add [ttk::frame $nb.f2] 154 $nb add [ttk::frame $nb.f3] 155 $nb select $nb.f2 156} -cleanup { 157 destroy $nb 158} -body { 159 set result [list] 160 lappend result [$nb index current] [winfo ismapped $nb.f2] 161 $nb hide $nb.f2 162 lappend result [$nb index current] [winfo ismapped $nb.f2] 163 update idletasks; lappend result [winfo ismapped $nb.f3] 164} -result [list 1 1 2 0 1] 165 166# See 1370833 167test notebook-6.2 "Forget selected tab" -setup { 168 ttk::notebook .n 169 pack .n 170 label .n.l -text abc 171 .n add .n.l 172} -body { 173 update 174 after 100 175 .n forget .n.l 176 update ;# Yowch! 177} -cleanup { 178 destroy .n 179} -result {} 180 181test notebook-6.3 "Hide first tab when it's the current" -setup { 182 pack [set nb [ttk::notebook .nb]] ; update 183 $nb add [ttk::frame $nb.f1] 184 $nb add [ttk::frame $nb.f2] 185 $nb add [ttk::frame $nb.f3] 186 $nb select $nb.f1 187} -cleanup { 188 destroy $nb 189} -body { 190 set result [list] 191 lappend result [$nb index current] [winfo ismapped $nb.f1] 192 $nb hide $nb.f1 193 lappend result [$nb index current] [winfo ismapped $nb.f1] 194} -result [list 0 1 1 0] 195 196test notebook-6.4 "Forget first tab when it's the current" -setup { 197 pack [set nb [ttk::notebook .nb]] ; update 198 $nb add [ttk::frame $nb.f1] 199 $nb add [ttk::frame $nb.f2] 200 $nb add [ttk::frame $nb.f3] 201 $nb select $nb.f1 202} -cleanup { 203 destroy $nb 204} -body { 205 set result [list] 206 lappend result [$nb index current] [winfo ismapped $nb.f1] 207 $nb forget $nb.f1 208 lappend result [$nb index current] [winfo ismapped $nb.f1] 209} -result [list 0 1 0 0] 210 211test notebook-6.5 "Hide last tab when it's the current" -setup { 212 pack [set nb [ttk::notebook .nb]] ; update 213 $nb add [ttk::frame $nb.f1] 214 $nb add [ttk::frame $nb.f2] 215 $nb add [ttk::frame $nb.f3] 216 $nb select $nb.f3 217} -cleanup { 218 destroy $nb 219} -body { 220 set result [list] 221 lappend result [$nb index current] [winfo ismapped $nb.f3] 222 $nb hide $nb.f3 223 lappend result [$nb index current] [winfo ismapped $nb.f3] 224} -result [list 2 1 1 0] 225 226test notebook-6.6 "Forget a middle tab when it's the current" -setup { 227 pack [set nb [ttk::notebook .nb]] ; update 228 $nb add [ttk::frame $nb.f1] 229 $nb add [ttk::frame $nb.f2] 230 $nb add [ttk::frame $nb.f3] 231 $nb select $nb.f2 232} -cleanup { 233 destroy $nb 234} -body { 235 set result [list] 236 lappend result [$nb index current] [winfo ismapped $nb.f2] 237 $nb forget $nb.f2 238 lappend result [$nb index current] [winfo ismapped $nb.f2] 239} -result [list 1 1 1 0] 240 241test notebook-6.7 "Hide a middle tab when it's the current" -setup { 242 pack [set nb [ttk::notebook .nb]]; update 243 $nb add [ttk::frame $nb.f1] 244 $nb add [ttk::frame $nb.f2] 245 $nb add [ttk::frame $nb.f3] 246 $nb select $nb.f2 247} -cleanup { 248 destroy $nb 249} -body { 250 set result [list] 251 lappend result [$nb index current] [winfo ismapped $nb.f2] 252 $nb hide $nb.f2 253 lappend result [$nb index current] [winfo ismapped $nb.f2] 254} -result [list 1 1 2 0] 255 256test notebook-6.8 "Forget a non-current tab < current" -setup { 257 pack [set nb [ttk::notebook .nb]] ; update 258 $nb add [ttk::frame $nb.f1] 259 $nb add [ttk::frame $nb.f2] 260 $nb add [ttk::frame $nb.f3] 261 $nb select $nb.f2 262} -cleanup { 263 destroy $nb 264} -body { 265 set result [list] 266 lappend result [$nb index current] [winfo ismapped $nb.f2] 267 $nb forget $nb.f1 268 lappend result [$nb index current] [winfo ismapped $nb.f2] 269} -result [list 1 1 0 1] 270 271test notebook-6.9 "Hide a non-current tab < current" -setup { 272 pack [set nb [ttk::notebook .nb]] ; update 273 $nb add [ttk::frame $nb.f1] 274 $nb add [ttk::frame $nb.f2] 275 $nb add [ttk::frame $nb.f3] 276 $nb select $nb.f2 277} -cleanup { 278 destroy $nb 279} -body { 280 set result [list] 281 lappend result [$nb index current] [winfo ismapped $nb.f2] 282 $nb hide $nb.f1 283 lappend result [$nb index current] [winfo ismapped $nb.f2] 284} -result [list 1 1 1 1] 285 286test notebook-6.10 "Forget a non-current tab > current" -setup { 287 pack [set nb [ttk::notebook .nb]] ; update 288 $nb add [ttk::frame $nb.f1] 289 $nb add [ttk::frame $nb.f2] 290 $nb add [ttk::frame $nb.f3] 291 $nb select $nb.f2 292} -cleanup { 293 destroy $nb 294} -body { 295 set result [list] 296 lappend result [$nb index current] [winfo ismapped $nb.f2] 297 $nb forget $nb.f3 298 lappend result [$nb index current] [winfo ismapped $nb.f2] 299} -result [list 1 1 1 1] 300 301test notebook-6.11 "Hide a non-current tab > current" -setup { 302 pack [set nb [ttk::notebook .nb]]; update 303 $nb add [ttk::frame $nb.f1] 304 $nb add [ttk::frame $nb.f2] 305 $nb add [ttk::frame $nb.f3] 306 $nb select $nb.f2 307} -cleanup { 308 destroy $nb 309} -body { 310 set result [list] 311 lappend result [$nb index current] [winfo ismapped $nb.f2] 312 $nb hide $nb.f3 313 lappend result [$nb index current] [winfo ismapped $nb.f2] 314} -result [list 1 1 1 1] 315 316test notebook-6.12 "Hide and re-add a tab" -setup { 317 pack [set nb [ttk::notebook .nb]]; update 318 $nb add [ttk::frame $nb.f1] 319 $nb add [ttk::frame $nb.f2] 320 $nb add [ttk::frame $nb.f3] 321 $nb select $nb.f2 322} -cleanup { 323 destroy $nb 324} -body { 325 set result [list] 326 lappend result [$nb index current] [$nb tab $nb.f2 -state] 327 $nb hide $nb.f2 328 lappend result [$nb index current] [$nb tab $nb.f2 -state] 329 $nb add $nb.f2 330 lappend result [$nb index current] [$nb tab $nb.f2 -state] 331} -result [list 1 normal 2 hidden 2 normal] 332 333# 334# Insert: 335# 336unset nb 337test notebook-7.0 "insert - setup" -body { 338 pack [ttk::notebook .nb] 339 for {set i 0} {$i < 5} {incr i} { 340 .nb add [ttk::frame .nb.f$i] -text "$i" 341 } 342 .nb select .nb.f1 343 list [.nb index current] [.nb tabs] 344} -result [list 1 [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]] 345 346test notebook-7.1 "insert - move backwards" -body { 347 .nb insert 1 3 348 list [.nb index current] [.nb tabs] 349} -result [list 2 [list .nb.f0 .nb.f3 .nb.f1 .nb.f2 .nb.f4]] 350 351test notebook-7.2 "insert - move backwards again" -body { 352 .nb insert 1 3 353 list [.nb index current] [.nb tabs] 354} -result [list 3 [list .nb.f0 .nb.f2 .nb.f3 .nb.f1 .nb.f4]] 355 356test notebook-7.3 "insert - move backwards again" -body { 357 .nb insert 1 3 358 list [.nb index current] [.nb tabs] 359} -result [list 1 [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]] 360 361test notebook-7.4 "insert - move forwards" -body { 362 .nb insert 3 1 363 list [.nb index current] [.nb tabs] 364} -result [list 3 [list .nb.f0 .nb.f2 .nb.f3 .nb.f1 .nb.f4]] 365 366test notebook-7.5 "insert - move forwards again" -body { 367 .nb insert 3 1 368 list [.nb index current] [.nb tabs] 369} -result [list 2 [list .nb.f0 .nb.f3 .nb.f1 .nb.f2 .nb.f4]] 370 371test notebook-7.6 "insert - move forwards again" -body { 372 .nb insert 3 1 373 list [.nb index current] [.nb tabs] 374} -result [list 1 [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]] 375 376test notebook-7.7a "insert - current tab undisturbed" -body { 377 .nb select 0 378 .nb insert 3 1 379 .nb index current 380} -result 0 381 382test notebook-7.7b "insert - current tab undisturbed" -body { 383 .nb select 0 384 .nb insert 1 3 385 .nb index current 386} -result 0 387 388test notebook-7.7c "insert - current tab undisturbed" -body { 389 .nb select 4 390 .nb insert 3 1 391 .nb index current 392} -result 4 393 394test notebook-7.7d "insert - current tab undisturbed" -body { 395 .nb select 4 396 .nb insert 1 3 397 .nb index current 398} -result 4 399 400test notebook-7.8a "move tabs - current tab undisturbed - exhaustive" -body { 401 .nb select .nb.f0 402 foreach i {0 1 2 3 4} { 403 .nb insert $i .nb.f$i 404 } 405 406 foreach i {0 1 2 3 4} { 407 .nb select .nb.f$i 408 foreach j {0 1 2 3 4} { 409 foreach k {0 1 2 3 4} { 410 .nb insert $j $k 411 set current [lindex [.nb tabs] [.nb index current]] 412 if {$current != ".nb.f$i"} { 413 error "($i,$j,$k) current = $current" 414 } 415 .nb insert $k $j 416 if {[.nb tabs] ne [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]} { 417 error "swap $j $k; swap $k $j => [.nb tabs]" 418 } 419 } 420 } 421 } 422 .nb tabs 423} -result [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4] 424 425test notebook-7.8b "insert new - current tab undisturbed - exhaustive" -body { 426 foreach i {0 1 2 3 4} { 427 .nb select .nb.f$i 428 foreach j {0 1 2 3 4} { 429.nb select .nb.f$i 430 .nb insert $j [frame .nb.newf] 431 set current [lindex [.nb tabs] [.nb index current]] 432 if {$current != ".nb.f$i"} { 433 puts stderr "new tab at $j, current = $current, expect .nb.f$i" 434 } 435 destroy .nb.newf 436 if {[.nb tabs] ne [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]} { 437 error "tabs disturbed" 438 } 439 } 440 } 441} 442 443test notebook-7.end "insert - cleanup" -body { 444 destroy .nb 445} 446 447test notebook-1817596-1 "insert should autoselect first tab" -body { 448 pack [ttk::notebook .nb] 449 list \ 450 [.nb insert end [ttk::label .nb.l1 -text One] -text One] \ 451 [.nb select] \ 452 ; 453} -result [list "" .nb.l1] -cleanup { destroy .nb } 454 455test notebook-1817596-2 "error in insert should have no effect" -body { 456 pack [ttk::notebook .nb] 457 .nb insert end [ttk::label .nb.l1] 458 .nb insert end [ttk::label .nb.l2] 459 list \ 460 [catch { .nb insert .l2 0 -badoption badvalue } err] \ 461 [.nb tabs] \ 462} -result [list 1 [list .nb.l1 .nb.l2]] -cleanup { destroy .nb } 463 464test notebook-1817596-3 "insert/configure" -body { 465 pack [ttk::notebook .nb] 466 .nb insert end [ttk::label .nb.l0] -text "L0" 467 .nb insert end [ttk::label .nb.l1] -text "L1" 468 .nb insert end [ttk::label .nb.l2] -text "XX" 469 .nb insert 0 2 -text "L2" 470 471 list [.nb tabs] [.nb tab 0 -text] [.nb tab 1 -text] [.nb tab 2 -text] 472 473} -result [list [list .nb.l2 .nb.l0 .nb.l1] L2 L0 L1] -cleanup { destroy .nb } 474 475 476# See #1343984 477test notebook-1343984-1 "don't autoselect on destroy - setup" -body { 478 ttk::notebook .nb 479 set ::history [list] 480 bind TestFrame <Map> { lappend history MAP %W } 481 bind TestFrame <Destroy> { lappend history DESTROY %W } 482 .nb add [ttk::frame .nb.frame1 -class TestFrame] -text "Frame 1" 483 .nb add [ttk::frame .nb.frame2 -class TestFrame] -text "Frame 2" 484 .nb add [ttk::frame .nb.frame3 -class TestFrame] -text "Frame 3" 485 pack .nb -fill both -expand 1 486 update 487 set ::history 488} -result [list MAP .nb.frame1] 489 490test notebook-1343984-2 "don't autoselect on destroy" -body { 491 set ::history [list] 492 destroy .nb 493 update 494 set ::history 495} -result [list DESTROY .nb.frame1 DESTROY .nb.frame2 DESTROY .nb.frame3] 496 497tcltest::cleanupTests 498