427 lines
12 KiB
Plaintext
427 lines
12 KiB
Plaintext
# This file is a Tcl script to test out the "listbox" command
|
|
# of Tk. It is organized in the standard fashion for Tcl tests.
|
|
#
|
|
# Copyright (c) 1993 The Regents of the University of California.
|
|
# All rights reserved.
|
|
#
|
|
# Permission is hereby granted, without written agreement and without
|
|
# license or royalty fees, to use, copy, modify, and distribute this
|
|
# software and its documentation for any purpose, provided that the
|
|
# above copyright notice and the following two paragraphs appear in
|
|
# all copies of this software.
|
|
#
|
|
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
|
|
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
|
|
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
|
|
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
#
|
|
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
|
|
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
|
|
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
|
|
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
|
|
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
|
|
#
|
|
# $Header: /user6/ouster/wish/tests/RCS/listbox.test,v 1.3 93/04/24 14:03:10 ouster Exp $ (Berkeley)
|
|
|
|
if {[string compare test [info procs test]] == 1} then \
|
|
{source defs}
|
|
|
|
foreach i [winfo children .] {
|
|
destroy $i
|
|
}
|
|
wm geometry . {}
|
|
listbox .l -geometry 20x20 -bd 2 -relief raised
|
|
pack append . .l top
|
|
update
|
|
|
|
proc listboxGet {} {
|
|
set last [.l size]
|
|
set result {}
|
|
for {set i 0} {$i < $last} {incr i} {
|
|
lappend result [.l get $i]
|
|
}
|
|
return $result
|
|
}
|
|
|
|
test listbox-1.1 {insert widget command} {
|
|
listboxGet
|
|
} {}
|
|
.l insert end a b c {d e}
|
|
test listbox-1.2 {insert widget command} {
|
|
listboxGet
|
|
} {a b c {d e}}
|
|
.l i 1 x y
|
|
test listbox-1.3 {insert widget command} {
|
|
listboxGet
|
|
} {a x y b c {d e}}
|
|
.l insert end xx
|
|
test listbox-1.4 {insert widget command} {
|
|
listboxGet
|
|
} {a x y b c {d e} xx}
|
|
.l insert -2 early
|
|
test listbox-1.5 {insert widget command} {
|
|
listboxGet
|
|
} {early a x y b c {d e} xx}
|
|
.l insert 100 late
|
|
test listbox-1.6 {insert widget command} {
|
|
listboxGet
|
|
} {early a x y b c {d e} xx late}
|
|
test listbox-1.7 {insert widget command} {
|
|
list [catch {.l insert 1} msg] $msg [listboxGet]
|
|
} {0 {} {early a x y b c {d e} xx late}}
|
|
test listbox-1.8 {insert widget command} {
|
|
list [catch {.l insert} msg] $msg
|
|
} {1 {wrong # args: should be ".l insert index ?element element ...?"}}
|
|
test listbox-1.9 {insert widget command} {
|
|
list [catch {.l insert gorp} msg] $msg
|
|
} {1 {bad listbox index "gorp"}}
|
|
|
|
test listbox-2.1 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete 1
|
|
listboxGet
|
|
} {a c d e}
|
|
test listbox-2.2 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l d 1 3
|
|
listboxGet
|
|
} {a e}
|
|
test listbox-2.3 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete 3 end
|
|
listboxGet
|
|
} {a b c}
|
|
test listbox-2.4 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete end
|
|
listboxGet
|
|
} {a b c d}
|
|
test listbox-2.5 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete 0
|
|
listboxGet
|
|
} {b c d e}
|
|
test listbox-2.6 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete 3 2
|
|
listboxGet
|
|
} {a b c d e}
|
|
test listbox-2.7 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete -2 2
|
|
listboxGet
|
|
} {d e}
|
|
test listbox-2.8 {delete widget command} {
|
|
.l delete 0 end
|
|
.l insert 0 a b c d e
|
|
.l delete 1 1000
|
|
listboxGet
|
|
} {a}
|
|
test listbox-2.9 {delete widget command} {
|
|
.l delete 0 end
|
|
.l delete end
|
|
listboxGet
|
|
} {}
|
|
test listbox-2.10 {delete widget command} {
|
|
list [catch {.l delete} msg] $msg
|
|
} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
|
|
test listbox-2.11 {delete widget command} {
|
|
list [catch {.l delete 1 2 3} msg] $msg
|
|
} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
|
|
test listbox-2.12 {delete widget command} {
|
|
list [catch {.l delete eof} msg] $msg
|
|
} {1 {bad listbox index "eof"}}
|
|
|
|
.l delete 0 end
|
|
.l insert 0 el0 el1 el2 el3 el4
|
|
update
|
|
test listbox-3.1 {get widget command} {
|
|
.l get 0
|
|
} el0
|
|
test listbox-3.2 {get widget command} {
|
|
.l g 1
|
|
} el1
|
|
test listbox-3.3 {get widget command} {
|
|
.l get end
|
|
} el4
|
|
test listbox-3.4 {get widget command} {
|
|
.l get -2
|
|
} el0
|
|
test listbox-3.5 {get widget command} {
|
|
.l get 100
|
|
} el4
|
|
test listbox-3.6 {get widget command} {
|
|
list [catch {.l get} msg] $msg
|
|
} {1 {wrong # args: should be ".l get index"}}
|
|
test listbox-3.7 {get widget command} {
|
|
list [catch {.l get 1 2} msg] $msg
|
|
} {1 {wrong # args: should be ".l get index"}}
|
|
test listbox-3.8 {get widget command} {
|
|
list [catch {.l get junk} msg] $msg
|
|
} {1 {bad listbox index "junk"}}
|
|
|
|
.l delete 0 end
|
|
for {set i 0} {$i < 30} {incr i} {
|
|
.l insert end el$i
|
|
}
|
|
test listbox-4.1 {nearest widget command} {
|
|
.l n 0
|
|
} 0
|
|
test listbox-4.2 {nearest widget command} {
|
|
.l nearest [winfo height .l]
|
|
} 19
|
|
.l yview 5
|
|
test listbox-4.3 {nearest widget command} {
|
|
.l nearest 0
|
|
} 5
|
|
test listbox-4.4 {nearest widget command} {
|
|
.l nearest [winfo height .l]
|
|
} 24
|
|
test listbox-4.5 {nearest widget command} {
|
|
list [catch {.l nearest} msg] $msg
|
|
} {1 {wrong # args: should be ".l nearest y"}}
|
|
test listbox-4.6 {nearest widget command} {
|
|
list [catch {.l nearest 1 2} msg] $msg
|
|
} {1 {wrong # args: should be ".l nearest y"}}
|
|
test listbox-4.7 {nearest widget command} {
|
|
list [catch {.l nearest gorp} msg] $msg
|
|
} {1 {expected integer but got "gorp"}}
|
|
|
|
test listbox-5.1 {selections} {
|
|
.l curselection
|
|
} {}
|
|
test listbox-5.2 {selections} {
|
|
.l select clear
|
|
.l select from 1
|
|
.l curselection
|
|
} {1}
|
|
test listbox-5.3 {selections} {
|
|
.l select clear
|
|
.l select from end
|
|
.l curselection
|
|
} {29}
|
|
test listbox-5.4 {selections} {
|
|
.l select clear
|
|
.l select to 2
|
|
.l curselection
|
|
} {2}
|
|
test listbox-5.5 {selections} {
|
|
.l select clear
|
|
.l select from 23
|
|
.l select to end
|
|
.l curselection
|
|
} {23 24 25 26 27 28 29}
|
|
test listbox-5.6 {selections} {
|
|
.l select clear
|
|
.l select from 23
|
|
.l select to 20
|
|
.l curselection
|
|
} {20 21 22 23}
|
|
test listbox-5.7 {selections} {
|
|
.l select clear
|
|
.l select from 23
|
|
.l select to 28
|
|
.l select to 20
|
|
.l curselection
|
|
} {20 21 22 23}
|
|
test listbox-5.8 {selections} {
|
|
.l select clear
|
|
.l select from 5
|
|
.l select to 10
|
|
.l select adjust 12
|
|
.l curselection
|
|
} {5 6 7 8 9 10 11 12}
|
|
test listbox-5.9 {selections} {
|
|
.l select clear
|
|
.l select from 5
|
|
.l select to 10
|
|
.l select adjust 9
|
|
.l curselection
|
|
} {5 6 7 8 9}
|
|
test listbox-5.10 {selections} {
|
|
.l select c
|
|
.l select f 5
|
|
.l select t 10
|
|
.l select a 6
|
|
.l curselection
|
|
} {6 7 8 9 10}
|
|
test listbox-5.11 {selections} {
|
|
.l select clear
|
|
.l select from 5
|
|
.l select t 10
|
|
.l select adjust 3
|
|
.l curselection
|
|
} {3 4 5 6 7 8 9 10}
|
|
test listbox-5.12 {selections} {
|
|
.l select clear
|
|
.l select from 5
|
|
.l select to 10
|
|
.l select adjust 12
|
|
.l select adjust 7
|
|
.l curselection
|
|
} {7 8 9 10 11 12}
|
|
test listbox-5.13 {selections} {
|
|
.l select clear
|
|
.l select from 5
|
|
.l select to 10
|
|
.l select clear
|
|
.l curselection
|
|
} {}
|
|
test listbox-5.14 {selections} {
|
|
list [catch {.l select} msg] $msg
|
|
} {1 {too few args: should be ".l select option ?index?"}}
|
|
test listbox-5.15 {selections} {
|
|
list [catch {.l select adjust} msg] $msg
|
|
} {1 {wrong # args: should be ".l select option index"}}
|
|
test listbox-5.16 {selections} {
|
|
list [catch {.l select adjust 1 2} msg] $msg
|
|
} {1 {wrong # args: should be ".l select option index"}}
|
|
test listbox-5.17 {selections} {
|
|
list [catch {.l select adjust junk} msg] $msg
|
|
} {1 {bad listbox index "junk"}}
|
|
test listbox-5.18 {selections} {
|
|
list [catch {.l select clear 1} msg] $msg
|
|
} {1 {wrong # args: should be ".l select clear"}}
|
|
test listbox-5.19 {selections} {
|
|
list [catch {.l select from} msg] $msg
|
|
} {1 {wrong # args: should be ".l select option index"}}
|
|
test listbox-5.20 {selections} {
|
|
list [catch {.l select from 1 2} msg] $msg
|
|
} {1 {wrong # args: should be ".l select option index"}}
|
|
test listbox-5.21 {selections} {
|
|
list [catch {.l select from eof} msg] $msg
|
|
} {1 {bad listbox index "eof"}}
|
|
test listbox-5.22 {selections} {
|
|
list [catch {.l select to} msg] $msg
|
|
} {1 {wrong # args: should be ".l select option index"}}
|
|
test listbox-5.23 {selections} {
|
|
list [catch {.l select to 1 2} msg] $msg
|
|
} {1 {wrong # args: should be ".l select option index"}}
|
|
test listbox-5.24 {selections} {
|
|
list [catch {.l select to eof} msg] $msg
|
|
} {1 {bad listbox index "eof"}}
|
|
|
|
proc lbSelUpdateTest {cmd} {
|
|
.l delete 0 end
|
|
.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
|
|
.l select from 3
|
|
.l select to 6
|
|
uplevel $cmd
|
|
.l curselection
|
|
}
|
|
test listbox-6.1 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l delete 1}
|
|
} {2 3 4 5}
|
|
test listbox-6.2 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l delete 1 4}
|
|
} {1 2}
|
|
test listbox-6.3 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l delete 4}
|
|
} {3 4 5}
|
|
test listbox-6.4 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l delete 5 7}
|
|
} {3 4}
|
|
test listbox-6.5 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l delete end}
|
|
} {3 4 5 6}
|
|
test listbox-6.6 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l delete 1 7}
|
|
} {}
|
|
test listbox-6.7 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l insert 1 x}
|
|
} {4 5 6 7}
|
|
test listbox-6.8 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l insert 3 x y}
|
|
} {5 6 7 8}
|
|
test listbox-6.9 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l insert 4 x}
|
|
} {3 4 5 6 7}
|
|
test listbox-6.10 {selections and inserts/deletes} {
|
|
lbSelUpdateTest {.l insert 7 x y}
|
|
} {3 4 5 6}
|
|
|
|
catch {unset x}
|
|
set x {}
|
|
test listbox-7.1 {-exportselection option} {
|
|
selection clear .
|
|
.l select from 1
|
|
lappend x [catch {selection get} msg] $msg [.l curselection]
|
|
.l config -exportselection 0
|
|
lappend x [catch {selection get} msg] $msg [.l curselection]
|
|
.l select clear
|
|
lappend x [catch {selection get} msg] $msg [.l curselection]
|
|
.l select from 1
|
|
.l select to 3
|
|
lappend x [catch {selection get} msg] $msg [.l curselection]
|
|
.l config -exportselection 1
|
|
lappend x [catch {selection get} msg] $msg [.l curselection]
|
|
} {0 el1 1 1 {selection doesn't exist or form "STRING" not defined} 1 1 {selection doesn't exist or form "STRING" not defined} {} 1 {selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 el2 el3} {1 2 3}}
|
|
test list-7.2 {-exportselection option} {
|
|
.l select from 1
|
|
.l select to 3
|
|
selection clear .
|
|
list [catch {selection get} msg] $msg [.l curselection]
|
|
} {1 {selection doesn't exist or form "STRING" not defined} {}}
|
|
|
|
.l delete 0 end
|
|
for {set i 0} {$i < 30} {incr i} {
|
|
.l insert end el$i
|
|
}
|
|
test list-8.1 {yview widget command} {
|
|
.l yview 0
|
|
.l nearest 0
|
|
} 0
|
|
test list-8.2 {yview widget command} {
|
|
.l yview end
|
|
.l nearest 0
|
|
} 29
|
|
test list-8.3 {yview widget command} {
|
|
.l yview 5
|
|
.l nearest 0
|
|
} 5
|
|
test list-8.4 {yview widget command} {
|
|
.l yview 5
|
|
.l delete 1 3
|
|
.l nearest 0
|
|
} 2
|
|
test list-8.5 {yview widget command} {
|
|
.l yview 5
|
|
.l delete 5 8
|
|
.l nearest 0
|
|
} 5
|
|
test list-8.6 {yview widget command} {
|
|
.l yview 5
|
|
.l delete 10
|
|
.l nearest 0
|
|
} 5
|
|
test list-8.6 {yview widget command} {
|
|
list [catch {.l yview} msg] $msg
|
|
} {1 {wrong # args: should be ".l yview index"}}
|
|
test list-8.7 {yview widget command} {
|
|
list [catch {.l yview 1 2} msg] $msg
|
|
} {1 {wrong # args: should be ".l yview index"}}
|
|
test list-8.8 {yview widget command} {
|
|
list [catch {.l yview junk} msg] $msg
|
|
} {1 {bad listbox index "junk"}}
|
|
|
|
test listbox-9.1 {miscellaneous} {
|
|
list [catch {.l} msg] $msg
|
|
} {1 {wrong # args: should be ".l option ?arg arg ...?"}}
|
|
test listbox-9.2 {miscellaneous} {
|
|
list [catch {.l junk} msg] $msg
|
|
} {1 {bad option "junk": must be configure, curselection, delete, get, insert, nearest, scan, select, size, xview, or yview}}
|
|
test listbox-9.3 {miscellaneous} {
|
|
list [catch {.l s} msg] $msg
|
|
} {1 {bad option "s": must be configure, curselection, delete, get, insert, nearest, scan, select, size, xview, or yview}}
|
|
destroy .l
|
|
test listbox-9.4 {miscellaneous} {
|
|
list [catch {.l} msg] $msg
|
|
} {1 {invalid command name ".l"}}
|