# 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. # # RCS: @(#) $Id: raise.test,v 1.1.1.1 2007/07/10 15:05:18 duncan Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands testConstraint testmakeexist [llength [info commands testmakeexist]] # 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} { raise_setup tkwait visibility .raise.e raise_getOrder } {d d d b c e e e} test raise-1.2 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.a update raise_getOrder } {d d d b c e e e} test raise-1.3 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.c update raise_getOrder } {d d d b c e e e} test raise-1.4 {preserve creation order} testmakeexist { raise_setup testmakeexist .raise.e update raise_getOrder } {d d d b c e e e} test raise-1.5 {preserve creation order} testmakeexist { 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} testmakeexist { 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} testmakeexist { 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} testmakeexist { 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"}} deleteWindows # cleanup ::tcltest::cleanupTests return