home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / tests / wm.test < prev    next >
Encoding:
Text File  |  1993-07-10  |  7.4 KB  |  289 lines
  1. # This file is a Tcl script to test out Tk's interactions with
  2. # the window manager, including the "wm" command.  It is organized
  3. # in the standard fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1992-1993 The Regents of the University of California.
  6. # All rights reserved.
  7. #
  8. # Permission is hereby granted, without written agreement and without
  9. # license or royalty fees, to use, copy, modify, and distribute this
  10. # software and its documentation for any purpose, provided that the
  11. # above copyright notice and the following two paragraphs appear in
  12. # all copies of this software.
  13. #
  14. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  15. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  16. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  17. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  18. #
  19. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  20. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  21. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  22. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  23. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  24. #
  25. # $Header: /user6/ouster/wish/tests/RCS/wm.test,v 1.12 93/07/10 14:54:01 ouster Exp $ (Berkeley)
  26.  
  27. if {[string compare test [info procs test]] == 1} {
  28.     source defs
  29. }
  30.  
  31. proc sleep ms {
  32.     global x
  33.     after $ms {set x 1}
  34.     tkwait variable x
  35. }
  36.  
  37. set i 1
  38. foreach geom {+20+80 +80+20 +0+0} {
  39.     catch {destroy .t}
  40.     test wm-1.$i {initial window position} {
  41.     toplevel .t -width 200 -height 150
  42.     wm geom .t $geom
  43.     update
  44.     wm geom .t
  45.     } 200x150$geom
  46.     incr i
  47. }
  48.  
  49. # The tests below are tricky because window managers don't all move
  50. # windows correctly.  Try one motion and compute the window manager's
  51. # error, then factor this error into the actual tests.  In other words,
  52. # this just makes sure that things are consistent between moves.
  53.  
  54. set i 1
  55. catch {destroy .t}
  56. toplevel .t -width 100 -height 150
  57. wm geom .t +200+200
  58. update
  59. wm geom .t +150+150
  60. update
  61. scan [wm geom .t] %dx%d+%d+%d width height x y
  62. set xerr [expr 150-$x]
  63. set yerr [expr 150-$y]
  64. foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
  65.     test wm-2.$i {moving window while mapped} {
  66.     wm geom .t $geom
  67.     update
  68.     scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
  69.     format "%s%d%s%d" $xsign [expr $x$xsign$xerr] $ysign \
  70.         [expr $y$ysign$yerr]
  71.     } $geom
  72.     incr i
  73. }
  74.  
  75. set i 1
  76. foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
  77.     test wm-3.$i {moving window while iconified} {
  78.     wm iconify .t
  79.     sleep 200
  80.     wm geom .t $geom
  81.     update
  82.     wm deiconify .t
  83.     scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
  84.     format "%s%d%s%d" $xsign [expr $x$xsign$xerr] $ysign \
  85.         [expr $y$ysign$yerr]
  86.     } $geom
  87.     incr i
  88. }
  89.  
  90. set i 1
  91. foreach geom {+20+80 +100+40 +0+0} {
  92.     test wm-4.$i {moving window while withdrawn} {
  93.     wm withdraw .t
  94.     sleep 200
  95.     wm geom .t $geom
  96.     update
  97.     wm deiconify .t
  98.     wm geom .t
  99.     } 100x150$geom
  100.     incr i
  101. }
  102.  
  103. test wm-5.1 {compounded state changes} {
  104.     catch {destroy .t}
  105.     toplevel .t -width 200 -height 100
  106.     wm geometry .t +100+100
  107.     update
  108.     wm withdraw .t
  109.     wm deiconify .t
  110.     list [winfo ismapped .t] [wm state .t]
  111. } {1 normal}
  112. test wm-5.2 {compounded state changes} {
  113.     catch {destroy .t}
  114.     toplevel .t -width 200 -height 100
  115.     wm geometry .t +100+100
  116.     update
  117.     wm withdraw .t
  118.     wm deiconify .t
  119.     wm withdraw .t
  120.     list [winfo ismapped .t] [wm state .t]
  121. } {0 withdrawn}
  122. test wm-5.3 {compounded state changes} {
  123.     catch {destroy .t}
  124.     toplevel .t -width 200 -height 100
  125.     wm geometry .t +100+100
  126.     update
  127.     wm iconify .t
  128.     wm deiconify .t
  129.     wm iconify .t
  130.     wm deiconify .t
  131.     list [winfo ismapped .t] [wm state .t]
  132. } {1 normal}
  133. test wm-5.4 {compounded state changes} {
  134.     catch {destroy .t}
  135.     toplevel .t -width 200 -height 100
  136.     wm geometry .t +100+100
  137.     update
  138.     wm iconify .t
  139.     wm deiconify .t
  140.     wm iconify .t
  141.     list [winfo ismapped .t] [wm state .t]
  142. } {0 iconic}
  143. test wm-5.5 {compounded state changes} {
  144.     catch {destroy .t}
  145.     toplevel .t -width 200 -height 100
  146.     wm geometry .t +100+100
  147.     update
  148.     wm iconify .t
  149.     wm withdraw .t
  150.     list [winfo ismapped .t] [wm state .t]
  151. } {0 withdrawn}
  152. test wm-5.6 {compounded state changes} {
  153.     catch {destroy .t}
  154.     toplevel .t -width 200 -height 100
  155.     wm geometry .t +100+100
  156.     update
  157.     wm iconify .t
  158.     wm withdraw .t
  159.     wm deiconify .t
  160.     list [winfo ismapped .t] [wm state .t]
  161. } {1 normal}
  162. if $atBerkeley {
  163.     test wm-5.7 {compounded state changes} {
  164.     catch {destroy .t}
  165.     toplevel .t -width 200 -height 100
  166.     wm geometry .t +100+100
  167.     update
  168.     wm withdraw .t
  169.     wm iconify .t
  170.     list [winfo ismapped .t] [wm state .t]
  171.     } {0 iconic}
  172. }
  173.  
  174. catch {destroy .t}
  175. toplevel .t -width 200 -height 100
  176. wm geom .t +10+10
  177. wm minsize .t 1 1
  178. update
  179. test wm-6.1 {size changes} {
  180.     .t config -width 180 -height 150
  181.     update
  182.     wm geom .t
  183. } 180x150+10+10
  184. test wm-6.2 {size changes} {
  185.     wm geom .t 250x60
  186.     .t config -width 170 -height 140
  187.     update
  188.     wm geom .t
  189. } 250x60+10+10
  190. test wm-6.3 {size changes} {
  191.     wm geom .t 250x60
  192.     .t config -width 170 -height 140
  193.     wm geom .t {}
  194.     update
  195.     wm geom .t
  196. } 170x140+10+10
  197. if $atBerkeley {
  198.     test wm-6.4 {size changes} {
  199.     wm minsize .t 1 1
  200.     update
  201.     puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
  202.     puts -nonewline stdout "then hit return: "
  203.     flush stdout
  204.     gets stdin
  205.     update
  206.     set width [winfo width .t]
  207.     set height [winfo height .t]
  208.     .t config -width 230 -height 110
  209.     update
  210.     incr width -[winfo width .t]
  211.     incr height -[winfo height .t]
  212.     wm geom .t {}
  213.     update
  214.     set w2 [winfo width .t]
  215.     set h2 [winfo height .t]
  216.     .t config -width 114 -height 261
  217.     update
  218.     list $width $height $w2 $h2 [wm geom .t]
  219.     } {0 0 230 110 114x261+10+10}
  220. }
  221.  
  222. test wm-7.1 {window initially withdrawn} {
  223.     catch {destroy .t}
  224.     toplevel .t -width 100 -height 30
  225.     wm geometry .t +0+0
  226.     wm withdraw .t
  227.     sleep 200
  228.     set result [winfo ismapped .t]
  229.     wm deiconify .t
  230.     list $result [winfo ismapped .t]
  231. } {0 1}
  232. test wm-7.2 {window initially withdrawn} {
  233.     catch {destroy .t}
  234.     toplevel .t -width 100 -height 30
  235.     wm geometry .t +0+0
  236.     wm withdraw .t
  237.     wm deiconify .t
  238.     sleep 200
  239.     winfo ismapped .t
  240. } 1
  241.  
  242. test wm-8.1 {window initially iconic} {
  243.     catch {destroy .t}
  244.     toplevel .t -width 100 -height 30
  245.     wm geometry .t +0+0
  246.     wm title .t 1
  247.     wm iconify .t
  248.     update idletasks
  249.     list [winfo ismapped .t] [wm state .t]
  250. } {0 iconic}
  251.  
  252. # I don't know why the wait below is needed, but without it the test
  253. # fails under twm.
  254. sleep 200
  255.  
  256. test wm-8.2 {window initially iconic} {
  257.     catch {destroy .t}
  258.     toplevel .t -width 100 -height 30
  259.     wm geometry .t +0+0
  260.     wm title .t 2
  261.     wm iconify .t
  262.     update idletasks
  263.     wm withdraw .t
  264.     wm deiconify .t
  265.     list [winfo ismapped .t] [wm state .t]
  266. } {1 normal}
  267.  
  268. catch {destroy .m}
  269. menu .m
  270. foreach i {{Test label} Another {Yet another} {Last label}} {
  271.     .m add command -label $i
  272. }
  273. .m post 100 200
  274. test wm-9.1 {override_redirect and Tk_MoveTopLevelWindow} {
  275.     list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
  276. } {1 normal 100 200}
  277. .m post 150 210
  278. test wm-9.2 {override_redirect and Tk_MoveTopLevelWindow} {
  279.     list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
  280. } {1 normal 150 210}
  281. .m unpost
  282. test wm-9.3 {override_redirect and Tk_MoveTopLevelWindow} {
  283.     list [winfo ismapped .m]
  284. } 0
  285. destroy .m
  286.  
  287. catch {destroy .t}
  288. concat {}
  289.