summaryrefslogtreecommitdiffstats
path: root/tests/raise.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/raise.test')
-rw-r--r--tests/raise.test299
1 files changed, 299 insertions, 0 deletions
diff --git a/tests/raise.test b/tests/raise.test
new file mode 100644
index 0000000..af13746
--- /dev/null
+++ b/tests/raise.test
@@ -0,0 +1,299 @@
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) raise.test 1.8 96/02/16 10:55:18
+
+if {[info commands testmakeexist] == {}} {
+ puts "This application hasn't been compiled with the \"testmakeexist\""
+ puts "command, so I can't run this test. Are you sure you're using"
+ puts "tktest instead of wish?"
+ return
+}
+
+if {[string compare test [info procs test]] == 1} then \
+ {source defs}
+
+# 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 {} {
+ foreach i [winfo child .] {
+ destroy $i
+ }
+ foreach i {.raise1 .raise2 .raise3} {
+ toplevel $i
+ wm geom $i 150x100+0+0
+ update
+ }
+}
+
+foreach i [winfo child .] {
+ destroy $i
+}
+toplevel .raise
+wm geom .raise 250x200+0+0
+
+test raise-1.1 {preserve creation order} {
+ raise_setup
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.2 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.a
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.3 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.c
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.4 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.e
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.5 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.d .raise.c .raise.b
+ update
+ raise_getOrder
+} {d d d b c e e e}
+
+test raise-2.1 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.a
+ update
+ raise_getOrder
+} {a d d a c a e e}
+test raise-2.2 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.c
+ update
+ raise_getOrder
+} {d d c b c e e c}
+test raise-2.3 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.e
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-2.4 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.e .raise.a
+ update
+ raise_getOrder
+} {d d d b c e b c}
+test raise-2.5 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.a .raise.d
+ update
+ raise_getOrder
+} {a d d a c e e e}
+
+test raise-3.1 {raise internal windows after creation} {
+ raise_setup
+ update
+ raise .raise.a .raise.d
+ raise_getOrder
+} {a d d a c e e e}
+test raise-3.2 {raise internal windows after creation} {
+ raise_setup
+ testmakeexist .raise.a .raise.b
+ raise .raise.a .raise.b
+ update
+ raise_getOrder
+} {d d d a c e e e}
+test raise-3.3 {raise internal windows after creation} {
+ raise_setup
+ testmakeexist .raise.a .raise.d
+ raise .raise.a .raise.b
+ update
+ raise_getOrder
+} {d d d a c e e e}
+test raise-3.4 {raise internal windows after creation} {
+ raise_setup
+ testmakeexist .raise.a .raise.c .raise.d
+ raise .raise.a .raise.b
+ update
+ raise_getOrder
+} {d d d a c e e e}
+
+test raise-4.1 {raise relative to nephews} {
+ raise_setup
+ update
+ frame .raise.d.child
+ raise .raise.a .raise.d.child
+ raise_getOrder
+} {a d d a c e e e}
+test raise-4.2 {raise relative to nephews} {
+ raise_setup
+ update
+ frame .raise2
+ list [catch {raise .raise.a .raise2} msg] $msg
+} {1 {can't raise ".raise.a" above ".raise2"}}
+catch {destroy .raise2}
+
+test raise-5.1 {lower internal windows} {
+ raise_setup
+ update
+ lower .raise.d
+ raise_getOrder
+} {a b c b c e e e}
+test raise-5.2 {lower internal windows} {
+ raise_setup
+ update
+ lower .raise.d .raise.b
+ raise_getOrder
+} {d b c b c e e e}
+test raise-5.3 {lower internal windows} {
+ raise_setup
+ update
+ lower .raise.a .raise.e
+ raise_getOrder
+} {a d d a c e e e}
+test raise-5.4 {lower internal windows} {
+ raise_setup
+ update
+ frame .raise2
+ list [catch {lower .raise.a .raise2} msg] $msg
+} {1 {can't lower ".raise.a" below ".raise2"}}
+catch {destroy .raise2}
+
+test raise-6.1 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise1
+ winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
+} .raise1
+test raise-6.2 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise2
+ winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
+} .raise2
+test raise-6.3 {raise/lower toplevel windows} {nonPortable} {
+ 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]]
+} {.raise2 .raise1}
+test raise-6.4 {raise/lower toplevel windows} {nonPortable} {
+ 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]]
+} {.raise1 .raise3}
+test raise-6.5 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ raise .raise1
+ set time [lindex [time {raise .raise1}] 0]
+ expr {$time < 2000000}
+} 1
+test raise-6.6 {raise/lower toplevel windows} {nonPortable} {
+ 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]]
+} {.raise1 .raise3}
+
+test raise-7.1 {errors in raise/lower commands} {
+ list [catch {raise} msg] $msg
+} {1 {wrong # args: should be "raise window ?aboveThis?"}}
+test raise-7.2 {errors in raise/lower commands} {
+ list [catch {raise a b c} msg] $msg
+} {1 {wrong # args: should be "raise window ?aboveThis?"}}
+test raise-7.3 {errors in raise/lower commands} {
+ list [catch {raise badName} msg] $msg
+} {1 {bad window path name "badName"}}
+test raise-7.4 {errors in raise/lower commands} {
+ list [catch {raise . badName2} msg] $msg
+} {1 {bad window path name "badName2"}}
+test raise-7.5 {errors in raise/lower commands} {
+ list [catch {lower} msg] $msg
+} {1 {wrong # args: should be "lower window ?belowThis?"}}
+test raise-7.6 {errors in raise/lower commands} {
+ list [catch {lower a b c} msg] $msg
+} {1 {wrong # args: should be "lower window ?belowThis?"}}
+test raise-7.7 {errors in raise/lower commands} {
+ list [catch {lower badName3} msg] $msg
+} {1 {bad window path name "badName3"}}
+test raise-7.8 {errors in raise/lower commands} {
+ list [catch {lower . badName4} msg] $msg
+} {1 {bad window path name "badName4"}}
+
+foreach i [winfo child .] {
+ destroy $i
+}