1 # This file is a Tcl script to test out [incr Widgets] Tabset class.
2 # It is organized in the standard fashion for Tcl tests with the following
3 # notation for test case labels:
5 # 1.x - Construction/Destruction tests
6 # 2.x - Configuration option tests
9 # Copyright (c) 1995 DSC Technologies Corporation
11 # See the file "license.terms" for information on usage and redistribution
12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 package require Iwidgets 3.0
18 if {[string compare test [info procs test]] == 1} {
30 # Initial construction test
32 test Tabset-1.$c {Tabset construction} {
47 # Option tests which are successful.
49 test Tabset-2.$o {configuration option} {
50 llength [.ts configure]
56 {-disabledforeground #a3a3a3 #a3a3a3 }
57 {-backdrop white white }
61 {-selectbackground #ececec #ececec }
62 {-gap overlap overlap }
63 {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
64 {-state normal normal }
65 {-equaltabs true true }
67 {-selectforeground black black }
68 {-foreground #000000000000 #000000000000 }
69 {-raiseselect false false }
76 {-tabborders true true }
80 set option [lindex $test 0]
81 test Tabset-2.$o "configuration options, $option" {
82 .ts configure $option [lindex $test 1]
83 lindex [.ts configure $option] 4
90 # Tabconfigure Option tests which are successful.
92 test Tabset-2.$o {tab configuration option} {
93 llength [.ts tabconfigure 0]
96 # do tabconfigure tests also...
99 {0 -state normal normal}
103 {0 -label Hello Hello}
104 {0 -label "Hello World" "Hello World"}
107 {0 -selectbackground gray70 gray70}
108 {0 -selectforeground black black}
109 {0 -disabledforeground gray gray}
110 {0 -background white white}
111 {0 -foreground black black}
112 {0 -orient vertical vertical}
113 {0 -invert false false}
115 {0 -font "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1" "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1"}
116 {0 -tabborders true true}
118 set index [lindex $test 0]
119 set option [lindex $test 1]
120 test Tabset-2.$o "tab configuration options, $option" {
121 .ts tabconfigure $index $option [lindex $test 2]
122 .ts tabcget $index $option
129 # Option tests which fail and produce errors.
132 # { -OPTION BADVALUE {ERROR_MESSAGE} }
134 # set option [lindex $test 0]
135 # test Tabset-2.$o "configuration options, $option" {
136 # list [catch {.bb configure $option [lindex $test 1]} msg] $msg
137 # } [list 1 [lindex $test 2]]
142 # Method tests which are successful.
151 {{.ts add -label Never}
155 {{.ts add -label "Hello World" -disabledforeground gray}
169 {{.ts select "Hello World"}
173 {{.ts insert select -label "An Insert"}
175 {{.ts insert end -label "Next To Last"}
191 {{.ts delete 0 "Hello World"}
213 {{.ts delete select end}
217 {{.ts add -label "First Page"}
219 {{.ts add -label "Second Page"}
221 {{.ts add -label "Third Page"}
223 {{.ts add -label "Fourth Page"}
225 {{.ts add -label "Fifth Page"}
227 {{.ts add -label "Sixth Page"}
229 {{.ts select "First Page"}
231 {{.ts delete select "Second Page"}
233 {{.ts delete "Third Page" 1}
235 {{.ts delete "Fifth Page" "Sixth Page"}
238 set method [lindex [lindex $test 0] 1]
239 set method_invoke [lindex $test 0]
240 test_pattern Tabset-3.$m "\[$method_invoke\]" {
241 list [catch {eval [lindex $test 0]} msg] $msg
242 } [list 0 [lindex $test 1]]
248 # Method tests which fail and produce errors
251 {{.ts delete 0 end} {}}
254 {{.ts delete 0} {can't delete tabs, no tabs}}
256 {{.ts delete 1} {bad value for index1}}
257 {{.ts delete select} {bad value for index1}}
260 {{.ts delete 0 1} {bad value for index2}}
261 {{.ts delete 1 4} {bad value for index1}}
263 {{.ts delete 0 1} {}}
265 {{.ts delete 0 1 4 5 6} {wrong # args}}
266 {{.ts delete} {wrong # args}}
268 {{.ts delete 0} {can't delete tabs}}
269 {{.ts delete select} {can't delete tabs}}
270 {{.ts insert 0} {no tab to insert before, tabset}}
273 {{.ts insert 2} {bad value}}
274 {{.ts insert -1} {bad option}}
275 {{.ts delete 0 end} {}}
276 {{.ts next} {can't goto next tab, no tabs in the tabset}}
277 {{.ts prev} {can't goto previous tab, no tabs in the tabset}}
278 {{.ts select 0} {can't activate a tab, no tabs in the tabset}}
280 {{.ts select 1} {bad value}}
283 set method [lindex [lindex $test 0] 1]
284 set method_invoke [lindex $test 0]
285 test_pattern Tabset-3.$m "\[$method_invoke\]" {
286 list [catch {eval [lindex $test 0]} msg] $msg
287 } [list 1 [lindex $test 1]]
291 # Conclusion of constrcution/destruction tests
293 test Tabset-1.$c {Tabset destruction} {
300 test Tabset-1.$c {Tabset construction} {
301 iwidgets::Tabset .ts -width 100 -height 100
314 test Tabset-1.$c {Tabset destruction} {