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