1660 lines
50 KiB
Plaintext
1660 lines
50 KiB
Plaintext
# This file is a Tcl script to test entry widgets in Tk. It is
|
|
# organized in the standard fashion for Tcl tests.
|
|
#
|
|
# Copyright (c) 1994 The Regents of the University of California.
|
|
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
|
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
|
# All rights reserved.
|
|
|
|
package require tcltest 2.1
|
|
eval tcltest::configure $argv
|
|
tcltest::loadTestedCommands
|
|
|
|
proc scroll args {
|
|
global scrollInfo
|
|
set scrollInfo $args
|
|
}
|
|
|
|
# Create additional widget that's used to hold the selection at times.
|
|
|
|
entry .sel
|
|
.sel insert end "This is some sample text"
|
|
|
|
# Font names
|
|
|
|
set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1
|
|
set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1
|
|
|
|
# Create entries in the option database to be sure that geometry options
|
|
# like border width have predictable values.
|
|
|
|
option add *Entry.borderWidth 2
|
|
option add *Entry.highlightThickness 2
|
|
option add *Entry.font {Helvetica -12}
|
|
|
|
entry .e -bd 2 -relief sunken
|
|
pack .e
|
|
update
|
|
|
|
set i 1
|
|
foreach test {
|
|
{-background #ff0000 #ff0000 non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-bd 4 4 badValue {bad screen distance "badValue"}}
|
|
{-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
|
|
{-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
|
|
{-cursor arrow arrow badValue {bad cursor spec "badValue"}}
|
|
{-disabledbackground green green non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-disabledforeground blue blue non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
|
|
{-fg #110022 #110022 bogus {unknown color name "bogus"}}
|
|
{-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
|
|
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
|
|
{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"}}
|
|
{-invalidcommand "any string" "any string" {} {}}
|
|
{-invcmd "any string" "any string" {} {}}
|
|
{-justify right right bogus {bad justification "bogus": must be left, right, or center}}
|
|
{-readonlybackground green green non-existent
|
|
{unknown color name "non-existent"}}
|
|
{-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 n normal bogus
|
|
{bad state "bogus": must be disabled, normal, or readonly}}
|
|
{-takefocus "any string" "any string" {} {}}
|
|
{-textvariable i i {} {}}
|
|
{-width 402 402 3p {expected integer but got "3p"}}
|
|
{-xscrollcommand {Some command} {Some command} {} {}}
|
|
} {
|
|
lassign $test name goodValue goodResult badValue badResult
|
|
test entry-1.$i {configuration options} {
|
|
.e configure $name $goodValue
|
|
list [lindex [.e configure $name] 4] [.e cget $name]
|
|
} [list $goodResult $goodResult]
|
|
incr i
|
|
if {$badValue ne ""} {
|
|
test entry-1.$i {configuration options} -body {
|
|
.e configure $name $badValue
|
|
} -returnCodes error -result $badResult
|
|
}
|
|
.e configure $name [lindex [.e configure $name] 3]
|
|
incr i
|
|
}
|
|
|
|
test entry-2.1 {Tk_EntryCmd procedure} {
|
|
list [catch {entry} msg] $msg
|
|
} {1 {wrong # args: should be "entry pathName ?options?"}}
|
|
test entry-2.2 {Tk_EntryCmd procedure} {
|
|
list [catch {entry gorp} msg] $msg
|
|
} {1 {bad window path name "gorp"}}
|
|
test entry-2.3 {Tk_EntryCmd procedure} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
list [winfo exists .e] [winfo class .e] [info commands .e]
|
|
} {1 Entry .e}
|
|
test entry-2.4 {Tk_EntryCmd procedure} {
|
|
catch {destroy .e}
|
|
list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \
|
|
[info commands .e]
|
|
} {1 {unknown option "-gorp"} 0 {}}
|
|
test entry-2.5 {Tk_EntryCmd procedure} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
} {.e}
|
|
|
|
catch {destroy .e}
|
|
entry .e -font $fixed
|
|
pack .e
|
|
update
|
|
|
|
set cx [font measure $fixed a]
|
|
set cy [font metrics $fixed -linespace]
|
|
set ux [font measure $fixed \u4e4e]
|
|
|
|
test entry-3.1 {EntryWidgetCmd procedure} {
|
|
list [catch {.e} msg] $msg
|
|
} {1 {wrong # args: should be ".e option ?arg arg ...?"}}
|
|
test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
list [catch {.e bbox} msg] $msg
|
|
} {1 {wrong # args: should be ".e bbox index"}}
|
|
test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
list [catch {.e bbox a b} msg] $msg
|
|
} {1 {wrong # args: should be ".e bbox index"}}
|
|
test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
list [catch {.e bbox bogus} msg] $msg
|
|
} {1 {bad entry index "bogus"}}
|
|
test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
.e delete 0 end
|
|
.e bbox 0
|
|
} [list 5 5 0 $cy]
|
|
test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
# Tcl_UtfAtIndex(): no utf chars
|
|
|
|
.e delete 0 end
|
|
.e insert 0 "abc"
|
|
list [.e bbox 3] [.e bbox end]
|
|
} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"]
|
|
test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
# Tcl_UtfAtIndex(): utf at end
|
|
.e delete 0 end
|
|
.e insert 0 "ab\u4e4e"
|
|
.e bbox end
|
|
} "[expr 5+2*$cx] 5 $ux $cy"
|
|
test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
# Tcl_UtfAtIndex(): utf before index
|
|
.e delete 0 end
|
|
.e insert 0 "ab\u4e4ec"
|
|
.e bbox 3
|
|
} "[expr 5+2*$cx+$ux] 5 $cx $cy"
|
|
test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
# Tcl_UtfAtIndex(): no chars
|
|
.e delete 0 end
|
|
.e bbox end
|
|
} "5 5 0 $cy"
|
|
test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} {
|
|
.e delete 0 end
|
|
.e insert 0 "abcdefghij\u4e4eklmnop"
|
|
list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
|
|
} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"]
|
|
test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} {
|
|
list [catch {.e cget} msg] $msg
|
|
} {1 {wrong # args: should be ".e cget option"}}
|
|
test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} {
|
|
list [catch {.e cget a b} msg] $msg
|
|
} {1 {wrong # args: should be ".e cget option"}}
|
|
test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} {
|
|
list [catch {.e cget -gorp} msg] $msg
|
|
} {1 {unknown option "-gorp"}}
|
|
test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} {
|
|
.e configure -bd 4
|
|
.e cget -bd
|
|
} {4}
|
|
test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} {
|
|
llength [.e configure]
|
|
} {36}
|
|
test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} {
|
|
list [catch {.e configure -foo} msg] $msg
|
|
} {1 {unknown option "-foo"}}
|
|
test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} {
|
|
.e configure -bd 4
|
|
.e configure -bg #ffffff
|
|
lindex [.e configure -bd] 4
|
|
} {4}
|
|
test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
list [catch {.e delete} msg] $msg
|
|
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
|
|
test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
list [catch {.e delete a b c} msg] $msg
|
|
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
|
|
test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
list [catch {.e delete foo} msg] $msg
|
|
} {1 {bad entry index "foo"}}
|
|
test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
list [catch {.e delete 0 bar} msg] $msg
|
|
} {1 {bad entry index "bar"}}
|
|
test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e delete 2 4
|
|
.e get
|
|
} {014567890}
|
|
test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e delete 6
|
|
.e get
|
|
} {0123457890}
|
|
test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
# UTF
|
|
set x {}
|
|
.e delete 0 end
|
|
.e insert end "01234\u4e4e67890"
|
|
.e delete 6
|
|
lappend x [.e get]
|
|
.e delete 0 end
|
|
.e insert end "012345\u4e4e7890"
|
|
.e delete 6
|
|
lappend x [.e get]
|
|
.e delete 0 end
|
|
.e insert end "0123456\u4e4e890"
|
|
.e delete 6
|
|
lappend x [.e get]
|
|
} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
|
|
test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e delete 6 5
|
|
.e get
|
|
} {01234567890}
|
|
test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e configure -state disabled
|
|
.e delete 2 8
|
|
.e configure -state normal
|
|
.e get
|
|
} {01234567890}
|
|
test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e configure -state readonly
|
|
.e delete 2 8
|
|
.e configure -state normal
|
|
.e get
|
|
} {01234567890}
|
|
test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} {
|
|
list [catch {.e get foo} msg] $msg
|
|
} {1 {wrong # args: should be ".e get"}}
|
|
test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} {
|
|
list [catch {.e icursor} msg] $msg
|
|
} {1 {wrong # args: should be ".e icursor pos"}}
|
|
test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} {
|
|
list [catch {.e icursor foo} msg] $msg
|
|
} {1 {bad entry index "foo"}}
|
|
test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e icursor 4
|
|
.e index insert
|
|
} {4}
|
|
test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} {
|
|
list [catch {.e in} msg] $msg
|
|
} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}}
|
|
test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} {
|
|
list [catch {.e index} msg] $msg
|
|
} {1 {wrong # args: should be ".e index string"}}
|
|
test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} {
|
|
list [catch {.e index foo} msg] $msg
|
|
} {1 {bad entry index "foo"}}
|
|
test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} {
|
|
list [catch {.e index 0} msg] $msg
|
|
} {0 0}
|
|
test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} {
|
|
# UTF
|
|
.e delete 0 end
|
|
.e insert 0 abc\u4e4e\u0153def
|
|
list [.e index 3] [.e index 4] [.e index end]
|
|
} {3 4 8}
|
|
test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} {
|
|
list [catch {.e insert a} msg] $msg
|
|
} {1 {wrong # args: should be ".e insert index text"}}
|
|
test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} {
|
|
list [catch {.e insert a b c} msg] $msg
|
|
} {1 {wrong # args: should be ".e insert index text"}}
|
|
test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} {
|
|
list [catch {.e insert foo Text} msg] $msg
|
|
} {1 {bad entry index "foo"}}
|
|
test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e insert 3 xxx
|
|
.e get
|
|
} {012xxx34567890}
|
|
test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e configure -state disabled
|
|
.e insert 3 xxx
|
|
.e configure -state normal
|
|
.e get
|
|
} {01234567890}
|
|
test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "01234567890"
|
|
.e configure -state readonly
|
|
.e insert 3 xxx
|
|
.e configure -state normal
|
|
.e get
|
|
} {01234567890}
|
|
test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} {
|
|
list [catch {.e insert a b c} msg] $msg
|
|
} {1 {wrong # args: should be ".e insert index text"}}
|
|
test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} {
|
|
list [catch {.e scan a} msg] $msg
|
|
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
|
|
test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} {
|
|
list [catch {.e scan a b c} msg] $msg
|
|
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
|
|
test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} {
|
|
list [catch {.e scan foobar 20} msg] $msg
|
|
} {1 {bad scan option "foobar": must be mark or dragto}}
|
|
test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} {
|
|
list [catch {.e scan mark 20.1} msg] $msg
|
|
} {1 {expected integer but got "20.1"}}
|
|
# This test is non-portable because character sizes vary.
|
|
|
|
test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
|
|
.e delete 0 end
|
|
update
|
|
.e insert end "This is quite a long string, in fact a "
|
|
.e insert end "very very long string"
|
|
.e scan mark 30
|
|
.e scan dragto 28
|
|
.e index @0
|
|
} {2}
|
|
test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} {
|
|
list [catch {.e select} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection option ?index?"}}
|
|
test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} {
|
|
list [catch {.e select foo} msg] $msg
|
|
} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
|
|
test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} {
|
|
list [catch {.e select clear gorp} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection clear"}}
|
|
test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "0123456789"
|
|
.e select from 1
|
|
.e select to 4
|
|
update
|
|
.e select clear
|
|
list [catch {selection get} msg] $msg [selection own]
|
|
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
|
|
test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} {
|
|
list [catch {.e selection present foo} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection present"}}
|
|
test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e select from 3
|
|
.e select to 6
|
|
.e selection present
|
|
} {1}
|
|
test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e select from 3
|
|
.e select to 6
|
|
.e configure -exportselection false
|
|
.e selection present
|
|
} {1}
|
|
.e configure -exportselection true
|
|
test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e select from 3
|
|
.e select to 6
|
|
.e delete 0 end
|
|
.e selection present
|
|
} {0}
|
|
test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} {
|
|
list [catch {.e select adjust x} msg] $msg
|
|
} {1 {bad entry index "x"}}
|
|
test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} {
|
|
list [catch {.e select adjust 2 3} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection adjust index"}}
|
|
test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "0123456789"
|
|
.e select from 1
|
|
.e select to 5
|
|
update
|
|
.e select adjust 4
|
|
selection get
|
|
} {123}
|
|
test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} {
|
|
.e delete 0 end
|
|
.e insert end "0123456789"
|
|
.e select from 1
|
|
.e select to 5
|
|
update
|
|
.e select adjust 2
|
|
selection get
|
|
} {234}
|
|
test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} {
|
|
list [catch {.e select from 2 3} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection from index"}}
|
|
test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} {
|
|
list [catch {.e select range 2} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection range start end"}}
|
|
test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} {
|
|
list [catch {.e selection range 2 3 4} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection range start end"}}
|
|
test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e select from 1
|
|
.e select to 5
|
|
.e select range 4 4
|
|
list [catch {.e index sel.first} msg] $msg
|
|
} {1 {selection isn't in widget .e}}
|
|
test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e select from 3
|
|
.e select to 7
|
|
.e select range 2 9
|
|
list [.e index sel.first] [.e index sel.last] [.e index anchor]
|
|
} {2 9 3}
|
|
test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e selection range 0 end
|
|
.e configure -state disabled
|
|
.e selection range 2 4
|
|
.e configure -state normal
|
|
list [.e index sel.first] [.e index sel.last]
|
|
} {0 10}
|
|
test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} {
|
|
.e delete 0 end
|
|
.e insert end 0123456789
|
|
.e selection range 0 end
|
|
.e configure -state readonly
|
|
.e selection range 2 4
|
|
.e configure -state normal
|
|
list [.e index sel.first] [.e index sel.last]
|
|
} {2 4}
|
|
.e delete 0 end
|
|
.e insert end "This is quite a long text string, so long that it "
|
|
.e insert end "runs off the end of the window quite a bit."
|
|
test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} {
|
|
list [catch {.e select to 2 3} msg] $msg
|
|
} {1 {wrong # args: should be ".e selection to index"}}
|
|
test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview 5
|
|
format {%.7f %.7f} {*}[.e xview]
|
|
} {0.0537634 0.2688172}
|
|
test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview gorp} msg] $msg
|
|
} {1 {bad entry index "gorp"}}
|
|
test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview 0
|
|
.e icursor 10
|
|
.e xview insert
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.107527 0.322581}
|
|
test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview moveto foo bar} msg] $msg
|
|
} {1 {wrong # args: should be ".e xview moveto fraction"}}
|
|
test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview moveto foo} msg] $msg
|
|
} {1 {expected floating-point number but got "foo"}}
|
|
test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview moveto 0.5
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.505376 0.720430}
|
|
test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview scroll 24} msg] $msg
|
|
} {1 {wrong # args: should be ".e xview scroll number units|pages"}}
|
|
test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview scroll gorp units} msg] $msg
|
|
} {1 {expected integer but got "gorp"}}
|
|
test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview moveto 0
|
|
.e xview scroll 1 pages
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.193548 0.408602}
|
|
test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview moveto .9
|
|
update
|
|
.e xview scroll -2 p
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.397849 0.612903}
|
|
test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview 30
|
|
update
|
|
.e xview scroll 2 units
|
|
.e index @0
|
|
} {32}
|
|
test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview 30
|
|
update
|
|
.e xview scroll -1 units
|
|
.e index @0
|
|
} {29}
|
|
test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview scroll 23 foobars} msg] $msg
|
|
} {1 {bad argument "foobars": must be units or pages}}
|
|
test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
list [catch {.e xview eat 23 hamburgers} msg] $msg
|
|
} {1 {unknown option "eat": must be moveto or scroll}}
|
|
test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview 0
|
|
update
|
|
.e xview -4
|
|
.e index @0
|
|
} {0}
|
|
test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
.e xview 300
|
|
.e index @0
|
|
} {73}
|
|
.e insert 10 \u4e4e
|
|
test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} {
|
|
# UTF
|
|
# If Tcl_NumUtfChars wasn't used, wrong answer would be:
|
|
# 0.106383 0.117021 0.117021
|
|
|
|
set x {}
|
|
.e xview moveto .1
|
|
lappend x [format {%.6f} [lindex [.e xview] 0]]
|
|
.e xview moveto .11
|
|
lappend x [format {%.6f} [lindex [.e xview] 0]]
|
|
.e xview moveto .12
|
|
lappend x [format {%.6f} [lindex [.e xview] 0]]
|
|
} {0.095745 0.106383 0.117021}
|
|
test entry-3.82 {EntryWidgetCmd procedure} {
|
|
list [catch {.e gorp} msg] $msg
|
|
} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}}
|
|
|
|
# The test below doesn't actually check anything directly, but if run
|
|
# with Purify or some other memory-allocation-checking program it will
|
|
# ensure that resources get properly freed.
|
|
|
|
test entry-4.1 {DestroyEntry procedure} {
|
|
catch {destroy .e}
|
|
entry .e -textvariable x -show *
|
|
pack .e
|
|
.e insert end "Sample text"
|
|
update
|
|
destroy .e
|
|
} {}
|
|
|
|
frame .f -width 200 -height 50 -relief raised -bd 2
|
|
pack .f -side right
|
|
test entry-5.1 {ConfigureEntry procedure, -textvariable} {
|
|
catch {destroy .e}
|
|
set x 12345
|
|
entry .e -textvariable x
|
|
.e get
|
|
} {12345}
|
|
test entry-5.2 {ConfigureEntry procedure, -textvariable} {
|
|
catch {destroy .e}
|
|
set x 12345
|
|
entry .e -textvariable x
|
|
set y abcde
|
|
.e configure -textvariable y
|
|
set x 54321
|
|
.e get
|
|
} {abcde}
|
|
test entry-5.3 {ConfigureEntry procedure, -textvariable} {
|
|
catch {destroy .e}
|
|
catch {unset x}
|
|
entry .e
|
|
.e insert 0 "Some text"
|
|
.e configure -textvariable x
|
|
set x
|
|
} {Some text}
|
|
test entry-5.4 {ConfigureEntry procedure, -textvariable} {
|
|
proc override args {
|
|
global x
|
|
set x 12345
|
|
}
|
|
catch {destroy .e}
|
|
catch {unset x}
|
|
trace variable x w override
|
|
entry .e
|
|
.e insert 0 "Some text"
|
|
.e configure -textvariable x
|
|
set result [list $x [.e get]]
|
|
unset x; rename override {}
|
|
set result
|
|
} {12345 12345}
|
|
test entry-5.5 {ConfigureEntry procedure} {
|
|
catch {destroy .e}
|
|
entry .e -exportselection false
|
|
pack .e
|
|
.e insert end "0123456789"
|
|
.sel select from 0
|
|
.sel select to 10
|
|
set x {}
|
|
lappend x [selection get]
|
|
.e select from 1
|
|
.e select to 5
|
|
lappend x [selection get]
|
|
.e configure -exportselection 1
|
|
lappend x [selection get]
|
|
set x
|
|
} {{This is so} {This is so} 1234}
|
|
test entry-5.6 {ConfigureEntry procedure} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
pack .e
|
|
.e insert end "0123456789"
|
|
.e select from 1
|
|
.e select to 5
|
|
.e configure -exportselection 0
|
|
list [catch {selection get} msg] $msg [.e index sel.first] \
|
|
[.e index sel.last]
|
|
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5}
|
|
test entry-5.7 {ConfigureEntry procedure} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -width 4 -xscrollcommand scroll
|
|
pack .e
|
|
.e insert end "01234567890"
|
|
update
|
|
.e configure -width 5
|
|
format {%.6f %.6f} {*}$scrollInfo
|
|
} {0.000000 0.363636}
|
|
test entry-5.8 {ConfigureEntry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -width 0
|
|
pack .e
|
|
.e insert end "0123"
|
|
update
|
|
.e configure -font $big
|
|
update
|
|
winfo geom .e
|
|
} {62x37+0+0}
|
|
test entry-5.9 {ConfigureEntry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised
|
|
pack .e
|
|
.e insert end "0123"
|
|
update
|
|
list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
|
|
} {0 0 1 1}
|
|
test entry-5.10 {ConfigureEntry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief flat
|
|
pack .e
|
|
.e insert end "0123"
|
|
update
|
|
list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
|
|
} {0 0 1 1}
|
|
test entry-5.11 {ConfigureEntry procedure} {
|
|
# If "0" in selected font had 0 width, caused divide-by-zero error.
|
|
|
|
catch {destroy .e}
|
|
pack [entry .e -font {{open look glyph}}]
|
|
.e scan dragto 30
|
|
update
|
|
} {}
|
|
|
|
# No tests for DisplayEntry.
|
|
|
|
test entry-6.1 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3
|
|
pack .e
|
|
.e insert end 012\t45
|
|
update
|
|
list [.e index @61] [.e index @62]
|
|
} {3 4}
|
|
test entry-6.2 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 20 -justify center \
|
|
-highlightthickness 3
|
|
pack .e
|
|
.e insert end 012\t45
|
|
update
|
|
list [.e index @96] [.e index @97]
|
|
} {3 4}
|
|
test entry-6.3 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 20 -justify right \
|
|
-highlightthickness 3
|
|
pack .e
|
|
.e insert end 012\t45
|
|
update
|
|
list [.e index @131] [.e index @132]
|
|
} {3 4}
|
|
test entry-6.4 {EntryComputeGeometry procedure} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 5
|
|
pack .e
|
|
.e insert end "01234567890"
|
|
update
|
|
.e xview 6
|
|
.e index @0
|
|
} {6}
|
|
test entry-6.5 {EntryComputeGeometry procedure} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 5
|
|
pack .e
|
|
.e insert end "01234567890"
|
|
update
|
|
.e xview 7
|
|
.e index @0
|
|
} {6}
|
|
test entry-6.6 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 10
|
|
pack .e
|
|
.e insert end "01234\t67890"
|
|
update
|
|
.e xview 3
|
|
list [.e index @39] [.e index @40]
|
|
} {5 6}
|
|
test entry-6.7 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $big -bd 3 -relief raised -width 5
|
|
pack .e
|
|
.e insert end "01234567"
|
|
update
|
|
list [winfo reqwidth .e] [winfo reqheight .e]
|
|
} {77 39}
|
|
test entry-6.8 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $big -bd 3 -relief raised -width 0
|
|
pack .e
|
|
.e insert end "01234567"
|
|
update
|
|
list [winfo reqwidth .e] [winfo reqheight .e]
|
|
} {116 39}
|
|
test entry-6.9 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2
|
|
pack .e
|
|
update
|
|
list [winfo reqwidth .e] [winfo reqheight .e]
|
|
} {25 39}
|
|
test entry-6.10 {EntryComputeGeometry procedure} {unix fonts} {
|
|
catch {destroy .e}
|
|
entry .e -bd 1 -relief raised -width 0 -show .
|
|
.e insert 0 12345
|
|
pack .e
|
|
update
|
|
set x [winfo reqwidth .e]
|
|
.e configure -show X
|
|
lappend x [winfo reqwidth .e]
|
|
.e configure -show ""
|
|
lappend x [winfo reqwidth .e]
|
|
} {23 53 43}
|
|
test entry-6.11 {EntryComputeGeometry procedure} win {
|
|
catch {destroy .e}
|
|
entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12}
|
|
.e insert 0 12345
|
|
pack .e
|
|
update
|
|
set x [winfo reqwidth .e]
|
|
.e configure -show X
|
|
lappend x [winfo reqwidth .e]
|
|
.e configure -show ""
|
|
lappend x [winfo reqwidth .e]
|
|
} [list \
|
|
[expr 8+5*[font measure {helvetica 12} .]] \
|
|
[expr 8+5*[font measure {helvetica 12} X]] \
|
|
[expr 8+[font measure {helvetica 12} 12345]]]
|
|
test entry-6.12 {EntryComputeGeometry procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -bd 2 -relief raised -width 20
|
|
pack .e
|
|
.e insert end "012\t456\t"
|
|
update
|
|
list [.e index @81] [.e index @82] [.e index @116] [.e index @117]
|
|
} {6 7 7 8}
|
|
|
|
catch {destroy .e}
|
|
entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
|
|
pack .e
|
|
focus .e
|
|
test entry-7.1 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 abcde
|
|
.e insert 2 XXX
|
|
update
|
|
list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo]
|
|
} {abXXXcde abXXXcde {0.000000 1.000000}}
|
|
test entry-7.2 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 abcde
|
|
.e insert 500 XXX
|
|
update
|
|
list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo]
|
|
} {abcdeXXX abcdeXXX {0.000000 1.000000}}
|
|
test entry-7.3 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789
|
|
.e select from 2
|
|
.e select to 6
|
|
.e insert 2 XXX
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 8
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {5 9 5 8}
|
|
test entry-7.4 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789
|
|
.e select from 2
|
|
.e select to 6
|
|
.e insert 3 XXX
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 8
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {2 9 2 8}
|
|
test entry-7.5 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789
|
|
.e select from 2
|
|
.e select to 6
|
|
.e insert 5 XXX
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 8
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {2 9 2 8}
|
|
test entry-7.6 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789
|
|
.e select from 2
|
|
.e select to 6
|
|
.e insert 6 XXX
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 5
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {2 6 2 5}
|
|
test entry-7.7 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789
|
|
.e icursor 4
|
|
.e insert 4 XXX
|
|
.e index insert
|
|
} {7}
|
|
test entry-7.8 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789
|
|
.e icursor 4
|
|
.e insert 5 XXX
|
|
.e index insert
|
|
} {4}
|
|
test entry-7.9 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 "This is a very long string"
|
|
update
|
|
.e xview 4
|
|
.e insert 3 XXX
|
|
.e index @0
|
|
} {7}
|
|
test entry-7.10 {InsertChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 "This is a very long string"
|
|
update
|
|
.e xview 4
|
|
.e insert 4 XXX
|
|
.e index @0
|
|
} {4}
|
|
.e configure -width 0
|
|
test entry-7.11 {InsertChars procedure} {fonts} {
|
|
.e delete 0 end
|
|
.e insert 0 "xyzzy"
|
|
update
|
|
.e insert 2 00
|
|
winfo reqwidth .e
|
|
} {59}
|
|
|
|
.e configure -width 10
|
|
test entry-8.1 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 abcde
|
|
.e delete 2 4
|
|
update
|
|
list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo]
|
|
} {abe abe {0.000000 1.000000}}
|
|
test entry-8.2 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 abcde
|
|
.e delete -2 2
|
|
update
|
|
list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo]
|
|
} {cde cde {0.000000 1.000000}}
|
|
test entry-8.3 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 abcde
|
|
.e delete 3 1000
|
|
update
|
|
list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo]
|
|
} {abc abc {0.000000 1.000000}}
|
|
test entry-8.4 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 3
|
|
.e select to 8
|
|
.e delete 1 3
|
|
update
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 5
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {1 6 1 5}
|
|
test entry-8.5 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 3
|
|
.e select to 8
|
|
.e delete 1 4
|
|
update
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 4
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {1 5 1 4}
|
|
test entry-8.6 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 3
|
|
.e select to 8
|
|
.e delete 1 7
|
|
update
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 5
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {1 2 1 5}
|
|
test entry-8.7 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 3
|
|
.e select to 8
|
|
.e delete 1 8
|
|
list [catch {.e index sel.first} msg] $msg
|
|
} {1 {selection isn't in widget .e}}
|
|
test entry-8.8 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 3
|
|
.e select to 8
|
|
.e delete 3 7
|
|
update
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 8
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {3 4 3 8}
|
|
test entry-8.9 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 3
|
|
.e select to 8
|
|
.e delete 3 8
|
|
list [catch {.e index sel.first} msg] $msg
|
|
} {1 {selection isn't in widget .e}}
|
|
test entry-8.10 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 8
|
|
.e select to 3
|
|
.e delete 5 8
|
|
update
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 8
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {3 5 5 8}
|
|
test entry-8.11 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e select from 8
|
|
.e select to 3
|
|
.e delete 8 10
|
|
update
|
|
set x "[.e index sel.first] [.e index sel.last]"
|
|
.e select to 4
|
|
lappend x [.e index sel.first] [.e index sel.last]
|
|
} {3 8 4 8}
|
|
test entry-8.12 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e icursor 4
|
|
.e delete 1 4
|
|
.e index insert
|
|
} {1}
|
|
test entry-8.13 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e icursor 4
|
|
.e delete 1 5
|
|
.e index insert
|
|
} {1}
|
|
test entry-8.14 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcde
|
|
.e icursor 4
|
|
.e delete 4 6
|
|
.e index insert
|
|
} {4}
|
|
test entry-8.15 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 "This is a very long string"
|
|
.e xview 4
|
|
.e delete 1 4
|
|
.e index @0
|
|
} {1}
|
|
test entry-8.16 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 "This is a very long string"
|
|
.e xview 4
|
|
.e delete 1 5
|
|
.e index @0
|
|
} {1}
|
|
test entry-8.17 {DeleteChars procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 "This is a very long string"
|
|
.e xview 4
|
|
.e delete 4 6
|
|
.e index @0
|
|
} {4}
|
|
.e configure -width 0
|
|
test entry-8.18 {DeleteChars procedure} {fonts} {
|
|
.e delete 0 end
|
|
.e insert 0 "xyzzy"
|
|
update
|
|
.e delete 2 4
|
|
winfo reqwidth .e
|
|
} {31}
|
|
|
|
test entry-9.1 {EntryValueChanged procedure} {
|
|
catch {destroy .e}
|
|
proc override args {
|
|
global x
|
|
set x 12345
|
|
}
|
|
catch {unset x}
|
|
trace variable x w override
|
|
entry .e -textvariable x
|
|
.e insert 0 foo
|
|
set result [list $x [.e get]]
|
|
unset x; rename override {}
|
|
set result
|
|
} {12345 12345}
|
|
|
|
catch {destroy .e}
|
|
entry .e
|
|
pack .e
|
|
.e configure -width 0
|
|
test entry-10.1 {EntrySetValue procedure} {fonts} {
|
|
set x abcde
|
|
set y ab
|
|
.e configure -textvariable x
|
|
update
|
|
.e configure -textvariable y
|
|
update
|
|
list [.e get] [winfo reqwidth .e]
|
|
} {ab 24}
|
|
test entry-10.2 {EntrySetValue procedure, updating selection} {
|
|
catch {destroy .e}
|
|
entry .e -textvariable x
|
|
.e insert 0 "abcdefghjklmnopqrstu"
|
|
.e selection range 4 10
|
|
set x "a"
|
|
list [catch {.e index sel.first} msg] $msg
|
|
} {1 {selection isn't in widget .e}}
|
|
test entry-10.3 {EntrySetValue procedure, updating selection} {
|
|
catch {destroy .e}
|
|
entry .e -textvariable x
|
|
.e insert 0 "abcdefghjklmnopqrstu"
|
|
.e selection range 4 10
|
|
set x "abcdefg"
|
|
list [.e index sel.first] [.e index sel.last]
|
|
} {4 7}
|
|
test entry-10.4 {EntrySetValue procedure, updating selection} {
|
|
catch {destroy .e}
|
|
entry .e -textvariable x
|
|
.e insert 0 "abcdefghjklmnopqrstu"
|
|
.e selection range 4 10
|
|
set x "abcdefghijklmn"
|
|
list [.e index sel.first] [.e index sel.last]
|
|
} {4 10}
|
|
test entry-10.5 {EntrySetValue procedure, updating display position} {
|
|
catch {destroy .e}
|
|
entry .e -width 10 -font $fixed -textvariable x
|
|
pack .e
|
|
.e insert 0 "abcdefghjklmnopqrstuvwxyz"
|
|
.e xview 10
|
|
update
|
|
set x "abcdefg"
|
|
update
|
|
.e index @0
|
|
} {0}
|
|
test entry-10.6 {EntrySetValue procedure, updating display position} {
|
|
catch {destroy .e}
|
|
entry .e -width 10 -font $fixed -textvariable x
|
|
pack .e
|
|
.e insert 0 "abcdefghjklmnopqrstuvwxyz"
|
|
.e xview 10
|
|
update
|
|
set x "1234567890123456789012"
|
|
update
|
|
.e index @0
|
|
} {10}
|
|
test entry-10.7 {EntrySetValue procedure, updating insertion cursor} {
|
|
catch {destroy .e}
|
|
entry .e -width 10 -font $fixed -textvariable x
|
|
pack .e
|
|
.e insert 0 "abcdefghjklmnopqrstuvwxyz"
|
|
.e icursor 5
|
|
set x "123"
|
|
.e index insert
|
|
} {3}
|
|
test entry-10.8 {EntrySetValue procedure, updating insertion cursor} {
|
|
catch {destroy .e}
|
|
entry .e -width 10 -font $fixed -textvariable x
|
|
pack .e
|
|
.e insert 0 "abcdefghjklmnopqrstuvwxyz"
|
|
.e icursor 5
|
|
set x "123456"
|
|
.e index insert
|
|
} {5}
|
|
|
|
test entry-11.1 {EntryEventProc procedure} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
.e insert 0 abcdefg
|
|
destroy .e
|
|
update
|
|
} {}
|
|
test entry-11.2 {EntryEventProc procedure} {
|
|
deleteWindows
|
|
entry .e1 -fg #112233
|
|
rename .e1 .e2
|
|
set x {}
|
|
lappend x [winfo children .]
|
|
lappend x [.e2 cget -fg]
|
|
destroy .e1
|
|
lappend x [info command .e*] [winfo children .]
|
|
} {.e1 #112233 {} {}}
|
|
|
|
test entry-12.1 {EntryCmdDeletedProc procedure} {
|
|
deleteWindows
|
|
button .e1 -text "xyz_123"
|
|
rename .e1 {}
|
|
list [info command .e*] [winfo children .]
|
|
} {{} {}}
|
|
|
|
catch {destroy .e}
|
|
entry .e -font $fixed -width 5 -bd 2 -relief sunken
|
|
pack .e
|
|
.e insert 0 012345678901234567890
|
|
.e xview 4
|
|
update
|
|
test entry-13.1 {GetEntryIndex procedure} {
|
|
.e index end
|
|
} {21}
|
|
test entry-13.2 {GetEntryIndex procedure} {
|
|
list [catch {.e index abogus} msg] $msg
|
|
} {1 {bad entry index "abogus"}}
|
|
test entry-13.3 {GetEntryIndex procedure} {
|
|
.e select from 1
|
|
.e select to 6
|
|
.e index anchor
|
|
} {1}
|
|
test entry-13.4 {GetEntryIndex procedure} {
|
|
.e select from 4
|
|
.e select to 1
|
|
.e index anchor
|
|
} {4}
|
|
test entry-13.5 {GetEntryIndex procedure} {
|
|
.e select from 3
|
|
.e select to 15
|
|
.e select adjust 4
|
|
.e index anchor
|
|
} {15}
|
|
test entry-13.6 {GetEntryIndex procedure} {
|
|
list [catch {.e index ebogus} msg] $msg
|
|
} {1 {bad entry index "ebogus"}}
|
|
test entry-13.7 {GetEntryIndex procedure} {
|
|
.e icursor 2
|
|
.e index insert
|
|
} {2}
|
|
test entry-13.8 {GetEntryIndex procedure} {
|
|
list [catch {.e index ibogus} msg] $msg
|
|
} {1 {bad entry index "ibogus"}}
|
|
test entry-13.9 {GetEntryIndex procedure} {
|
|
.e select from 1
|
|
.e select to 6
|
|
list [.e index sel.first] [.e index sel.last]
|
|
} {1 6}
|
|
selection clear .e
|
|
test entry-13.10 {GetEntryIndex procedure} unix {
|
|
# On unix, when selection is cleared, entry widget's internal
|
|
# selection range is reset.
|
|
|
|
list [catch {.e index sel.first} msg] $msg
|
|
} {1 {selection isn't in widget .e}}
|
|
test entry-13.11 {GetEntryIndex procedure} win {
|
|
# On mac and pc, when selection is cleared, entry widget remembers
|
|
# last selected range. When selection ownership is restored to
|
|
# entry, the old range will be rehighlighted.
|
|
|
|
list [catch {selection get}] [.e index sel.first]
|
|
} {1 1}
|
|
test entry-13.12 {GetEntryIndex procedure} unix {
|
|
list [catch {.e index sbogus} msg] $msg
|
|
} {1 {selection isn't in widget .e}}
|
|
test entry-13.13 {GetEntryIndex procedure} win {
|
|
list [catch {.e index sbogus} msg] $msg
|
|
} {1 {bad entry index "sbogus"}}
|
|
test entry-13.14 {GetEntryIndex procedure} win {
|
|
list [catch {selection get}] [catch {.e index sbogus}]
|
|
} {1 1}
|
|
test entry-13.15 {GetEntryIndex procedure} {
|
|
list [catch {.e index @xyz} msg] $msg
|
|
} {1 {bad entry index "@xyz"}}
|
|
test entry-13.16 {GetEntryIndex procedure} {fonts} {
|
|
.e index @4
|
|
} {4}
|
|
test entry-13.17 {GetEntryIndex procedure} {fonts} {
|
|
.e index @11
|
|
} {4}
|
|
test entry-13.18 {GetEntryIndex procedure} {fonts} {
|
|
.e index @12
|
|
} {5}
|
|
test entry-13.19 {GetEntryIndex procedure} {fonts} {
|
|
.e index @[expr [winfo width .e] - 6]
|
|
} {8}
|
|
test entry-13.20 {GetEntryIndex procedure} {fonts} {
|
|
.e index @[expr [winfo width .e] - 5]
|
|
} {9}
|
|
test entry-13.21 {GetEntryIndex procedure} {
|
|
.e index @1000
|
|
} {9}
|
|
test entry-13.22 {GetEntryIndex procedure} {
|
|
list [catch {.e index 1xyz} msg] $msg
|
|
} {1 {bad entry index "1xyz"}}
|
|
test entry-13.23 {GetEntryIndex procedure} {
|
|
.e index -10
|
|
} {0}
|
|
test entry-13.24 {GetEntryIndex procedure} {
|
|
.e index 12
|
|
} {12}
|
|
test entry-13.25 {GetEntryIndex procedure} {
|
|
.e index 49
|
|
} {21}
|
|
test entry-13.26 {GetEntryIndex procedure} {fonts} {
|
|
catch {destroy .e}
|
|
entry .e -show .
|
|
.e insert 0 XXXYZZY
|
|
pack .e
|
|
update
|
|
list [.e index @7] [.e index @8]
|
|
} {0 1}
|
|
|
|
# XXX Still need to write tests for EntryScanTo and EntrySelectTo.
|
|
|
|
set x {}
|
|
for {set i 1} {$i <= 500} {incr i} {
|
|
append x "This is line $i, out of 500\n"
|
|
}
|
|
test entry-14.1 {EntryFetchSelection procedure} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
.e insert end "This is a test string"
|
|
.e select from 1
|
|
.e select to 18
|
|
selection get
|
|
} {his is a test str}
|
|
test entry-14.2 {EntryFetchSelection procedure} {
|
|
catch {destroy .e}
|
|
entry .e -show *
|
|
.e insert end "This is a test string"
|
|
.e select from 1
|
|
.e select to 18
|
|
selection get
|
|
} {*****************}
|
|
test entry-14.3 {EntryFetchSelection procedure} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
.e insert end $x
|
|
.e select from 0
|
|
.e select to end
|
|
string compare [selection get] $x
|
|
} 0
|
|
|
|
test entry-15.1 {EntryLostSelection} {
|
|
catch {destroy .e}
|
|
entry .e
|
|
.e insert 0 "Text"
|
|
.e select from 0
|
|
.e select to 4
|
|
set result [selection get]
|
|
selection clear
|
|
.e select from 0
|
|
.e select to 4
|
|
lappend result [selection get]
|
|
} {Text Text}
|
|
|
|
# No tests for EventuallyRedraw.
|
|
|
|
catch {destroy .e}
|
|
entry .e -width 10 -xscrollcommand scroll
|
|
pack .e
|
|
update
|
|
|
|
test entry-16.1 {EntryVisibleRange procedure} {fonts} {
|
|
.e delete 0 end
|
|
.e insert 0 .............................
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.000000 0.827586}
|
|
test entry-16.2 {EntryVisibleRange procedure} {unix fonts} {
|
|
.e configure -show X
|
|
.e delete 0 end
|
|
.e insert 0 .............................
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.000000 0.275862}
|
|
test entry-16.3 {EntryVisibleRange procedure} win {
|
|
.e configure -show .
|
|
.e delete 0 end
|
|
.e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.000000 0.827586}
|
|
.e configure -show ""
|
|
test entry-16.4 {EntryVisibleRange procedure} {
|
|
.e delete 0 end
|
|
format {%.6f %.6f} {*}[.e xview]
|
|
} {0.000000 1.000000}
|
|
|
|
catch {destroy .e}
|
|
entry .e -width 10 -xscrollcommand scroll -font $fixed
|
|
pack .e
|
|
update
|
|
test entry-17.1 {EntryUpdateScrollbar procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 123
|
|
update
|
|
format {%.6f %.6f} {*}$scrollInfo
|
|
} {0.000000 1.000000}
|
|
test entry-17.2 {EntryUpdateScrollbar procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 0123456789abcdef
|
|
.e xview 3
|
|
update
|
|
format {%.6f %.6f} {*}$scrollInfo
|
|
} {0.187500 0.812500}
|
|
test entry-17.3 {EntryUpdateScrollbar procedure} {
|
|
.e delete 0 end
|
|
.e insert 0 abcdefghijklmnopqrs
|
|
.e xview 6
|
|
update
|
|
format {%.6f %.6f} {*}$scrollInfo
|
|
} {0.315789 0.842105}
|
|
test entry-17.4 {EntryUpdateScrollbar procedure} {
|
|
destroy .e
|
|
proc bgerror msg {
|
|
global x
|
|
set x $msg
|
|
}
|
|
entry .e -width 5 -xscrollcommand thisisnotacommand
|
|
pack .e
|
|
update
|
|
rename bgerror {}
|
|
list $x $errorInfo
|
|
} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand"
|
|
while executing
|
|
"thisisnotacommand 0.0 1.0"
|
|
(horizontal scrolling command executed by .e)}}
|
|
|
|
set l [interp hidden]
|
|
deleteWindows
|
|
|
|
test entry-18.1 {Entry widget vs hiding} {
|
|
destroy .e
|
|
entry .e
|
|
interp hide {} .e
|
|
destroy .e
|
|
list [winfo children .] [interp hidden]
|
|
} [list {} $l]
|
|
|
|
##
|
|
## Entry widget VALIDATION tests
|
|
##
|
|
|
|
destroy .e
|
|
catch {unset ::e}
|
|
catch {unset ::vVals}
|
|
entry .e -validate all \
|
|
-validatecommand [list doval %W %d %i %P %s %S %v %V] \
|
|
-invalidcommand bell \
|
|
-textvariable ::e \
|
|
-background red -foreground white
|
|
pack .e
|
|
proc doval {W d i P s S v V} {
|
|
set ::vVals [list $W $d $i $P $s $S $v $V]
|
|
return 1
|
|
}
|
|
|
|
# The validation tests build each one upon the previous, so cascading
|
|
# failures aren't good
|
|
#
|
|
test entry-19.1 {entry widget validation} {
|
|
.e insert 0 a
|
|
set ::vVals
|
|
} {.e 1 0 a {} a all key}
|
|
test entry-19.2 {entry widget validation} {
|
|
.e insert 1 b
|
|
set ::vVals
|
|
} {.e 1 1 ab a b all key}
|
|
test entry-19.3 {entry widget validation} {
|
|
.e insert end c
|
|
set ::vVals
|
|
} {.e 1 2 abc ab c all key}
|
|
test entry-19.4 {entry widget validation} {
|
|
.e insert 1 123
|
|
list $::vVals $::e
|
|
} {{.e 1 1 a123bc abc 123 all key} a123bc}
|
|
test entry-19.5 {entry widget validation} {
|
|
.e delete 2
|
|
set ::vVals
|
|
} {.e 0 2 a13bc a123bc 2 all key}
|
|
test entry-19.6 {entry widget validation} {
|
|
.e configure -validate key
|
|
.e delete 1 3
|
|
set ::vVals
|
|
} {.e 0 1 abc a13bc 13 key key}
|
|
test entry-19.7 {entry widget validation} {
|
|
set ::vVals {}
|
|
.e configure -validate focus
|
|
.e insert end d
|
|
set ::vVals
|
|
} {}
|
|
test entry-19.8 {entry widget validation} {
|
|
focus -force .e
|
|
# update necessary to process FocusIn event
|
|
update
|
|
set ::vVals
|
|
} {.e -1 -1 abcd abcd {} focus focusin}
|
|
test entry-19.9 {entry widget validation} {
|
|
focus -force .
|
|
# update necessary to process FocusOut event
|
|
update
|
|
set ::vVals
|
|
} {.e -1 -1 abcd abcd {} focus focusout}
|
|
.e configure -validate all
|
|
test entry-19.10 {entry widget validation} {
|
|
focus -force .e
|
|
# update necessary to process FocusIn event
|
|
update
|
|
set ::vVals
|
|
} {.e -1 -1 abcd abcd {} all focusin}
|
|
test entry-19.11 {entry widget validation} {
|
|
focus -force .
|
|
# update necessary to process FocusOut event
|
|
update
|
|
set ::vVals
|
|
} {.e -1 -1 abcd abcd {} all focusout}
|
|
.e configure -validate focusin
|
|
test entry-19.12 {entry widget validation} {
|
|
focus -force .e
|
|
# update necessary to process FocusIn event
|
|
update
|
|
set ::vVals
|
|
} {.e -1 -1 abcd abcd {} focusin focusin}
|
|
test entry-19.13 {entry widget validation} {
|
|
set ::vVals {}
|
|
focus -force .
|
|
# update necessary to process FocusOut event
|
|
update
|
|
set ::vVals
|
|
} {}
|
|
.e configure -validate focuso
|
|
test entry-19.14 {entry widget validation} {
|
|
focus -force .e
|
|
# update necessary to process FocusIn event
|
|
update
|
|
set ::vVals
|
|
} {}
|
|
test entry-19.15 {entry widget validation} {
|
|
focus -force .
|
|
# update necessary to process FocusOut event
|
|
update
|
|
set ::vVals
|
|
} {.e -1 -1 abcd abcd {} focusout focusout}
|
|
test entry-19.16 {entry widget validation} {
|
|
list [.e validate] $::vVals
|
|
} {1 {.e -1 -1 abcd abcd {} all forced}}
|
|
test entry-19.17 {entry widget validation} {
|
|
set ::e newdata
|
|
list [.e cget -validate] $::vVals
|
|
} {focusout {.e -1 -1 newdata abcd {} focusout forced}}
|
|
|
|
proc doval {W d i P s S v V} {
|
|
set ::vVals [list $W $d $i $P $s $S $v $V]
|
|
return 0
|
|
}
|
|
|
|
test entry-19.18 {entry widget validation} {
|
|
.e configure -validate all
|
|
set ::e nextdata
|
|
list [.e cget -validate] $::vVals
|
|
} {none {.e -1 -1 nextdata newdata {} all forced}}
|
|
|
|
proc doval {W d i P s S v V} {
|
|
set ::vVals [list $W $d $i $P $s $S $v $V]
|
|
set ::e mydata
|
|
return 1
|
|
}
|
|
|
|
## This sets validate to none because it shows that we prevent a possible
|
|
## loop condition in the validation, when the entry textvar is also set
|
|
test entry-19.19 {entry widget validation} {
|
|
.e configure -validate all
|
|
.e validate
|
|
list [.e cget -validate] [.e get] $::vVals
|
|
} {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
|
|
|
|
## This leaves validate alone because we trigger validation through the
|
|
## textvar (a write trace), and the write during validation triggers
|
|
## nothing (by definition of avoiding loops on var traces). This is
|
|
## one of those "dangerous" conditions where the user will have a
|
|
## different value in the entry widget shown as is in the textvar.
|
|
test entry-19.20 {entry widget validation} {
|
|
.e configure -validate all
|
|
set ::e testdata
|
|
list [.e cget -validate] [.e get] $::e $::vVals
|
|
} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
|
|
|
|
destroy .e
|
|
catch {unset ::e ::vVals}
|
|
|
|
##
|
|
## End validation tests
|
|
##
|
|
|
|
test entry-20.1 {widget deletion while active} {
|
|
destroy .e
|
|
entry .e -validate all \
|
|
-validatecommand { destroy %W ; return 1 } \
|
|
-invalidcommand bell
|
|
update
|
|
.e insert 0 abc
|
|
winfo exists .e
|
|
} 0
|
|
test entry-20.2 {widget deletion while active} {
|
|
destroy .e
|
|
entry .e -validate all \
|
|
-validatecommand { return 0 } \
|
|
-invalidcommand { destroy %W }
|
|
.e insert 0 abc
|
|
winfo exists .e
|
|
} 0
|
|
test entry-20.3 {widget deletion while active} {
|
|
destroy .e
|
|
entry .e -validate all \
|
|
-validatecommand { rename .e {} ; return 1 }
|
|
.e insert 0 abc
|
|
winfo exists .e
|
|
} 0
|
|
test entry-20.4 {widget deletion while active} {
|
|
destroy .e
|
|
entry .e -validate all \
|
|
-validatecommand { return 0 } \
|
|
-invalidcommand { rename .e {} }
|
|
.e insert 0 abc
|
|
winfo exists .e
|
|
} 0
|
|
test entry-20.5 {widget deletion while active} {
|
|
destroy .e
|
|
entry .e -validatecommand { destroy .e ; return 0 }
|
|
.e validate
|
|
winfo exists .e
|
|
} 0
|
|
test entry-20.6 {widget deletion while active} {
|
|
destroy .e
|
|
pack [entry .e]
|
|
update
|
|
.e config -xscrollcommand { destroy .e }
|
|
update idle
|
|
winfo exists .e
|
|
} 0
|
|
test entry-20.7 {widget deletion with textvariable active} {
|
|
# SF bugs 607390 and 617446
|
|
destroy .e
|
|
set FOO init
|
|
entry .e -textvariable FOO -validate all \
|
|
-vcmd {%W configure -bg white; format 1}
|
|
bind .e <Destroy> { set FOO hello }
|
|
destroy .e
|
|
winfo exists .e
|
|
} 0
|
|
|
|
test entry-21.1 {selection present while disabled, bug 637828} {
|
|
destroy .e
|
|
entry .e
|
|
.e insert end 0123456789
|
|
.e select from 3
|
|
.e select to 6
|
|
set out [.e selection present]
|
|
.e configure -state disabled
|
|
# still return 1 when disabled, because 'selection get' will work,
|
|
# but selection cannot be changed (new behavior since 8.4)
|
|
.e select to 9
|
|
lappend out [.e selection present] [selection get]
|
|
} {1 1 345}
|
|
|
|
test entry-22.1 {lost namespaced textvar} {
|
|
destroy .e
|
|
namespace eval test { variable foo {a b} }
|
|
entry .e -textvariable ::test::foo
|
|
namespace delete test
|
|
catch {.e insert end "more stuff"} result1
|
|
catch {.e delete 5 end} result2
|
|
catch {set ::test::foo} result3
|
|
list [.e get] [.e cget -textvar] $result1 $result2 $result3
|
|
} [list "a bmo" ::test::foo \
|
|
{can't set "::test::foo": parent namespace doesn't exist} \
|
|
{can't set "::test::foo": parent namespace doesn't exist} \
|
|
{can't read "::test::foo": no such variable}]
|
|
|
|
test entry-23.1 {error in trace proc attached to the textvariable} {
|
|
destroy .e
|
|
trace variable myvar w traceit
|
|
proc traceit args {error "Intentional error here!"}
|
|
entry .e -textvariable myvar
|
|
catch {.e insert end mystring} result1
|
|
catch {.e delete 0} result2
|
|
list $result1 $result2
|
|
} [list {can't set "myvar": Intentional error here!} \
|
|
{can't set "myvar": Intentional error here!}]
|
|
|
|
test entry-24.1 {textvariable lives in a non-existing namespace} {
|
|
destroy .e
|
|
catch {entry .e -textvariable thisnsdoesntexist::myvar} result1
|
|
set result1
|
|
} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist}
|
|
|
|
destroy .e
|
|
|
|
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
|
|
# and EntryTextVarProc.
|
|
|
|
option clear
|
|
|
|
# cleanup
|
|
cleanupTests
|
|
return
|