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 false 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 {no value given for parameter "path" to "Entry"}} 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