entry.test

The BWidget Toolkit is a high-level Widget Set for Tcl/Tk built using native Tcl/Tk 8.x namespaces.

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