home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / tests / raise.test < prev    next >
Encoding:
Text File  |  1993-07-10  |  9.1 KB  |  308 lines
  1. # This file is a Tcl script to test out Tk's "raise" and
  2. # "lower" commands, plus associated code to manage window
  3. # stacking order.  It is organized in the standard fashion
  4. # for Tcl tests.
  5. #
  6. # Copyright (c) 1993 The Regents of the University of California.
  7. # All rights reserved.
  8. #
  9. # Permission is hereby granted, without written agreement and without
  10. # license or royalty fees, to use, copy, modify, and distribute this
  11. # software and its documentation for any purpose, provided that the
  12. # above copyright notice and the following two paragraphs appear in
  13. # all copies of this software.
  14. #
  15. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  16. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  17. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  18. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  19. #
  20. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  21. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  22. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  23. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  24. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  25. #
  26. # $Header: /user6/ouster/wish/tests/RCS/raise.test,v 1.3 93/07/10 14:20:17 ouster Exp $ (Berkeley)
  27.  
  28. if {[info commands testmakeexist] == {}} {
  29.     puts "This application hasn't been compiled with the \"testmakeexist\""
  30.     puts "command, so I can't run this test.  Are you sure you're using"
  31.     puts "tktest instead of wish?"
  32.     return
  33. }
  34.  
  35. if {[string compare test [info procs test]] == 1} then \
  36.   {source defs}
  37.  
  38. # Procedure to create a bunch of overlapping windows, which should
  39. # make it easy to detect differences in order.
  40.  
  41. proc raise_setup {} {
  42.     foreach i [winfo child .raise] {
  43.     destroy $i
  44.     }
  45.     foreach i {a b c d e} {
  46.     label .raise.$i -text $i -relief raised -bd 2
  47.     }
  48.     place .raise.a -x 20 -y 60 -width 60 -height 80
  49.     place .raise.b -x 60 -y 60 -width 60 -height 80
  50.     place .raise.c -x 100 -y 60 -width 60 -height 80
  51.     place .raise.d -x 40 -y 20 -width 100 -height 60
  52.     place .raise.e -x 40 -y 120 -width 100 -height 60
  53. }
  54.  
  55. # Procedure to return information about which windows are on top
  56. # of which other windows.
  57.  
  58. proc raise_getOrder {} {
  59.     set x [winfo rootx .raise]
  60.     set y [winfo rooty .raise]
  61.     list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \
  62.         [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \
  63.         [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \
  64.         [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \
  65.         [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \
  66.         [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \
  67.         [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \
  68.         [winfo name [winfo containing [expr $x+130] [expr $y+130]]]
  69. }
  70.  
  71. # Procedure to set up a collection of top-level windows
  72.  
  73. proc raise_makeToplevels {} {
  74.     foreach i [winfo child .] {
  75.     destroy $i
  76.     }
  77.     foreach i {.raise1 .raise2 .raise3} {
  78.     toplevel $i
  79.     wm geom $i 150x100+0+0
  80.     update
  81.     }
  82. }
  83.  
  84. foreach i [winfo child .] {
  85.     destroy $i
  86. }
  87. toplevel .raise
  88. wm geom .raise 250x200+0+0
  89.  
  90. test raise-1.1 {preserve creation order} {
  91.     raise_setup
  92.     update
  93.     raise_getOrder
  94. } {d d d b c e e e}
  95. test raise-1.2 {preserve creation order} {
  96.     raise_setup
  97.     testmakeexist .raise.a
  98.     update
  99.     raise_getOrder
  100. } {d d d b c e e e}
  101. test raise-1.3 {preserve creation order} {
  102.     raise_setup
  103.     testmakeexist .raise.c
  104.     update
  105.     raise_getOrder
  106. } {d d d b c e e e}
  107. test raise-1.4 {preserve creation order} {
  108.     raise_setup
  109.     testmakeexist .raise.e
  110.     update
  111.     raise_getOrder
  112. } {d d d b c e e e}
  113. test raise-1.5 {preserve creation order} {
  114.     raise_setup
  115.     testmakeexist .raise.d .raise.c .raise.b
  116.     update
  117.     raise_getOrder
  118. } {d d d b c e e e}
  119.  
  120. test raise-2.1 {raise internal windows before creation} {
  121.     raise_setup
  122.     raise .raise.a
  123.     update
  124.     raise_getOrder
  125. } {a d d a c a e e}
  126. test raise-2.2 {raise internal windows before creation} {
  127.     raise_setup
  128.     raise .raise.c
  129.     update
  130.     raise_getOrder
  131. } {d d c b c e e c}
  132. test raise-2.3 {raise internal windows before creation} {
  133.     raise_setup
  134.     raise .raise.e
  135.     update
  136.     raise_getOrder
  137. } {d d d b c e e e}
  138. test raise-2.4 {raise internal windows before creation} {
  139.     raise_setup
  140.     raise .raise.e .raise.a
  141.     update
  142.     raise_getOrder
  143. } {d d d b c e b c}
  144. test raise-2.5 {raise internal windows before creation} {
  145.     raise_setup
  146.     raise .raise.a .raise.d
  147.     update
  148.     raise_getOrder
  149. } {a d d a c e e e}
  150.  
  151. test raise-3.1 {raise internal windows after creation} {
  152.     raise_setup
  153.     update
  154.     raise .raise.a .raise.d
  155.     raise_getOrder
  156. } {a d d a c e e e}
  157. test raise-3.2 {raise internal windows after creation} {
  158.     raise_setup
  159.     testmakeexist .raise.a .raise.b
  160.     raise .raise.a .raise.b
  161.     update
  162.     raise_getOrder
  163. } {d d d a c e e e}
  164. test raise-3.3 {raise internal windows after creation} {
  165.     raise_setup
  166.     testmakeexist .raise.a .raise.d
  167.     raise .raise.a .raise.b
  168.     update
  169.     raise_getOrder
  170. } {d d d a c e e e}
  171. test raise-3.4 {raise internal windows after creation} {
  172.     raise_setup
  173.     testmakeexist .raise.a .raise.c .raise.d
  174.     raise .raise.a .raise.b
  175.     update
  176.     raise_getOrder
  177. } {d d d a c e e e}
  178.  
  179. test raise-4.1 {raise relative to nephews} {
  180.     raise_setup
  181.     update
  182.     frame .raise.d.child
  183.     raise .raise.a .raise.d.child
  184.     raise_getOrder
  185. } {a d d a c e e e}
  186. test raise-4.2 {raise relative to nephews} {
  187.     raise_setup
  188.     update
  189.     frame .raise2
  190.     list [catch {raise .raise.a .raise2} msg] $msg
  191. } {1 {can't raise ".raise.a" above ".raise2"}}
  192. catch {destroy .raise2}
  193.  
  194. test raise-5.1 {lower internal windows} {
  195.     raise_setup
  196.     update
  197.     lower .raise.d
  198.     raise_getOrder
  199. } {a b c b c e e e}
  200. test raise-5.2 {lower internal windows} {
  201.     raise_setup
  202.     update
  203.     lower .raise.d .raise.b
  204.     raise_getOrder
  205. } {d b c b c e e e}
  206. test raise-5.3 {lower internal windows} {
  207.     raise_setup
  208.     update
  209.     lower .raise.a .raise.e
  210.     raise_getOrder
  211. } {a d d a c e e e}
  212. test raise-5.4 {lower internal windows} {
  213.     raise_setup
  214.     update
  215.     frame .raise2
  216.     list [catch {lower .raise.a .raise2} msg] $msg
  217. } {1 {can't lower ".raise.a" below ".raise2"}}
  218. catch {destroy .raise2}
  219.  
  220. test raise-6.1 {raise/lower toplevel windows} {
  221.     raise_makeToplevels
  222.     update
  223.     raise .raise1
  224.     winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
  225. } .raise1
  226. test raise-6.2 {raise/lower toplevel windows} {
  227.     raise_makeToplevels
  228.     update
  229.     raise .raise2
  230.     winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
  231. } .raise2
  232. test raise-6.3 {raise/lower toplevel windows} {
  233.     raise_makeToplevels
  234.     update
  235.     raise .raise3
  236.     raise .raise2
  237.     raise .raise1 .raise3
  238.     set result [winfo containing [winfo rootx .raise1] [winfo rooty .raise1]]
  239.     destroy .raise2
  240.     update
  241.     after 500
  242.     list $result [winfo containing [winfo rootx .raise1] [winfo rooty .raise1]]
  243. } {.raise2 .raise1}
  244. test raise-6.4 {raise/lower toplevel windows} {
  245.     raise_makeToplevels
  246.     update
  247.     raise .raise2
  248.     raise .raise1
  249.     lower .raise3 .raise1
  250.     set result [winfo containing [winfo rootx .raise1] [winfo rooty .raise1]]
  251.     wm geometry .raise2 +30+30
  252.     wm geometry .raise1 +60+60
  253.     destroy .raise1
  254.     update
  255.     after 500
  256.     list $result [winfo containing [winfo rootx .raise2] [winfo rooty .raise2]]
  257. } {.raise1 .raise3}
  258. test raise-6.5 {raise/lower toplevel windows} {
  259.     raise_makeToplevels
  260.     raise .raise1
  261.     set time [lindex [time {raise .raise1}] 0]
  262.     expr {$time < 2000000}
  263. } 1
  264. test raise-6.6 {raise/lower toplevel windows} {
  265.     raise_makeToplevels
  266.     update
  267.     raise .raise2
  268.     raise .raise1
  269.     raise .raise3
  270.     frame .raise1.f1
  271.     frame .raise1.f1.f2
  272.     lower .raise3 .raise1.f1.f2
  273.     set result [winfo containing [winfo rootx .raise1] [winfo rooty .raise1]]
  274.     destroy .raise1
  275.     update
  276.     after 500
  277.     list $result [winfo containing [winfo rootx .raise2] [winfo rooty .raise2]]
  278. } {.raise1 .raise3}
  279.  
  280. test raise-7.1 {errors in raise/lower commands} {
  281.     list [catch {raise} msg] $msg
  282. } {1 {wrong # args: should be "raise window ?aboveThis?"}}
  283. test raise-7.2 {errors in raise/lower commands} {
  284.     list [catch {raise a b c} msg] $msg
  285. } {1 {wrong # args: should be "raise window ?aboveThis?"}}
  286. test raise-7.3 {errors in raise/lower commands} {
  287.     list [catch {raise badName} msg] $msg
  288. } {1 {bad window path name "badName"}}
  289. test raise-7.4 {errors in raise/lower commands} {
  290.     list [catch {raise . badName2} msg] $msg
  291. } {1 {bad window path name "badName2"}}
  292. test raise-7.5 {errors in raise/lower commands} {
  293.     list [catch {lower} msg] $msg
  294. } {1 {wrong # args: should be "lower window ?belowThis?"}}
  295. test raise-7.6 {errors in raise/lower commands} {
  296.     list [catch {lower a b c} msg] $msg
  297. } {1 {wrong # args: should be "lower window ?belowThis?"}}
  298. test raise-7.7 {errors in raise/lower commands} {
  299.     list [catch {lower badName3} msg] $msg
  300. } {1 {bad window path name "badName3"}}
  301. test raise-7.8 {errors in raise/lower commands} {
  302.     list [catch {lower . badName4} msg] $msg
  303. } {1 {bad window path name "badName4"}}
  304.  
  305. foreach i [winfo child .] {
  306.     destroy $i
  307. }
  308.