1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
if { [lsearch [package names] tcltest] == -1 } {
package require tcltest
namespace import tcltest::*
}
lappend auto_path /home/ericm/bwidget
package require BWidget
option add *Entry.borderWidth 2
option add *Entry.highlightThickness 2
option add *Entry.font {Helvetica -12}
option add *Entry.relief sunken
Entry .e
pack .e
update
set i 0
foreach test {
{-background #ff0000 #ff0000 non-existent \
{unknown color name "non-existent"}}
{-bd 4 4 bad Value {bad screen distance "badValue"}}
{-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
{-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
{-command foo foo {} {}}
{-disabledforeground blue blue non-existent \
{unknown color name "non-existent"}}
{-editable false 0 shazbot {expected boolean value but got "shazbot"}}
{-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
{-fg #110022 #110022 bogus {unknown color name "bogus"}}
{-font {Helvetica 12 italic} {Helvetica 12 italic} {} \
{font "" doesn't exist}}
{-foreground #110022 #110022 bogus {unknown color name "bogus"}}
{-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
{-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
{-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
{-highlightthickness -2 0 {} {}}
{-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
{-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
{-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
{-insertontime 100 100 3.2 {expected integer but got "3.2"}}
{-justify right right bogus \
{bad justification "bogus": must be left, right, or center}}
{-relief groove groove 1.5 \
{bad relief "1.5": must be flat, groove, raised, ridge,\
solid, or sunken}}
{-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
{-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
{-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
{-show * * {} {}}
{-state normal normal bogus \
{bad state "bogus": must be disabled or normal}}
{-takefocus "any string" "any string" {} {}}
{-text foobar foobar {} {}}
{-textvariable i i {} {}}
{-width 402 402 3p {expected integer but got "3p"}}
{-xscrollcommand {Some command} {Some command} {} {}}
} {
set name [lindex $test 0]
test entry-1.$i {configuration options} {
.e configure $name [lindex $test 1]
list [lindex [.e configure $name] 4] [.e cget $name]
} [list [lindex $test 2] [lindex $test 2]]
incr i
}
destroy .e
test Entry-2.1 {Entry} {
list [catch {Entry} msg] $msg
} {1 {wrong # args: should be "Entry path ..."}}
test Entry-2.2 {Entry} {
list [catch {Entry gorp} msg] $msg
} {1 {bad window path name "gorp"}}
test Entry-2.3 {Entry procedure} {
Entry .e
set res [list [winfo exists .e] [winfo class .e] [info commands .e]]
destroy .e
set res
} {1 Entry .e}
test Entry-2.4 {Entr procedure} {
list [catch {Entry .e -gorp foo} msg] $msg [winfo exists .e] \
[info commands .e]
} {1 {unknown option "-gorp"} 0 {}}
test Entry-3.1 {disabled state grays widget} {
Entry .e -disabledforeground blue -foreground red -state normal
set res [list [.e cget -foreground] [.e cget -disabledforeground] \
[.e:cmd cget -foreground]]
.e configure -state disabled
lappend res [.e:cmd cget -foreground]
.e configure -state normal
lappend res [.e:cmd cget -foreground]
destroy .e
set res
} {red blue red blue red}
test Entry-3.2 {changing disabledforeground of an enabled entry} {
Entry .e -disabledforeground blue -foreground red -state normal
set res [list [.e cget -foreground] [.e cget -disabledforeground] \
[.e:cmd cget -foreground]]
.e configure -disabledforeground green
lappend res [.e:cmd cget -foreground]
destroy .e
set res
} {red blue red red}
test Entry-3.3 {changing normal foreground of a disabled entry} {
Entry .e -disabledforeground blue -foreground red -state disabled
set res [list [.e cget -foreground] [.e cget -disabledforeground] \
[.e:cmd cget -foreground]]
.e configure -foreground green
lappend res [.e:cmd cget -foreground]
destroy .e
set res
} {red blue blue blue}
test Entry-3.4 {changing disabled foreground of a disabled entry} {
Entry .e -disabledforeground blue -foreground red -state disabled
set res [list [.e cget -foreground] [.e cget -disabledforeground] \
[.e:cmd cget -foreground]]
.e configure -disabledforeground green
lappend res [.e:cmd cget -foreground]
destroy .e
set res
} {red blue blue green}
test Entry-4.1 {editable flag enables/disables editing} {
Entry .e -editable true
set res [expr {[lsearch [bindtags .e] BwDisabledEntry] == -1}]
.e configure -editable false
lappend res [expr {[lsearch [bindtags .e] BwDisabledEntry] != -1}]
destroy .e
set res
} {1 1}
test Entry-4.2 {editable flag does not impact foreground color} {
Entry .e -editable 1 -foreground red -disabledforeground blue -state normal
set res [list [.e:cmd cget -foreground]]
.e configure -editable false
lappend res [.e:cmd cget -foreground]
destroy .e
set res
} {red red}
test Entry-4.3 {editable flag changes cursor} {
Entry .e -editable 1
set res [list [.e:cmd cget -cursor]]
.e configure -editable 0
lappend res [.e:cmd cget -cursor]
destroy .e
set res
} [list xterm left_ptr]
test Entry-5.1 {-text flag gets entry text} {
Entry .e
.e delete 0 end
.e insert end foobar
set res [.e cget -text]
destroy .e
set res
} foobar
test Entry-5.2 {-text flag sets entry text} {
Entry .e
.e delete 0 end
.e configure -text barbaz
set res [.e get]
destroy .e
set res
} barbaz
test Entry-6.1 {-command works} {
set ::foo 0
Entry .e -command {incr ::foo}
Entry::invoke .e
destroy .e
set ::foo
} 1
tcltest::cleanupTests
exit
|
