1# This file is a Tcl script to test out [incr Widgets] Messagebox 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: messagebox.test,v 1.3 2001/08/07 19:56:48 smithc 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 Messagebox-1.$c {Messagebox construction} {
46    iwidgets::Messagebox .mb
47    pack .mb -padx 10 -pady 10 -fill both -expand yes
48    update
49} {}
50
51incr c
52
53#
54# Option tests which are successful.
55#
56test Messagebox-2.$o {configuration option} {
57    llength [.mb configure]
58} {40}
59
60incr o
61
62foreach test {
63    {-activebackground #ececec #ececec}
64    {-activeforeground Black Black}
65    {-background #d9d9d9 #d9d9d9}
66    {-borderwidth 3 3}
67    {-cursor gumby gumby}
68    {-exportselection 0 0}
69    {-exportselection 1 1}
70    {-filename /tmp/foo /tmp/foo}
71    {-foreground Black Black}
72    {-height 0 0}
73    {-width 0 0}
74    {-width 550 550}
75    {-height 120 120}
76    {-highlightcolor Black Black}
77    {-highlightthickness 2 2}
78    {-labelmargin 5 5}
79    {-labeltext Label Label}
80    {-labelpos nw nw}
81    {-labelpos ne ne}
82    {-labelpos en en}
83    {-labelpos e e}
84    {-labelpos es es}
85    {-labelpos se se}
86    {-labelpos s s}
87    {-labelpos sw sw}
88    {-labelpos wn wn}
89    {-labelpos w w}
90    {-labelpos ws ws}
91    {-labelpos n n}
92    {-relief raised raised}
93    {-relief sunken sunken}
94    {-vscrollmode none none}
95    {-vscrollmode static static}
96    {-vscrollmode dynamic dynamic}
97    {-hscrollmode none none}
98    {-hscrollmode static static}
99    {-hscrollmode dynamic dynamic}
100    {-maxlines 1200 1200}
101    {-sbwidth 20 20}
102    {-savedir /tmp /tmp}
103    {-scrollmargin 5 5}
104    {-textbackground GhostWhite GhostWhite}} {
105	set option [lindex $test 0]
106	test Messagebox-2.$o "configuration options, $option" {
107	    .mb configure $option [lindex $test 1]
108	    lindex [.mb configure $option] 4
109	} [lindex $test 2]
110	update
111	incr o
112}
113
114#
115# Option tests which fail and produce errors.
116#
117foreach test {
118  {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
119  {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
120  {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}} {
121	set option [lindex $test 0]
122        test Messagebox-2.$o "configuration options, $option" {
123	    list [catch {.mb configure $option [lindex $test 1]} msg] $msg
124	} [list 1 [lindex $test 2]]
125	incr o
126}
127
128#
129# Method tests which are successful.
130#
131foreach test {
132    {{.mb issue "Default test"} {}}
133    {{.mb type add ERROR -background red -foreground white -bell 1} {ERROR}}
134    {{.mb issue "ERROR test" ERROR} {}}
135    {{.mb type configure ERROR -font 7x13 -show 0} {}}
136    {{.mb issue "ERROR test" ERROR} {}}
137    {{.mb type cget ERROR -background} {red}}
138    {{.mb type remove ERROR} {}}
139    {{.mb clear} {}}} {
140	set method [lindex [lindex $test 0] 1]
141	test Messagebox-3.$m "object methods, $method" {
142	    list [catch {eval [lindex $test 0]} msg] $msg
143	} [list 0 [lindex $test 1]]
144	update
145	incr m
146}
147
148#
149# Method tests which fail and produce errors
150#
151foreach test {
152    {{.mb type bogus bogus} {bad type operation: "bogus", should be add, remove, configure or cget}}
153    {{.mb issue foo bogus} {bad message type: "bogus", use the type command to create a new types}}} {
154	set method [lindex [lindex $test 0] 1]
155	test Messagebox-3.$m "object methods, $method" {
156	    list [catch {eval [lindex $test 0]} msg] $msg
157	} [list 1 [lindex $test 1]]
158	incr m
159}
160
161#
162# Conclusion of constrcution/destruction tests
163#
164test Messagebox-1.$c {Messagebox destruction} {
165    destroy .mb
166    update
167} {}
168
169incr c
170
171test Messagebox-1.$c {Messagebox construction} {
172    iwidgets::messagebox .mb -hscrollmode dynamic -labeltext "Label" \
173	    -labelpos n -labelmargin 5
174    pack .mb -padx 10 -pady 10 -fill both -expand yes
175    update
176} {}
177
178incr c
179
180test Messagebox-1.$c {Messagebox destruction} {
181    destroy .mb
182    update
183} {}
184
185incr c
186
187test Messagebox-1.$c {Messagebox destruction} {
188    iwidgets::messagebox .mb
189    pack .mb
190    destroy .mb
191    update
192} {}
193
194::tcltest::cleanupTests
195exit
196