1# This file is a Tcl script to test out [incr Widgets] Scrolledlistbox class.
2# It is organized in the standard fashion for Tcl tests with the following
3# notation for test case labels:
4#
5#   1.x - Construction/Destruction tests
6#   2.x - Configuration option tests
7#   3.x - Method tests
8#
9# Copyright (c) 1995 DSC Technologies Corporation
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13#
14# @(#) $Id: scrolledlistbox.test,v 1.5 2002/03/16 16:27:33 mgbacke Exp $
15
16package require tcltest
17namespace import -force ::tcltest::*
18
19if [catch {package require Iwidgets 4.0}] {
20  # Let's try modifying the auto_path.  Note that the IWIDGETS_LIBRARY
21  # env var is initialized in the Makefile when doing a 'make test'.
22  # If sourcing this file independently, this variable must be set manually.
23  if ![info exists env(IWIDGETS_LIBRARY)] {
24    error "Unable to locate Iwidgets package.  Set your IWIDGETS_LIBRARY\
25      environment\nvariable to the directory that contains iwidgets.tcl"
26  }
27  lappend auto_path $env(IWIDGETS_LIBRARY)
28  package require Iwidgets 4.0
29}
30
31if {[string compare test [info procs test]] == 1} {
32    source defs
33}
34
35wm geometry . {}
36raise .
37
38set c 1
39set o 1
40set m 1
41
42#
43# Initial construction test
44#
45test Scrolledlistbox-1.$c {Scrolledlistbox construction} {
46    iwidgets::Scrolledlistbox .slb -height 300 -width 300
47    pack .slb -padx 10 -pady 10 -fill both -expand yes
48    .slb insert end {Hello World} {Hello World}
49    update 
50} {}
51
52incr c
53
54#
55# Option tests which are successful.
56#
57test Scrolledlistbox-2.$o {configuration option} {
58    llength [.slb configure]
59} {40}
60
61incr o
62
63foreach test {
64    {-labeltext Scrolledlistbox Scrolledlistbox}
65    {-height 200 200}
66    {-width 200 200}
67    {-labelpos nw nw}
68    {-labelpos ne ne}
69    {-labelpos en en}
70    {-labelpos e e}
71    {-labelpos es es}
72    {-labelpos se se}
73    {-labelpos s s}
74    {-labelpos sw sw}
75    {-labelpos wn wn}
76    {-labelpos w w}
77    {-labelpos ws ws}
78    {-labelpos n n}
79    {-borderwidth 3 3} 
80    {-hscrollmode none none} 
81    {-hscrollmode static static} 
82    {-hscrollmode dynamic dynamic} 
83    {-relief raised raised} 
84    {-relief sunken sunken} 
85    {-sbwidth 20 20} 
86    {-sbwidth 15 15} 
87    {-textbackground GhostWhite GhostWhite} 
88    {-scrollmargin 10 10} 
89    {-selectborderwidth 3 3} 
90    {-selectforeground blue blue} 
91    {-selectmode browse browse} 
92    {-selectmode extended extended} 
93    {-selectmode single single} 
94    {-selectmode multiple multiple} 
95    {-sticky w w}
96    {-sticky nw nw}
97    {-sticky n n}
98    {-sticky ne ne}
99    {-sticky e e}
100    {-sticky se se}
101    {-sticky s s}
102    {-sticky sw sw}
103    {-sticky news news}
104    {-textfont 6x13 6x13} 
105    {-vscrollmode none none} 
106    {-vscrollmode static static} 
107    {-vscrollmode dynamic dynamic} 
108    {-visibleitems 30x20 30x20}
109    {-width 0 0}
110    {-height 0 0}} {
111	set option [lindex $test 0]
112	test Scrolledlistbox-2.$o "configuration options, $option" {
113	    .slb configure $option [lindex $test 1]
114	    lindex [.slb configure $option] 4
115	} [lindex $test 2]
116	update 
117	incr o
118}
119
120#
121# Option tests which fail and produce errors.
122#
123foreach test {
124  {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
125  {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
126  {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} {
127	set option [lindex $test 0]
128        test Scrolledlistbox-2.$o "configuration options, $option" {
129	    list [catch {.slb configure $option [lindex $test 1]} msg] $msg
130	} [list 1 [lindex $test 2]]
131	incr o
132}
133
134#
135# Method tests which are successful.
136#
137foreach test {
138    {{.slb insert 0 Test Test Test Test} {}}
139    {{.slb insert end {More Test}} {}}
140    {{.slb delete 1} {}}
141    {{.slb delete 0 3} {}}
142    {{.slb insert end World} {}}
143    {{.slb selection set World} {}}
144    {{.slb selection set World {More Test}} {}}
145    {{.slb getcurselection} {{More Test} World}}
146    {{.slb selecteditemcount} {2}}
147    {{.slb selection clear 0 end} {}}
148    {{.slb selecteditemcount} {0}}
149    {{.slb clear} {}}
150    {{.slb size} {0}}
151    {{.slb insert end {Test} {Test} {Long String Test}} {}}
152    {{.slb size} {3}}
153    {{.slb insert 0 {Test} {Test} {Long String Test}} {}}
154    {{.slb size} {6}}
155    {{.slb insert 1 {Test} {Test} {Long String Test}} {}}
156    {{.slb size} {9}}
157    {{.slb insert 5 {Test} {Test} {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}} {}}
158    {{.slb size} {12}}
159    {{.slb get end} {Long String Test}}
160    {{.slb justify left} {}}
161    {{.slb justify right} {}}
162    {{.slb justify top} {}}
163    {{.slb justify bottom} {}}
164    {{.slb sort ascending} {}}
165    {{.slb sort descending} {}}
166    {{.slb sort increasing} {}}
167    {{.slb sort decreasing} {}}} {
168	set method [lindex [lindex $test 0] 1]
169	test Scrolledlistbox-3.$m "object methods, $method" {
170	    list [catch {eval [lindex $test 0]} msg] $msg
171	} [list 0 [lindex $test 1]]
172	update 
173	incr m
174}
175
176#
177# Method tests which fail and produce errors
178#
179foreach test {
180    {{.slb index bogus} {bad Scrolledlistbox index "bogus": must be active, anchor, end, @x,y, number, or a pattern}}
181    {{.slb justify bogus} {bad justify argument "bogus": should be left, right, top, or bottom}}
182    {{.slb sort bogus} {bad sort argument "bogus": must be a valid argument to the Tcl lsort command}}} {
183
184	set method [lindex [lindex $test 0] 1]
185	test Scrolledlistbox-3.$m "object methods, $method" {
186	    list [catch {eval [lindex $test 0]} msg] $msg
187	} [list 1 [lindex $test 1]]
188	incr m
189}
190
191#
192# Conclusion of constrcution/destruction tests
193#
194test Scrolledlistbox-1.$c {Scrolledlistbox destruction} {
195    destroy .slb
196    update 
197} {}
198
199incr c
200
201test Scrolledlistbox-1.$c {Scrolledlistbox construction} {
202    iwidgets::scrolledlistbox .slb -selectmode extended \
203	-vscrollmode static -hscrollmode dynamic -labeltext "List" \
204	-labelpos nw 
205    pack .slb -padx 10 -pady 10 -fill both -expand yes
206    update 
207} {}
208
209incr c
210
211test Scrolledlistbox-1.$c {Scrolledlistbox destruction} {
212    destroy .slb
213    update 
214} {}
215
216incr c
217
218test Scrolledlistbox-1.$c {Scrolledlistbox destruction} {
219    iwidgets::scrolledlistbox .slb
220    pack .slb
221    destroy .slb
222    update 
223} {}
224
225::tcltest::cleanupTests
226exit
227