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