diff options
Diffstat (limited to 'tk8.6/tests/raise.test')
| -rw-r--r-- | tk8.6/tests/raise.test | 320 |
1 files changed, 0 insertions, 320 deletions
diff --git a/tk8.6/tests/raise.test b/tk8.6/tests/raise.test deleted file mode 100644 index 461ccbf..0000000 --- a/tk8.6/tests/raise.test +++ /dev/null @@ -1,320 +0,0 @@ -# This file is a Tcl script to test out Tk's "raise" and -# "lower" commands, plus associated code to manage window -# stacking order. It is organized in the standard fashion -# for Tcl tests. -# -# Copyright (c) 1993-1994 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. - -package require tcltest 2.2 -eval tcltest::configure $argv -tcltest::loadTestedCommands -namespace import -force tcltest::test - -# Procedure to create a bunch of overlapping windows, which should -# make it easy to detect differences in order. - -proc raise_setup {} { - foreach i [winfo child .raise] { - destroy $i - } - foreach i {a b c d e} { - label .raise.$i -text $i -relief raised -bd 2 - } - place .raise.a -x 20 -y 60 -width 60 -height 80 - place .raise.b -x 60 -y 60 -width 60 -height 80 - place .raise.c -x 100 -y 60 -width 60 -height 80 - place .raise.d -x 40 -y 20 -width 100 -height 60 - place .raise.e -x 40 -y 120 -width 100 -height 60 -} - -# Procedure to return information about which windows are on top -# of which other windows. - -proc raise_getOrder {} { - set x [winfo rootx .raise] - set y [winfo rooty .raise] - list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \ - [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \ - [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \ - [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \ - [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \ - [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \ - [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \ - [winfo name [winfo containing [expr $x+130] [expr $y+130]]] -} - -# Procedure to set up a collection of top-level windows - -proc raise_makeToplevels {} { - deleteWindows - foreach i {.raise1 .raise2 .raise3} { - toplevel $i - wm geom $i 150x100+0+0 - update - } -} - -toplevel .raise -wm geom .raise 250x200+0+0 - - -test raise-1.1 {preserve creation order} -body { - raise_setup - tkwait visibility .raise.e - raise_getOrder -} -result {d d d b c e e e} -test raise-1.2 {preserve creation order} -constraints testmakeexist -body { - raise_setup - testmakeexist .raise.a - update - raise_getOrder -} -result {d d d b c e e e} -test raise-1.3 {preserve creation order} -constraints testmakeexist -body { - raise_setup - testmakeexist .raise.c - update - raise_getOrder -} -result {d d d b c e e e} -test raise-1.4 {preserve creation order} -constraints testmakeexist -body { - raise_setup - testmakeexist .raise.e - update - raise_getOrder -} -result {d d d b c e e e} -test raise-1.5 {preserve creation order} -constraints testmakeexist -body { - raise_setup - testmakeexist .raise.d .raise.c .raise.b - update - raise_getOrder -} -result {d d d b c e e e} - - -test raise-2.1 {raise internal windows before creation} -body { - raise_setup - raise .raise.a - update - raise_getOrder -} -result {a d d a c a e e} -test raise-2.2 {raise internal windows before creation} -body { - raise_setup - raise .raise.c - update - raise_getOrder -} -result {d d c b c e e c} -test raise-2.3 {raise internal windows before creation} -body { - raise_setup - raise .raise.e - update - raise_getOrder -} -result {d d d b c e e e} -test raise-2.4 {raise internal windows before creation} -body { - raise_setup - raise .raise.e .raise.a - update - raise_getOrder -} -result {d d d b c e b c} -test raise-2.5 {raise internal windows before creation} -body { - raise_setup - raise .raise.a .raise.d - update - raise_getOrder -} -result {a d d a c e e e} - - -test raise-3.1 {raise internal windows after creation} -body { - raise_setup - update - raise .raise.a .raise.d - raise_getOrder -} -result {a d d a c e e e} -test raise-3.2 {raise internal windows after creation} -constraints { - testmakeexist -} -body { - raise_setup - testmakeexist .raise.a .raise.b - raise .raise.a .raise.b - update - raise_getOrder -} -result {d d d a c e e e} -test raise-3.3 {raise internal windows after creation} -constraints { - testmakeexist -} -body { - raise_setup - testmakeexist .raise.a .raise.d - raise .raise.a .raise.b - update - raise_getOrder -} -result {d d d a c e e e} -test raise-3.4 {raise internal windows after creation} -constraints { - testmakeexist -} -body { - raise_setup - testmakeexist .raise.a .raise.c .raise.d - raise .raise.a .raise.b - update - raise_getOrder -} -result {d d d a c e e e} - - -test raise-4.1 {raise relative to nephews} -body { - raise_setup - update - frame .raise.d.child - raise .raise.a .raise.d.child - raise_getOrder -} -result {a d d a c e e e} -test raise-4.2 {raise relative to nephews} -setup { - destroy .raise2 -} -body { - raise_setup - update - frame .raise2 - raise .raise.a .raise2 -} -cleanup { - destroy .raise2 -} -returnCodes error -result {can't raise ".raise.a" above ".raise2"} - - -test raise-5.1 {lower internal windows} -body { - raise_setup - update - lower .raise.d - raise_getOrder -} -result {a b c b c e e e} -test raise-5.2 {lower internal windows} -body { - raise_setup - update - lower .raise.d .raise.b - raise_getOrder -} -result {d b c b c e e e} -test raise-5.3 {lower internal windows} -body { - raise_setup - update - lower .raise.a .raise.e - raise_getOrder -} -result {a d d a c e e e} -test raise-5.4 {lower internal windows} -setup { - destroy .raise2 -} -body { - raise_setup - update - frame .raise2 - lower .raise.a .raise2 -} -cleanup { - destroy .raise2 -} -returnCodes error -result {can't lower ".raise.a" below ".raise2"} - - -test raise-6.1 {raise/lower toplevel windows} -constraints { - nonPortable -} -body { - raise_makeToplevels - update - raise .raise1 - winfo containing [winfo rootx .raise1] [winfo rooty .raise1] -} -result {.raise1} -test raise-6.2 {raise/lower toplevel windows} -constraints { - nonPortable -} -body { - raise_makeToplevels - update - raise .raise2 - winfo containing [winfo rootx .raise1] [winfo rooty .raise1] -} -result {.raise2} -test raise-6.3 {raise/lower toplevel windows} -constraints { - nonPortable -} -body { - raise_makeToplevels - update - raise .raise3 - raise .raise2 - raise .raise1 .raise3 - set result [winfo containing [winfo rootx .raise1] \ - [winfo rooty .raise1]] - destroy .raise2 - update - after 500 - list $result [winfo containing [winfo rootx .raise1] \ - [winfo rooty .raise1]] -} -result {.raise2 .raise1} -test raise-6.4 {raise/lower toplevel windows} -constraints { - nonPortable -} -body { - raise_makeToplevels - update - raise .raise2 - raise .raise1 - lower .raise3 .raise1 - set result [winfo containing [winfo rootx .raise1] \ - [winfo rooty .raise1]] - wm geometry .raise2 +30+30 - wm geometry .raise1 +60+60 - destroy .raise1 - update - after 500 - list $result [winfo containing [winfo rootx .raise2] \ - [winfo rooty .raise2]] -} -result {.raise1 .raise3} -test raise-6.5 {raise/lower toplevel windows} -constraints { - nonPortable -} -body { - raise_makeToplevels - raise .raise1 - set time [lindex [time {raise .raise1}] 0] - expr {$time < 2000000} -} -result 1 -test raise-6.6 {raise/lower toplevel windows} -constraints { - nonPortable -} -body { - raise_makeToplevels - update - raise .raise2 - raise .raise1 - raise .raise3 - frame .raise1.f1 - frame .raise1.f1.f2 - lower .raise3 .raise1.f1.f2 - set result [winfo containing [winfo rootx .raise1] \ - [winfo rooty .raise1]] - destroy .raise1 - update - after 500 - list $result [winfo containing [winfo rootx .raise2] \ - [winfo rooty .raise2]] -} -result {.raise1 .raise3} - - -test raise-7.1 {errors in raise/lower commands} -body { - raise -} -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} -test raise-7.2 {errors in raise/lower commands} -body { - raise a b c -} -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} -test raise-7.3 {errors in raise/lower commands} -body { - raise badName -} -returnCodes error -result {bad window path name "badName"} -test raise-7.4 {errors in raise/lower commands} -body { - raise . badName2 -} -returnCodes error -result {bad window path name "badName2"} -test raise-7.5 {errors in raise/lower commands} -body { - lower -} -returnCodes error -result {wrong # args: should be "lower window ?belowThis?"} -test raise-7.6 {errors in raise/lower commands} -body { - lower a b c -} -returnCodes error -result {wrong # args: should be "lower window ?belowThis?"} -test raise-7.7 {errors in raise/lower commands} -body { - lower badName3 -} -returnCodes error -result {bad window path name "badName3"} -test raise-7.8 {errors in raise/lower commands} -body { - lower . badName4 -} -returnCodes error -result {bad window path name "badName4"} - -deleteWindows - -# cleanup -cleanupTests -return - |