home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / unixWm.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  78.2 KB  |  2,341 lines  |  [TEXT/ALFA]
  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-1994 The Regents of the University of California.
  6. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11. # SCCS: @(#) unixWm.test 1.45 97/08/08 15:40:36
  12.  
  13. if {$tcl_platform(platform) != "unix"} {
  14.     return
  15. }
  16.  
  17. if {[string compare test [info procs test]] == 1} {
  18.     source defs
  19. }
  20.  
  21. proc sleep ms {
  22.     global x
  23.     after $ms {set x 1}
  24.     vwait x
  25. }
  26.  
  27. # Procedure to set up a collection of top-level windows
  28.  
  29. proc makeToplevels {} {
  30.     foreach i [winfo child .] {
  31.     destroy $i
  32.     }
  33.     foreach i {.raise1 .raise2 .raise3} {
  34.     toplevel $i
  35.     wm geom $i 150x100+0+0
  36.     update
  37.     }
  38. }
  39.  
  40. set i 1
  41. foreach geom {+20+80 +80+20 +0+0} {
  42.     catch {destroy .t}
  43.     test unixWm-1.$i {initial window position} {
  44.     toplevel .t -width 200 -height 150
  45.     wm geom .t $geom
  46.     update
  47.     wm geom .t
  48.     } 200x150$geom
  49.     incr i
  50. }
  51.  
  52. # The tests below are tricky because window managers don't all move
  53. # windows correctly.  Try one motion and compute the window manager's
  54. # error, then factor this error into the actual tests.  In other words,
  55. # this just makes sure that things are consistent between moves.
  56.  
  57. set i 1
  58. catch {destroy .t}
  59. toplevel .t -width 100 -height 150
  60. wm geom .t +200+200
  61. update
  62. wm geom .t +150+150
  63. update
  64. scan [wm geom .t] %dx%d+%d+%d width height x y
  65. set xerr [expr 150-$x]
  66. set yerr [expr 150-$y]
  67. foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
  68.     test unixWm-2.$i {moving window while mapped} {
  69.     wm geom .t $geom
  70.     update
  71.     scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
  72.     format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
  73.         [eval expr $y$ysign$yerr]
  74.     } $geom
  75.     incr i
  76. }
  77.  
  78. set i 1
  79. foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
  80.     test unixWm-3.$i {moving window while iconified} {
  81.     wm iconify .t
  82.     sleep 200
  83.     wm geom .t $geom
  84.     update
  85.     wm deiconify .t
  86.     scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
  87.     format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
  88.         [eval expr $y$ysign$yerr]
  89.     } $geom
  90.     incr i
  91. }
  92.  
  93. set i 1
  94. foreach geom {+20+80 +100+40 +0+0} {
  95.     test unixWm-4.$i {moving window while withdrawn} {
  96.     wm withdraw .t
  97.     sleep 200
  98.     wm geom .t $geom
  99.     update
  100.     wm deiconify .t
  101.     wm geom .t
  102.     } 100x150$geom
  103.     incr i
  104. }
  105.  
  106. test unixWm-5.1 {compounded state changes} {nonPortable} {
  107.     catch {destroy .t}
  108.     toplevel .t -width 200 -height 100
  109.     wm geometry .t +100+100
  110.     update
  111.     wm withdraw .t
  112.     wm deiconify .t
  113.     list [winfo ismapped .t] [wm state .t]
  114. } {1 normal}
  115. test unixWm-5.2 {compounded state changes} {nonPortable} {
  116.     catch {destroy .t}
  117.     toplevel .t -width 200 -height 100
  118.     wm geometry .t +100+100
  119.     update
  120.     wm withdraw .t
  121.     wm deiconify .t
  122.     wm withdraw .t
  123.     list [winfo ismapped .t] [wm state .t]
  124. } {0 withdrawn}
  125. test unixWm-5.3 {compounded state changes} {nonPortable} {
  126.     catch {destroy .t}
  127.     toplevel .t -width 200 -height 100
  128.     wm geometry .t +100+100
  129.     update
  130.     wm iconify .t
  131.     wm deiconify .t
  132.     wm iconify .t
  133.     wm deiconify .t
  134.     list [winfo ismapped .t] [wm state .t]
  135. } {1 normal}
  136. test unixWm-5.4 {compounded state changes} {nonPortable} {
  137.     catch {destroy .t}
  138.     toplevel .t -width 200 -height 100
  139.     wm geometry .t +100+100
  140.     update
  141.     wm iconify .t
  142.     wm deiconify .t
  143.     wm iconify .t
  144.     list [winfo ismapped .t] [wm state .t]
  145. } {0 iconic}
  146. test unixWm-5.5 {compounded state changes} {nonPortable} {
  147.     catch {destroy .t}
  148.     toplevel .t -width 200 -height 100
  149.     wm geometry .t +100+100
  150.     update
  151.     wm iconify .t
  152.     wm withdraw .t
  153.     list [winfo ismapped .t] [wm state .t]
  154. } {0 withdrawn}
  155. test unixWm-5.6 {compounded state changes} {nonPortable} {
  156.     catch {destroy .t}
  157.     toplevel .t -width 200 -height 100
  158.     wm geometry .t +100+100
  159.     update
  160.     wm iconify .t
  161.     wm withdraw .t
  162.     wm deiconify .t
  163.     list [winfo ismapped .t] [wm state .t]
  164. } {1 normal}
  165. test unixWm-5.7 {compounded state changes} {nonPortable} {
  166.     catch {destroy .t}
  167.     toplevel .t -width 200 -height 100
  168.     wm geometry .t +100+100
  169.     update
  170.     wm withdraw .t
  171.     wm iconify .t
  172.     list [winfo ismapped .t] [wm state .t]
  173. } {0 iconic}
  174.  
  175. catch {destroy .t}
  176. toplevel .t -width 200 -height 100
  177. wm geom .t +10+10
  178. wm minsize .t 1 1
  179. update
  180. test unixWm-6.1 {size changes} {
  181.     .t config -width 180 -height 150
  182.     update
  183.     wm geom .t
  184. } 180x150+10+10
  185. test unixWm-6.2 {size changes} {
  186.     wm geom .t 250x60
  187.     .t config -width 170 -height 140
  188.     update
  189.     wm geom .t
  190. } 250x60+10+10
  191. test unixWm-6.3 {size changes} {
  192.     wm geom .t 250x60
  193.     .t config -width 170 -height 140
  194.     wm geom .t {}
  195.     update
  196.     wm geom .t
  197. } 170x140+10+10
  198. test unixWm-6.4 {size changes} {nonPortable} {
  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. # I don't know why the wait below is needed, but without it the test
  222. # fails under twm.
  223. sleep 200
  224.  
  225. test unixWm-6.5 {window initially iconic} {nonPortable} {
  226.     catch {destroy .t}
  227.     toplevel .t -width 100 -height 30
  228.     wm geometry .t +0+0
  229.     wm title .t 2
  230.     wm iconify .t
  231.     update idletasks
  232.     wm withdraw .t
  233.     wm deiconify .t
  234.     list [winfo ismapped .t] [wm state .t]
  235. } {1 normal}
  236.  
  237. catch {destroy .m}
  238. toplevel .m
  239. wm overrideredirect .m 1
  240. foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} {
  241.     label .m.$j -text $i
  242. }
  243. wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]]
  244. update
  245. test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} {
  246.     list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
  247. } {1 normal 100 200}
  248. wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]]
  249. update
  250. test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} {
  251.     list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
  252. } {1 normal 150 210}
  253. wm withdraw .m
  254. test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} {
  255.     list [winfo ismapped .m]
  256. } 0
  257. destroy .m
  258. catch {destroy .t}
  259.  
  260. test unixWm-8.1 {icon windows} {
  261.     catch {destroy .t}
  262.     catch {destroy .icon}
  263.     toplevel .t -width 100 -height 30
  264.     wm geometry .t +0+0
  265.     toplevel .icon -width 50 -height 50 -bg red
  266.     wm iconwindow .t .icon
  267.     list [catch {wm withdraw .icon} msg] $msg
  268. } {1 {can't withdraw .icon: it is an icon for .t}}
  269. test unixWm-8.2 {icon windows} {
  270.     catch {destroy .t}
  271.     toplevel .t -width 100 -height 30
  272.     list [catch {wm iconwindow} msg] $msg
  273. } {1 {wrong # args: should be "wm option window ?arg ...?"}}
  274. test unixWm-8.3 {icon windows} {
  275.     catch {destroy .t}
  276.     toplevel .t -width 100 -height 30
  277.     list [catch {wm iconwindow .t b c} msg] $msg
  278. } {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
  279. test unixWm-8.4 {icon windows} {
  280.     catch {destroy .t}
  281.     catch {destroy .icon}
  282.     toplevel .t -width 100 -height 30
  283.     wm geom .t +0+0
  284.     set result [wm iconwindow .t]
  285.     toplevel .icon -width 50 -height 50 -bg red
  286.     wm iconwindow .t .icon
  287.     lappend result [wm iconwindow .t] [wm state .icon]
  288.     wm iconwindow .t {}
  289.     lappend result [wm iconwindow .t] [wm state .icon]
  290.     update
  291.     lappend result [winfo ismapped .t] [winfo ismapped .icon]
  292.     wm iconify .t
  293.     update
  294.     lappend result [winfo ismapped .t] [winfo ismapped .icon]
  295. } {.icon icon {} withdrawn 1 0 0 0}
  296. test unixWm-8.5 {icon windows} {
  297.     catch {destroy .t}
  298.     toplevel .t -width 100 -height 30
  299.     list [catch {wm iconwindow .t .gorp} msg] $msg
  300. } {1 {bad window path name ".gorp"}}
  301. test unixWm-8.6 {icon windows} {
  302.     catch {destroy .t}
  303.     toplevel .t -width 100 -height 30
  304.     frame .t.icon -width 50 -height 50 -bg red
  305.     list [catch {wm iconwindow .t .t.icon} msg] $msg
  306. } {1 {can't use .t.icon as icon window: not at top level}}
  307. test unixWm-8.7 {icon windows} {
  308.     catch {destroy .t}
  309.     catch {destroy .icon}
  310.     toplevel .t -width 100 -height 30
  311.     wm geom .t +0+0
  312.     toplevel .icon -width 50 -height 50 -bg red
  313.     toplevel .icon2 -width 50 -height 50 -bg green
  314.     wm iconwindow .t .icon
  315.     set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]"
  316.     wm iconwindow .t .icon2
  317.     lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2]
  318. } {.icon icon normal .icon2 withdrawn icon}
  319. catch {destroy .icon2}
  320. test unixWm-8.8 {icon windows} {
  321.     catch {destroy .t}
  322.     catch {destroy .icon}
  323.     toplevel .icon -width 50 -height 50 -bg red
  324.     wm geom .icon +0+0
  325.     update
  326.     set result [winfo ismapped .icon]
  327.     toplevel .t -width 100 -height 30
  328.     wm geom .t +0+0
  329.     tkwait visibility .t    ;# Needed to keep tvtwm happy.
  330.     wm iconwindow .t .icon
  331.     sleep 500
  332.     lappend result [winfo ismapped .t] [winfo ismapped .icon]
  333. } {1 1 0}
  334. test unixWm-8.9 {icon windows} {nonPortable} {
  335.     # This test is non-portable because some window managers will
  336.     # destroy an icon window when it's associated window is destroyed.
  337.  
  338.     catch {destroy .t}
  339.     catch {destroy .icon}
  340.     toplevel .t -width 100 -height 30
  341.     toplevel .icon -width 50 -height 50 -bg red
  342.     wm geom .t +0+0
  343.     wm iconwindow .t .icon
  344.     update
  345.     set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]"
  346.     destroy .t
  347.     wm geom .icon +0+0
  348.     update
  349.     lappend result [winfo ismapped .icon] [wm state .icon]
  350.     wm deiconify .icon
  351.     update
  352.     lappend result [winfo ismapped .icon] [wm state .icon]
  353. } {icon 1 0 0 withdrawn 1 normal}
  354.  
  355. test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} {
  356.     catch {destroy .t}
  357.     toplevel .t -width 100 -height 50
  358.     wm geom .t +0+0
  359.     wm client .t Test_String
  360.     update
  361.     testprop [testwrapper .t] WM_CLIENT_MACHINE
  362. } {Test_String}
  363. test unixWm-9.2 {TkWmMapWindow procedure, command property} {unixOnly} {
  364.     catch {destroy .t}
  365.     toplevel .t -width 100 -height 50
  366.     wm geom .t +0+0
  367.     wm command .t "test command"
  368.     update
  369.     testprop [testwrapper .t] WM_COMMAND
  370. } {test
  371. command
  372. }
  373. test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} {
  374.     catch {destroy .t}
  375.     toplevel .t -width 100 -height 300 -bg blue
  376.     wm geom .t +0+0
  377.     wm iconify .t
  378.     sleep 500
  379.     winfo ismapped .t
  380. } {0}
  381. test unixWm-9.4 {TkWmMapWindow procedure, icon windows} {
  382.     catch {destroy .t}
  383.     sleep 500
  384.     toplevel .t -width 100 -height 50 -bg blue
  385.     wm iconwindow . .t
  386.     update
  387.     set result [winfo ismapped .t]
  388. } {0}
  389. test unixWm-9.5 {TkWmMapWindow procedure, normal windows} {
  390.     catch {destroy .t}
  391.     toplevel .t -width 200 -height 20
  392.     wm geom .t +0+0
  393.     update
  394.     winfo ismapped .t
  395. } {1}
  396.  
  397. test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} {
  398.     catch {destroy .t}
  399.     toplevel .t -width 100 -height 50
  400.     wm geom .t +0+0
  401.     update
  402.     .t configure -width 200 -height 100
  403.     destroy .t
  404. } {}
  405. test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} {
  406.     catch {destroy .t}
  407.     catch {destroy .f}
  408.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  409.     wm geom .t +0+0
  410.     update
  411.     frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
  412.     bind .f <Destroy> {lappend result destroyed}
  413.     testmenubar window .t .f
  414.     update
  415.     set result {}
  416.     destroy .t
  417.     lappend result [winfo exists .f]
  418. } {destroyed 0}
  419.  
  420. test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} {
  421.     list [catch {wm} msg] $msg
  422. } {1 {wrong # args: should be "wm option window ?arg ...?"}}
  423. test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} {
  424.     list [catch {wm foo} msg] $msg
  425. } {1 {wrong # args: should be "wm option window ?arg ...?"}}
  426. test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} {
  427.     list [catch {wm foo bogus} msg] $msg
  428. } {1 {bad window path name "bogus"}}
  429. test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} {
  430.     catch {destroy .b}
  431.     button .b -text hello
  432.     list [catch {wm geometry .b} msg] $msg
  433. } {1 {window ".b" isn't a top-level window}}
  434.  
  435. catch {destroy .t}
  436. catch {destroy .icon}
  437.  
  438. toplevel .t -width 100 -height 50
  439. wm geom .t +0+0
  440. update
  441.  
  442. test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} {
  443.     list [catch {wm aspect .t 12} msg] $msg
  444. } {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
  445. test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} {
  446.     list [catch {wm aspect .t 12 13 14 15 16} msg] $msg
  447. } {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
  448. test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} {
  449.     set result {}
  450.     lappend result [wm aspect .t]
  451.     wm aspect .t 3 4 10 2
  452.     lappend result [wm aspect .t]
  453.     wm aspect .t {} {} {} {}
  454.     lappend result [wm aspect .t]
  455. } {{} {3 4 10 2} {}}
  456. test unixWm-12.4 {Tk_WmCmd procedure, "aspect" option} {
  457.     list [catch {wm aspect .t bad 14 15 16} msg] $msg
  458. } {1 {expected integer but got "bad"}}
  459. test unixWm-12.5 {Tk_WmCmd procedure, "aspect" option} {
  460.     list [catch {wm aspect .t 13 foo 15 16} msg] $msg
  461. } {1 {expected integer but got "foo"}}
  462. test unixWm-12.6 {Tk_WmCmd procedure, "aspect" option} {
  463.     list [catch {wm aspect .t 13 14 bar 16} msg] $msg
  464. } {1 {expected integer but got "bar"}}
  465. test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} {
  466.     list [catch {wm aspect .t 13 14 15 baz} msg] $msg
  467. } {1 {expected integer but got "baz"}}
  468. test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} {
  469.     list [catch {wm aspect .t 0 14 15 16} msg] $msg
  470. } {1 {aspect number can't be <= 0}}
  471. test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} {
  472.     list [catch {wm aspect .t 13 0 15 16} msg] $msg
  473. } {1 {aspect number can't be <= 0}}
  474. test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} {
  475.     list [catch {wm aspect .t 13 14 0 16} msg] $msg
  476. } {1 {aspect number can't be <= 0}}
  477. test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} {
  478.     list [catch {wm aspect .t 13 14 15 0} msg] $msg
  479. } {1 {aspect number can't be <= 0}}
  480.  
  481. test unixWm-13.1 {Tk_WmCmd procedure, "client" option} {
  482.     list [catch {wm client .t x y} msg] $msg
  483. } {1 {wrong # arguments: must be "wm client window ?name?"}}
  484. test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} {
  485.     set result {}
  486.     lappend result [wm client .t]
  487.     wm client .t Test_String
  488.     lappend result [testprop [testwrapper .t] WM_CLIENT_MACHINE]
  489.     wm client .t New
  490.     lappend result [wm client .t]
  491.     wm client .t {}
  492.     lappend result [wm client .t] [testprop [testwrapper .t] WM_CLIENT_MACHINE]
  493. } {{} Test_String New {} {}}
  494. test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} {
  495.     catch {destroy .t2}
  496.     toplevel .t2
  497.     wm client .t2 Test_String
  498.     wm client .t2 {}
  499.     wm client .t2 Test_String
  500.     destroy .t2
  501. } {}
  502.  
  503. test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} {
  504.     list [catch {wm colormapwindows .t 12 13} msg] $msg
  505. } {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}}
  506. test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} {
  507.     catch {destroy .t2}
  508.     toplevel .t2 -width 200 -height 200 -colormap new
  509.     wm geom .t2 +0+0
  510.     frame .t2.a -width 100 -height 30
  511.     frame .t2.b -width 100 -height 30 -colormap new
  512.     pack .t2.a .t2.b -side top
  513.     update
  514.     set x [wm colormapwindows .t2]
  515.     frame .t2.c -width 100 -height 30 -colormap new
  516.     pack .t2.c -side top
  517.     update
  518.     list $x [wm colormapwindows .t2]
  519. } {{.t2.b .t2} {.t2.b .t2.c .t2}}
  520. test unixWm-14.3 {Tk_WmCmd procedure, "colormapwindows" option} {
  521.     list [catch {wm col . "a \{"} msg] $msg
  522. } {1 {unmatched open brace in list}}
  523. test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} {
  524.     list [catch {wm colormapwindows . foo} msg] $msg
  525. } {1 {bad window path name "foo"}}
  526. test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} {
  527.     catch {destroy .t2}
  528.     toplevel .t2 -width 200 -height 200 -colormap new
  529.     wm geom .t2 +0+0
  530.     frame .t2.a -width 100 -height 30
  531.     frame .t2.b -width 100 -height 30
  532.     frame .t2.c -width 100 -height 30
  533.     pack .t2.a .t2.b .t2.c -side top
  534.     wm colormapwindows .t2 {.t2.c .t2 .t2.a}
  535.     wm colormapwindows .t2
  536. } {.t2.c .t2 .t2.a}
  537. test unixWm-14.6 {Tk_WmCmd procedure, "colormapwindows" option} {
  538.     catch {destroy .t2}
  539.     toplevel .t2 -width 200 -height 200
  540.     wm geom .t2 +0+0
  541.     frame .t2.a -width 100 -height 30
  542.     frame .t2.b -width 100 -height 30
  543.     frame .t2.c -width 100 -height 30
  544.     pack .t2.a .t2.b .t2.c -side top
  545.     wm colormapwindows .t2 {.t2.b .t2.a}
  546.     wm colormapwindows .t2
  547. } {.t2.b .t2.a}
  548. test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} {
  549.     catch {destroy .t2}
  550.     toplevel .t2 -width 200 -height 200 -colormap new
  551.     wm geom .t2 +0+0
  552.     set x [wm colormapwindows .t2]
  553.     wm colormapwindows .t2 {}
  554.     list $x [wm colormapwindows .t2]
  555. } {{} {}}
  556. catch {destroy .t2}
  557.  
  558. test unixWm-15.1 {Tk_WmCmd procedure, "command" option} {
  559.     list [catch {wm command .t 12 13} msg] $msg
  560. } {1 {wrong # arguments: must be "wm command window ?value?"}}
  561. test unixWm-15.2 {Tk_WmCmd procedure, "command" option} {
  562.     list [catch {wm command .t 12 13} msg] $msg
  563. } {1 {wrong # arguments: must be "wm command window ?value?"}}
  564. test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} {
  565.     set result {}
  566.     lappend result [wm command .t]
  567.     wm command .t "test command"
  568.     lappend result [testprop [testwrapper .t] WM_COMMAND]
  569.     wm command .t "new command"
  570.     lappend result [wm command .t]
  571.     wm command .t {}
  572.     lappend result [wm command .t] [testprop [testwrapper .t] WM_COMMAND]
  573. } {{} {test
  574. command
  575. } {new command} {} {}}
  576. test unixWm-15.4 {Tk_WmCmd procedure, "command" option, window not mapped} {
  577.     catch {destroy .t2}
  578.     toplevel .t2
  579.     wm geom .t2 +0+0
  580.     wm command .t2 "test command"
  581.     wm command .t2 "new command"
  582.     wm command .t2 {}
  583.     destroy .t2
  584. } {}
  585. test unixWm-15.5 {Tk_WmCmd procedure, "command" option} {
  586.     list [catch {wm command .t "a \{b"} msg] $msg
  587. } {1 {unmatched open brace in list}}
  588.  
  589. test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} {
  590.     list [catch {wm deiconify .t 12} msg] $msg
  591. } {1 {wrong # arguments: must be "wm deiconify window"}}
  592. test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} {
  593.     catch {destroy .icon}
  594.     toplevel .icon -width 50 -height 50 -bg red
  595.     wm iconwindow .t .icon
  596.     set result [list [catch {wm deiconify .icon} msg] $msg]
  597.     destroy .icon
  598.     set result
  599. } {1 {can't deiconify .icon: it is an icon for .t}}
  600. test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {
  601.     wm iconify .t
  602.     set result {}
  603.     lappend result [winfo ismapped .t] [wm state .t]
  604.     wm deiconify .t
  605.     lappend result [winfo ismapped .t] [wm state .t]
  606. } {0 iconic 1 normal}
  607.  
  608. test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} {
  609.     list [catch {wm focusmodel .t 12 13} msg] $msg
  610. } {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}}
  611. test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} {
  612.     list [catch {wm focusmodel .t bogus} msg] $msg
  613. } {1 {bad argument "bogus": must be active or passive}}
  614. test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} {
  615.     set result {} 
  616.     lappend result [wm focusmodel .t]
  617.     wm focusmodel .t active
  618.     lappend result [wm focusmodel .t]
  619.     wm focusmodel .t passive
  620.     lappend result [wm focusmodel .t]
  621.     set result
  622. } {passive active passive}
  623.  
  624. test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} {
  625.     list [catch {wm frame .t 12} msg] $msg
  626. } {1 {wrong # arguments: must be "wm frame window"}}
  627. test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable {
  628.     expr [wm frame .t] == [winfo id .t]
  629. } {0}
  630. test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable {
  631.     catch {destroy .t2}
  632.     toplevel .t2
  633.     wm geom .t2 +0+0
  634.     wm overrideredirect .t2 1
  635.     update
  636.     set result [expr [wm frame .t2] == [winfo id .t2]]
  637.     destroy .t2
  638.     set result
  639. } {1}
  640.  
  641. test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} {
  642.     list [catch {wm geometry .t 12 13} msg] $msg
  643. } {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}}
  644. test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable {
  645.     wm geometry .t -1+5
  646.     update
  647.     wm geometry .t
  648. } {100x50-1+5}
  649. test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} nonPortable {
  650.     wm geometry .t +10-4
  651.     update
  652.     wm geometry .t
  653. } {100x50+10-4}
  654. test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} nonPortable {
  655.     catch {destroy .t2}
  656.     toplevel .t2
  657.     wm geom .t2 -5+10
  658.     listbox .t2.l -width 30 -height 12 -setgrid 1
  659.     pack .t2.l
  660.     update
  661.     set result [wm geometry .t2]
  662.     destroy .t2
  663.     set result
  664. } {30x12-5+10}
  665. test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} nonPortable {
  666.     wm geometry .t 150x300+5+6
  667.     update
  668.     set result {}
  669.     lappend result [wm geometry .t]
  670.     wm geometry .t {}
  671.     update
  672.     lappend result [wm geometry .t]
  673. } {150x300+5+6 100x50+5+6}
  674. test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} {
  675.     list [catch {wm geometry .t qrs} msg] $msg
  676. } {1 {bad geometry specifier "qrs"}}
  677.  
  678. test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} {
  679.     list [catch {wm grid .t 12 13} msg] $msg
  680. } {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
  681. test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} {
  682.     list [catch {wm grid .t 12 13 14 15 16} msg] $msg
  683. } {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
  684. test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} {
  685.     set result {}
  686.     lappend result [wm grid .t]
  687.     wm grid .t 5 6 20 10
  688.     lappend result [wm grid .t]
  689.     wm grid .t {} {} {} {}
  690.     lappend result [wm grid .t]
  691. } {{} {5 6 20 10} {}}
  692. test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} {
  693.     list [catch {wm grid .t bad 10 11 12} msg] $msg
  694. } {1 {expected integer but got "bad"}}
  695. test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} {
  696.     list [catch {wm grid .t -1 11 12 13} msg] $msg
  697. } {1 {baseWidth can't be < 0}}
  698. test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} {
  699.     list [catch {wm grid .t 10 foo 12 13} msg] $msg
  700. } {1 {expected integer but got "foo"}}
  701. test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} {
  702.     list [catch {wm grid .t 10 -11 12 13} msg] $msg
  703. } {1 {baseHeight can't be < 0}}
  704. test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} {
  705.     list [catch {wm grid .t 10 11 bar 13} msg] $msg
  706. } {1 {expected integer but got "bar"}}
  707. test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} {
  708.     list [catch {wm grid .t 10 11 -2 13} msg] $msg
  709. } {1 {widthInc can't be < 0}}
  710. test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} {
  711.     list [catch {wm grid .t 10 11 12 bogus} msg] $msg
  712. } {1 {expected integer but got "bogus"}}
  713. test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} {
  714.     list [catch {wm grid .t 10 11 12 -1} msg] $msg
  715. } {1 {heightInc can't be < 0}}
  716.  
  717. catch {destroy .t}
  718. catch {destroy .icon}
  719. toplevel .t -width 100 -height 50
  720. wm geom .t +0+0
  721. update
  722.  
  723. test unixWm-21.1 {Tk_WmCmd procedure, "group" option} {
  724.     list [catch {wm group .t 12 13} msg] $msg
  725. } {1 {wrong # arguments: must be "wm group window ?pathName?"}}
  726. test unixWm-21.2 {Tk_WmCmd procedure, "group" option} {
  727.     list [catch {wm group .t bogus} msg] $msg
  728. } {1 {bad window path name "bogus"}}
  729. test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} {
  730.     set result {}
  731.     lappend result [wm group .t]
  732.     wm group .t .
  733.     set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
  734.         WM_HINTS] 0]]]
  735.     lappend result [wm group .t] $bit
  736.     wm group .t {}
  737.     set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
  738.         WM_HINTS] 0]]]
  739.     lappend result [wm group .t] $bit
  740. } {{} . 0x40 {} 0x0}
  741. test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} {
  742.     catch {destroy .t2}
  743.     toplevel .t2
  744.     wm geom .t2 +0+0
  745.     wm group .t .t2
  746.     set hints [testprop [testwrapper .t] WM_HINTS]
  747.     set result [expr [testwrapper .t2] - [lindex $hints 8]]
  748.     destroy .t2
  749.     set result
  750. } {0}
  751. test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unixOnly} {
  752.     catch {destroy .t2}
  753.     catch {destroy .t3}
  754.     toplevel .t2 -width 120 -height 300
  755.     wm geometry .t2 +0+0
  756.     toplevel .t3 -width 120 -height 300
  757.     wm geometry .t2 +0+0
  758.     set result [list [testwrapper .t2]]
  759.     wm group .t3 .t2
  760.     lappend result [expr {[testwrapper .t2] == ""}]
  761.     destroy .t2 .t3
  762.     set result
  763. } {{} 0}
  764.  
  765. test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} {
  766.     list [catch {wm iconbitmap .t 12 13} msg] $msg
  767. } {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}}
  768. test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} {
  769.     set result {}
  770.     lappend result [wm iconbitmap .t]
  771.     wm iconbitmap .t questhead
  772.     set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
  773.         WM_HINTS] 0]]]
  774.     lappend result [wm iconbitmap .t] $bit
  775.     wm iconbitmap .t {}
  776.     set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
  777.         WM_HINTS] 0]]]
  778.     lappend result [wm iconbitmap .t] $bit
  779. } {{} questhead 0x4 {} 0x0}
  780. test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} {
  781.     list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
  782. } {1 {bitmap "bad-bitmap" not defined}}
  783.  
  784. test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} {
  785.     list [catch {wm iconify .t 12} msg] $msg
  786. } {1 {wrong # arguments: must be "wm iconify window"}}
  787. test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} {
  788.     catch {destroy .t2}
  789.     toplevel .t2
  790.     wm overrideredirect .t2 1
  791.     set result [list [catch {wm iconify .t2} msg] $msg]
  792.     destroy .t2
  793.     set result
  794. } {1 {can't iconify ".t2": override-redirect flag is set}}
  795. test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} {
  796.     catch {destroy .t2}
  797.     toplevel .t2
  798.     wm geom .t2 +0+0
  799.     wm transient .t2 .t
  800.     set result [list [catch {wm iconify .t2} msg] $msg]
  801.     destroy .t2
  802.     set result
  803. } {1 {can't iconify ".t2": it is a transient}}
  804. test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} {
  805.     catch {destroy .t2}
  806.     toplevel .t2
  807.     wm geom .t2 +0+0
  808.     wm iconwindow .t .t2
  809.     set result [list [catch {wm iconify .t2} msg] $msg]
  810.     destroy .t2
  811.     set result
  812. } {1 {can't iconify .t2: it is an icon for .t}}
  813. test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {
  814.     catch {destroy .t2}
  815.     toplevel .t2
  816.     wm geom .t2 +0+0
  817.     wm iconify .t2
  818.     update
  819.     set result [winfo ismapped .t2]
  820.     destroy .t2
  821.     set result
  822. } {0}
  823. test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {
  824.     catch {destroy .t2}
  825.     toplevel .t2
  826.     wm geom .t2 -0+0
  827.     update
  828.     set result [winfo ismapped .t2]
  829.     wm iconify .t2
  830.     lappend result [winfo ismapped .t2]
  831.     destroy .t2
  832.     set result
  833. } {1 0}
  834.  
  835. test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} {
  836.     list [catch {wm iconmask .t 12 13} msg] $msg
  837. } {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}}
  838. test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} {
  839.     set result {}
  840.     lappend result [wm iconmask .t]
  841.     wm iconmask .t questhead
  842.     set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
  843.         WM_HINTS] 0]]]
  844.     lappend result [wm iconmask .t] $bit
  845.     wm iconmask .t {}
  846.     set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
  847.         WM_HINTS] 0]]]
  848.     lappend result [wm iconmask .t] $bit
  849. } {{} questhead 0x20 {} 0x0}
  850. test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} {
  851.     list [catch {wm iconmask .t bogus} msg] $msg
  852. } {1 {bitmap "bogus" not defined}}
  853.  
  854. test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} {
  855.     list [catch {wm icon .t} msg] $msg
  856. } {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}
  857. test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} {
  858.     list [catch {wm iconname .t 12 13} msg] $msg
  859. } {1 {wrong # arguments: must be "wm iconname window ?newName?"}}
  860. test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} {
  861.     set result {}
  862.     lappend result [wm iconname .t]
  863.     wm iconname .t test_name
  864.     lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
  865.     wm iconname .t {}
  866.     lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
  867. } {{} test_name test_name {} {}}
  868.  
  869. test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} {
  870.     list [catch {wm iconposition .t 12} msg] $msg
  871. } {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
  872. test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} {
  873.     list [catch {wm iconposition .t 12 13 14} msg] $msg
  874. } {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
  875. test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} {
  876.     set result {}
  877.     lappend result [wm iconposition .t]
  878.     wm iconposition .t 10 15
  879.     set prop [testprop [testwrapper .t] WM_HINTS]
  880.     lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6]
  881.     lappend result  [format 0x%x [expr 0x10 & [lindex $prop 0]]]
  882.     wm iconposition .t {} {}
  883.     set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \
  884.         WM_HINTS] 0]]]
  885.     lappend result [wm iconposition .t] $bit
  886. } {{} {10 15} 0xa 0xf 0x10 {} 0x0}
  887. test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} {
  888.     list [catch {wm iconposition .t bad 13} msg] $msg
  889. } {1 {expected integer but got "bad"}}
  890. test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} {
  891.     list [catch {wm iconposition .t 13 lousy} msg] $msg
  892. } {1 {expected integer but got "lousy"}}
  893.  
  894. test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} {
  895.     list [catch {wm iconwindow .t 12 13} msg] $msg
  896. } {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
  897. test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} {
  898.     catch {destroy .icon}
  899.     toplevel .icon -width 50 -height 50 -bg green
  900.     set result {}
  901.     lappend result [wm iconwindow .t]
  902.     wm iconwindow .t .icon
  903.     set prop [testprop [testwrapper .t] WM_HINTS]
  904.     lappend result [wm iconwindow .t] [wm state .icon]
  905.     lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]]
  906.     lappend result [expr [testwrapper .icon] == [lindex $prop 4]]
  907.     wm iconwindow .t {}
  908.     set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \
  909.         WM_HINTS] 0]]]
  910.     lappend result [wm iconwindow .t]  [wm state .icon] $bit
  911.     destroy .icon
  912.     set result
  913. } {{} .icon icon 0x8 1 {} withdrawn 0x0}
  914. test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} {
  915.     list [catch {wm iconwindow .t bogus} msg] $msg
  916. } {1 {bad window path name "bogus"}}
  917. test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} {
  918.     catch {destroy .b}
  919.     button .b -text Help
  920.     set result [list [catch {wm iconwindow .t .b} msg] $msg]
  921.     destroy .b
  922.     set result
  923. } {1 {can't use .b as icon window: not at top level}}
  924. test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} {
  925.     catch {destroy .icon}
  926.     toplevel .icon -width 50 -height 50 -bg green
  927.     catch {destroy .t2}
  928.     toplevel .t2
  929.     wm geom .t2 -0+0
  930.     wm iconwindow .t2 .icon
  931.     set result [list [catch {wm iconwindow .t .icon} msg] $msg]
  932.     destroy .t2
  933.     destroy .icon
  934.     set result
  935. } {1 {.icon is already an icon for .t2}}
  936. test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} {
  937.     catch {destroy .icon}
  938.     catch {destroy .icon2}
  939.     toplevel .icon -width 50 -height 50 -bg green
  940.     toplevel .icon2 -width 50 -height 50 -bg red
  941.     set result {}
  942.     wm iconwindow .t .icon
  943.     lappend result [wm state .icon] [wm state .icon2]
  944.     wm iconwindow .t .icon2
  945.     lappend result [wm state .icon] [wm state .icon2]
  946.     destroy .icon .icon2
  947.     set result
  948. } {icon normal withdrawn icon}
  949. test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} {
  950.     catch {destroy .icon}
  951.     toplevel .icon -width 50 -height 50 -bg green
  952.     wm geometry .icon +0+0
  953.     update
  954.     set result {}
  955.     lappend result [wm state .icon] [winfo viewable .icon]
  956.     wm iconwindow .t .icon
  957.     lappend result [wm state .icon] [winfo viewable .icon]
  958.     destroy .icon
  959.     set result
  960. } {normal 1 icon 0}
  961.  
  962. test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} {
  963.     list [catch {wm maxsize} msg]  $msg
  964. } {1 {wrong # args: should be "wm option window ?arg ...?"}}
  965. test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} {
  966.     list [catch {wm maxsize . a} msg]  $msg
  967. } {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
  968. test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} {
  969.     list [catch {wm maxsize . a b c} msg]  $msg
  970. } {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
  971. test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
  972.     wm maxsize .t
  973. }  {1137 870}
  974. test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} {
  975.     list [catch {wm maxsize . x 100} msg]  $msg
  976. } {1 {expected integer but got "x"}}
  977. test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} {
  978.     list [catch {wm maxsize . 100 bogus} msg]  $msg
  979. } {1 {expected integer but got "bogus"}}
  980. test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} {
  981.     wm maxsize .t 200 150
  982.     wm maxsize .t
  983. } {200 150}
  984. test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
  985.     # Not portable, because some window managers let applications override
  986.     # minsize and maxsize.
  987.  
  988.     wm maxsize .t 200 150
  989.     wm geom .t 300x200
  990.     update
  991.     list [winfo width .t] [winfo height .t]
  992. } {200 150}
  993.  
  994. catch {destroy .t}
  995. catch {destroy .icon}
  996. toplevel .t -width 100 -height 50
  997. wm geom .t +0+0
  998. update
  999.  
  1000. test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} {
  1001.     list [catch {wm minsize} msg]  $msg
  1002. } {1 {wrong # args: should be "wm option window ?arg ...?"}}
  1003. test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} {
  1004.     list [catch {wm minsize . a} msg]  $msg
  1005. } {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
  1006. test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} {
  1007.     list [catch {wm minsize . a b c} msg]  $msg
  1008. } {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
  1009. test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} {
  1010.     wm minsize .t
  1011. }  {1 1}
  1012. test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} {
  1013.     list [catch {wm minsize . x 100} msg]  $msg
  1014. } {1 {expected integer but got "x"}}
  1015. test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} {
  1016.     list [catch {wm minsize . 100 bogus} msg]  $msg
  1017. } {1 {expected integer but got "bogus"}}
  1018. test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} {
  1019.     wm minsize .t 200 150
  1020.     wm minsize .t
  1021. } {200 150}
  1022. test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} {
  1023.     # Not portable, because some window managers let applications override
  1024.     # minsize and maxsize.
  1025.  
  1026.     wm minsize .t 150 100
  1027.     wm geom .t 50x50
  1028.     update
  1029.     list [winfo width .t] [winfo height .t]
  1030. } {150 100}
  1031.  
  1032. catch {destroy .t}
  1033. catch {destroy .icon}
  1034. toplevel .t -width 100 -height 50
  1035. wm geom .t +0+0
  1036. update
  1037.  
  1038. test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} {
  1039.     list [catch {wm overrideredirect .t 1 2} msg]  $msg
  1040. } {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}}
  1041. test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} {
  1042.     list [catch {wm overrideredirect .t boo} msg]  $msg
  1043. } {1 {expected boolean value but got "boo"}}
  1044. test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} {
  1045.     set result {}
  1046.     lappend result [wm overrideredirect .t]
  1047.     wm overrideredirect .t true
  1048.     lappend result [wm overrideredirect .t]
  1049.     wm overrideredirect .t off
  1050.     lappend result [wm overrideredirect .t]
  1051. } {0 1 0}
  1052.  
  1053. test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} {
  1054.     list [catch {wm positionfrom .t 1 2} msg]  $msg
  1055. } {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}}
  1056. test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} {
  1057.     set result {}
  1058.     lappend result [wm positionfrom .t]
  1059.     wm positionfrom .t program
  1060.     update
  1061.     set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
  1062.         WM_NORMAL_HINTS] 0]]]
  1063.     lappend result [wm positionfrom .t] $bit
  1064.     wm positionfrom .t user
  1065.     update
  1066.     set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
  1067.         WM_NORMAL_HINTS] 0]]]
  1068.     lappend result [wm positionfrom .t] $bit
  1069. } {user program 0x4 user 0x1}
  1070. test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} {
  1071.     list [catch {wm positionfrom .t none} msg]  $msg
  1072. } {1 {bad argument "none": must be program or user}}
  1073.  
  1074. test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} {
  1075.     list [catch {wm protocol .t 1 2 3} msg]  $msg
  1076. } {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}}
  1077. test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} {
  1078.     wm protocol .t {foo a} {a b c}
  1079.     wm protocol .t bar {test script for bar}
  1080.     set result [wm protocol .t]
  1081.     wm protocol .t {foo a} {}
  1082.     wm protocol .t bar {}
  1083.     set result
  1084. } {bar {foo a}}
  1085. test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} {
  1086.     set result {}
  1087.     lappend result [wm protocol .t]
  1088.     set x {}
  1089.     foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
  1090.     lappend x [winfo atomname $i]
  1091.     }
  1092.     lappend result $x
  1093.     wm protocol .t foo {test script}
  1094.     wm protocol .t bar {test script}
  1095.     set x {}
  1096.     foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
  1097.     lappend x [winfo atomname $i]
  1098.     }
  1099.     lappend result [wm protocol .t] $x
  1100.     wm protocol .t foo {}
  1101.     wm protocol .t bar {}
  1102.     set x {}
  1103.     foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
  1104.     lappend x [winfo atomname $i]
  1105.     }
  1106.     lappend result [wm protocol .t] $x
  1107. } {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW}
  1108. test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} {
  1109.     set result {}
  1110.     wm protocol .t foo {a b c}
  1111.     wm protocol .t bar {test script for bar}
  1112.     lappend result [wm protocol .t foo] [wm protocol .t bar]
  1113.     wm protocol .t foo {}
  1114.     wm protocol .t bar {}
  1115.     lappend result [wm protocol .t foo] [wm protocol .t bar]
  1116. } {{a b c} {test script for bar} {} {}}
  1117. test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} {
  1118.     wm protocol .t foo {a b c}
  1119.     wm protocol .t foo {test script}
  1120.     set result [wm protocol .t foo]
  1121.     wm protocol .t foo {}
  1122.     set result
  1123. } {test script}
  1124.  
  1125. test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} {
  1126.     list [catch {wm resizable . a} msg]  $msg
  1127. } {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
  1128. test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} {
  1129.     list [catch {wm resizable . a b c} msg]  $msg
  1130. } {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
  1131. test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} {
  1132.     list [catch {wm resizable .foo a b c} msg]  $msg
  1133. } {1 {bad window path name ".foo"}}
  1134. test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} {
  1135.     list [catch {wm resizable . x 1} msg]  $msg
  1136. } {1 {expected boolean value but got "x"}}
  1137. test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} {
  1138.     list [catch {wm resizable . 0 gorp} msg]  $msg
  1139. } {1 {expected boolean value but got "gorp"}}
  1140. test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} {
  1141.     catch {destroy .t2}
  1142.     toplevel .t2 -width 200 -height 100
  1143.     wm geom .t2 +0+0
  1144.     set result ""
  1145.     lappend result [wm resizable .t2]
  1146.     wm resizable .t2 1 0
  1147.     lappend result [wm resizable .t2]
  1148.     wm resizable .t2 no off
  1149.     lappend result [wm resizable .t2]
  1150.     wm resizable .t2 false true
  1151.     lappend result [wm resizable .t2]
  1152.     destroy .t2
  1153.     set result
  1154. } {{1 1} {1 0} {0 0} {0 1}}
  1155.  
  1156. test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} {
  1157.     list [catch {wm sizefrom .t 1 2} msg]  $msg
  1158. } {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}}
  1159. test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} {
  1160.     set result {}
  1161.     lappend result [wm sizefrom .t]
  1162.     wm sizefrom .t program
  1163.     update
  1164.     set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
  1165.         WM_NORMAL_HINTS] 0]]]
  1166.     lappend result [wm sizefrom .t] $bit
  1167.     wm sizefrom .t user
  1168.     update
  1169.     set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
  1170.         WM_NORMAL_HINTS] 0]]]
  1171.     lappend result [wm sizefrom .t] $bit
  1172. } {{} program 0x8 user 0x2}
  1173. test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} {
  1174.     list [catch {wm sizefrom .t none} msg]  $msg
  1175. } {1 {bad argument "none": must be program or user}}
  1176.  
  1177. test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {
  1178.     list [catch {wm state .t 1} msg]  $msg
  1179. } {1 {wrong # arguments: must be "wm state window"}}
  1180. test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
  1181.     set result {}
  1182.     catch {destroy .t2}
  1183.     toplevel .t2 -width 120 -height 300
  1184.     wm geometry .t2 +0+0
  1185.     lappend result [wm state .t2]
  1186.     update
  1187.     lappend result [wm state .t2]
  1188.     wm withdraw .t2
  1189.     lappend result [wm state .t2]
  1190.     wm iconify .t2
  1191.     lappend result [wm state .t2]
  1192.     wm deiconify .t2
  1193.     lappend result [wm state .t2]
  1194.     destroy .t2
  1195.     set result
  1196. } {normal normal withdrawn iconic normal}
  1197.  
  1198. test unixWm-36.1 {Tk_WmCmd procedure, "title" option} {
  1199.     list [catch {wm title .t 1 2} msg]  $msg
  1200. } {1 {wrong # arguments: must be "wm title window ?newTitle?"}}
  1201. test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} {
  1202.     set result {}
  1203.     lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
  1204.     wm title .t "Test window"
  1205.     set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
  1206.         WM_NORMAL_HINTS] 0]]]
  1207.     lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
  1208. } {t t {Test window} {Test window}}
  1209.  
  1210. test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} {
  1211.     list [catch {wm transient .t 1 2} msg]  $msg
  1212. } {1 {wrong # arguments: must be "wm transient window ?master?"}}
  1213. test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} {
  1214.     list [catch {wm transient .t foo} msg]  $msg
  1215. } {1 {bad window path name "foo"}}
  1216. test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} {
  1217.     set result {}
  1218.     catch {destroy .t2}
  1219.     toplevel .t2 -width 120 -height 300
  1220.     wm geometry .t2 +0+0
  1221.     update
  1222.     lappend result [wm transient .t2] \
  1223.         [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
  1224.     wm transient .t2 .t
  1225.     set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
  1226.     lappend result [wm transient .t2] [expr [testwrapper .t] - $transient]
  1227.     wm transient .t2 {}
  1228.     lappend result [wm transient .t2] \
  1229.         [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
  1230.     destroy .t2
  1231.     set result
  1232. } {{} {} .t 0 {} 0x0}
  1233. test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} {
  1234.     catch {destroy .t2}
  1235.     catch {destroy .t3}
  1236.     toplevel .t2 -width 120 -height 300
  1237.     wm geometry .t2 +0+0
  1238.     toplevel .t3 -width 120 -height 300
  1239.     wm geometry .t2 +0+0
  1240.     set result [list [testwrapper .t2]]
  1241.     wm transient .t3 .t2
  1242.     lappend result [expr {[testwrapper .t2] == ""}]
  1243.     destroy .t2 .t3
  1244.     set result
  1245. } {{} 0}
  1246.  
  1247. test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} {
  1248.     list [catch {wm withdraw .t 1} msg]  $msg
  1249. } {1 {wrong # arguments: must be "wm withdraw window"}}
  1250. test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} {
  1251.     catch {destroy .t2}
  1252.     toplevel .t2 -width 120 -height 300
  1253.     wm geometry .t2 +0+0
  1254.     wm iconwindow .t .t2
  1255.     set result [list [catch {wm withdraw .t2} msg]  $msg]
  1256.     destroy .t2
  1257.     set result
  1258. } {1 {can't withdraw .t2: it is an icon for .t}}
  1259. test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} {
  1260.     set result {}
  1261.     wm withdraw .t
  1262.     lappend result [wm state .t] [winfo ismapped .t]
  1263.     wm deiconify .t
  1264.     lappend result [wm state .t] [winfo ismapped .t]
  1265. } {withdrawn 0 normal 1}
  1266.  
  1267. test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} {
  1268.     list [catch {wm unknown .t} msg] $msg
  1269. } {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}
  1270.  
  1271. catch {destroy .t}
  1272. catch {destroy .icon}
  1273.  
  1274. test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {nonPortable} {
  1275.     catch {destroy .t}
  1276.     toplevel .t
  1277.     wm geometry .t 30x10+0+0
  1278.     listbox .t.l -height 20 -width 20 -setgrid 1 
  1279.     pack .t.l -fill both -expand 1
  1280.     update
  1281.     wm geometry .t
  1282. } {30x10+0+0}
  1283. test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} {
  1284.     catch {destroy .t}
  1285.     toplevel .t
  1286.     wm geometry .t 200x100+0+0
  1287.     listbox .t.l -height 20 -width 20 
  1288.     pack .t.l -fill both -expand 1
  1289.     update
  1290.     .t.l configure -setgrid 1
  1291.     update
  1292.     wm geometry .t
  1293. } {20x20+0+0}
  1294.  
  1295. test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
  1296.     catch {destroy .t}
  1297.     toplevel .t -width 400 -height 150
  1298.     wm geometry .t +0+0
  1299.     tkwait visibility .t
  1300.     set result {}
  1301.     lappend result [winfo width .t] [winfo height .t]
  1302.     .t configure -width 200 -height 300
  1303.     sleep 500
  1304.     lappend result [winfo width .t] [winfo height .t]
  1305. } {400 150 200 300}
  1306. test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
  1307.     catch {destroy .t}
  1308.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  1309.     wm geom .t +0+0
  1310.     update
  1311.     set x [winfo rootx .t]
  1312.     set y [winfo rooty .t]
  1313.     frame .t.m -bd 2 -relief raised -height 20
  1314.     testmenubar window .t .t.m
  1315.     update
  1316.     set result {}
  1317.     bind .t <Configure> {
  1318.     if {"%W" == ".t"} {
  1319.         lappend result "%W: %wx%h"
  1320.     }
  1321.     }
  1322.     bind .t.m <Configure> {lappend result "%W: %wx%h"}
  1323.     wm geometry .t 200x300
  1324.     update
  1325.     lappend result [expr [winfo rootx .t.m] - $x] \
  1326.         [expr [winfo rooty .t.m] - $y] \
  1327.         [winfo width .t.m] [winfo height .t.m] \
  1328.         [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] \
  1329.         [winfo width .t] [winfo height .t]
  1330. } {{.t.m: 200x20} {.t: 200x300} 0 0 200 20 0 20 200 300}
  1331. test unixWm-41.3 {ConfigureEvent procedure, synthesized Configure events} {
  1332.     catch {destroy .t}
  1333.     toplevel .t -width 400 -height 150
  1334.     wm geometry .t +0+0
  1335.     tkwait visibility .t
  1336.     set result {no event}
  1337.     bind .t <Configure> {set result "configured: %w %h"}
  1338.     wm geometry .t +10+20
  1339.     update
  1340.     set result
  1341. } {configured: 400 150}
  1342. test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} {
  1343.     catch {destroy .t}
  1344.     toplevel .t -width 400 -height 150
  1345.     wm geometry .t +0+0
  1346.     tkwait visibility .t
  1347.     set result {no event}
  1348.     bind .t <Configure> {set result "configured: %w %h"}
  1349.     wm geometry .t 130x200
  1350.     update
  1351.     set result
  1352. } {configured: 130 200}
  1353.  
  1354. # No tests for ReparentEvent or ComputeReparentGeometry; I can't figure
  1355. # out how to exercise these procedures reliably.
  1356.  
  1357. test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {
  1358.     catch {destroy .t}
  1359.     toplevel .t -width 400 -height 150
  1360.     wm geometry .t +0+0
  1361.     tkwait visibility .t
  1362.     set result {}
  1363.     bind .t <Map> {set x "mapped"}
  1364.     bind .t <Unmap> {set x "unmapped"}
  1365.     set x {no event}
  1366.     wm iconify .t
  1367.     lappend result $x [winfo ismapped .t]
  1368.     set x {no event}
  1369.     wm deiconify .t
  1370.     lappend result $x [winfo ismapped .t]
  1371. } {unmapped 0 mapped 1}
  1372.  
  1373. test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} {
  1374.     catch {destroy .t}
  1375.     toplevel .t -width 200 -height 200
  1376.     wm geom .t +0+0
  1377.     frame .t.f -container 1 -bd 2 -relief raised
  1378.     place .t.f -x 20 -y 10
  1379.     tkwait visibility .t.f
  1380.     toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -bg blue
  1381.     tkwait visibility .t2
  1382.     set result {}
  1383.     .t2 configure -width 70 -height 120
  1384.     update
  1385.     lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
  1386.     lappend result [winfo width .t2] [winfo height .t2]
  1387.     # destroy .t2
  1388.     set result
  1389. } {70 120 70 120}
  1390. test unixWm-43.2 {TopLevelReqProc procedure, resize causes window to move} \
  1391.     {nonPortable} {
  1392.     catch {destroy .t}
  1393.     toplevel .t -width 200 -height 200
  1394.     wm geom .t +0+0
  1395.     update
  1396.     wm geom .t -0-0
  1397.     update
  1398.     set x [winfo x .t]
  1399.     set y [winfo y .t]
  1400.     .t configure -width 300 -height 150
  1401.     update
  1402.     list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
  1403.         [winfo width .t] [winfo height .t]
  1404. } {-100 50 300 150}
  1405.  
  1406. test unixWm-44.1 {UpdateGeometryInfo procedure, width/height computation} {
  1407.     catch {destroy .t}
  1408.     toplevel .t -width 100 -height 200
  1409.     wm geometry .t +30+40
  1410.     wm overrideredirect .t 1
  1411.     tkwait visibility .t
  1412.     .t configure  -width 180 -height 20
  1413.     update
  1414.     list [winfo width .t] [winfo height .t]
  1415. } {180 20}
  1416. test unixWm-44.2 {UpdateGeometryInfo procedure, width/height computation} {
  1417.     catch {destroy .t}
  1418.     toplevel .t -width 80 -height 60
  1419.     wm grid .t 5 4 10 12
  1420.     wm geometry .t +30+40
  1421.     wm overrideredirect .t 1
  1422.     tkwait visibility .t
  1423.     wm geometry .t 10x2
  1424.     update
  1425.     list [winfo width .t] [winfo height .t]
  1426. } {130 36}
  1427. test unixWm-44.3 {UpdateGeometryInfo procedure, width/height computation} {
  1428.     catch {destroy .t}
  1429.     toplevel .t -width 80 -height 60
  1430.     wm grid .t 5 4 10 12
  1431.     wm geometry .t +30+40
  1432.     wm overrideredirect .t 1
  1433.     tkwait visibility .t
  1434.     wm geometry .t 1x10
  1435.     update
  1436.     list [winfo width .t] [winfo height .t]
  1437. } {40 132}
  1438. test unixWm-44.4 {UpdateGeometryInfo procedure, width/height computation} {
  1439.     catch {destroy .t}
  1440.     toplevel .t -width 100 -height 200
  1441.     wm geometry .t +30+40
  1442.     wm overrideredirect .t 1
  1443.     tkwait visibility .t
  1444.     wm geometry .t 300x150
  1445.     update
  1446.     list [winfo width .t] [winfo height .t]
  1447. } {300 150}
  1448. test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} {
  1449.     catch {destroy .t}
  1450.     toplevel .t -width 80 -height 60
  1451.     wm grid .t 18 7 10 12
  1452.     wm geometry .t +30+40
  1453.     wm overrideredirect .t 1
  1454.     tkwait visibility .t
  1455.     wm geometry .t 5x8
  1456.     update
  1457.     list [winfo width .t] [winfo height .t]
  1458. } {1 72}
  1459. test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
  1460.     catch {destroy .t}
  1461.     toplevel .t -width 80 -height 60
  1462.     wm grid .t 18 7 10 12
  1463.     wm geometry .t +30+40
  1464.     wm overrideredirect .t 1
  1465.     tkwait visibility .t
  1466.     wm geometry .t 20x1
  1467.     update
  1468.     list [winfo width .t] [winfo height .t]
  1469. } {100 1}
  1470. test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
  1471.     catch {destroy .t}
  1472.     toplevel .t -width 80 -height 60
  1473.     wm geometry .t +5-10
  1474.     wm overrideredirect .t 1
  1475.     tkwait visibility .t
  1476.     list [winfo x .t] [winfo y .t]
  1477. } "5 [expr [winfo screenheight .t] - 70]"
  1478. test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
  1479.     catch {destroy .t}
  1480.     toplevel .t -width 80 -height 60
  1481.     wm geometry .t -30+2
  1482.     wm overrideredirect .t 1
  1483.     tkwait visibility .t
  1484.     list [winfo x .t] [winfo y .t]
  1485. } "[expr [winfo screenwidth .t] - 110] 2"
  1486. test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
  1487.     catch {destroy .t}
  1488.     toplevel .t -width 80 -height 60
  1489.     wm resizable .t 0 0
  1490.     wm geometry .t +0+0
  1491.     tkwait visibility .t
  1492.     .t configure  -width 180 -height 20
  1493.     update
  1494.     set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
  1495.     list [expr [lindex $property 5]] [expr [lindex $property 6]] \
  1496.         [expr [lindex $property 7]] [expr [lindex $property 8]]
  1497. } {180 20 180 20}
  1498. test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} {
  1499.     catch {destroy .t}
  1500.     toplevel .t -width 80 -height 60
  1501.     wm resizable .t 0 0
  1502.     wm geometry .t +0+0
  1503.     tkwait visibility .t
  1504.     .t configure -width 180 -height 50
  1505.     frame .t.m -bd 2 -relief raised -width 100 -height 50
  1506.     testmenubar window .t .t.m
  1507.     update
  1508.     .t configure -height 70
  1509.     .t.m configure -height 30
  1510.     list [update] [destroy .t]
  1511. } {{} {}}
  1512.  
  1513. test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} {
  1514.     catch {destroy .t}
  1515.     toplevel .t -width 80 -height 60
  1516.     wm grid .t 6 10 10 5
  1517.     wm minsize .t 2 4
  1518.     wm maxsize .t 30 40
  1519.     wm geometry .t +0+0
  1520.     tkwait visibility .t
  1521.     set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
  1522.     list [expr [lindex $property 5]] [expr [lindex $property 6]] \
  1523.         [expr [lindex $property 7]] [expr [lindex $property 8]] \
  1524.         [expr [lindex $property 9]] [expr [lindex $property 10]]
  1525. } {40 30 320 210 10 5}
  1526. test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} {
  1527.     catch {destroy .t}
  1528.     toplevel .t -width 80 -height 60
  1529.     wm minsize .t 30 40
  1530.     wm maxsize .t 200 500
  1531.     wm geometry .t +0+0
  1532.     tkwait visibility .t
  1533.     set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
  1534.     list [expr [lindex $property 5]] [expr [lindex $property 6]] \
  1535.         [expr [lindex $property 7]] [expr [lindex $property 8]] \
  1536.         [expr [lindex $property 9]] [expr [lindex $property 10]]
  1537. } {30 40 200 500 1 1}
  1538. test unixWm-46.3 {UpdateSizeHints procedure, grid with menu} {
  1539.     catch {destroy .t}
  1540.     toplevel .t -width 80 -height 60
  1541.     frame .t.menu -height 23 -width 50
  1542.     testmenubar window .t .t.menu
  1543.     wm grid .t 6 10 10 5
  1544.     wm minsize .t 2 4
  1545.     wm maxsize .t 30 40
  1546.     wm geometry .t +0+0
  1547.     tkwait visibility .t
  1548.     set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
  1549.     list [winfo height .t] \
  1550.         [expr [lindex $property 5]] [expr [lindex $property 6]] \
  1551.         [expr [lindex $property 7]] [expr [lindex $property 8]] \
  1552.         [expr [lindex $property 9]] [expr [lindex $property 10]]
  1553. } {60 40 53 320 233 10 5}
  1554. test unixWm-46.4 {UpdateSizeHints procedure, not resizable with menu} {
  1555.     catch {destroy .t}
  1556.     toplevel .t -width 80 -height 60
  1557.     frame .t.menu -height 23 -width 50
  1558.     testmenubar window .t .t.menu
  1559.     wm resizable .t 0 0
  1560.     wm geometry .t +0+0
  1561.     tkwait visibility .t
  1562.     set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
  1563.     list [winfo height .t] \
  1564.         [expr [lindex $property 5]] [expr [lindex $property 6]] \
  1565.         [expr [lindex $property 7]] [expr [lindex $property 8]] \
  1566.         [expr [lindex $property 9]] [expr [lindex $property 10]]
  1567. } {60 80 83 80 83 1 1}
  1568.  
  1569. # I don't know how to test WaitForConfigureNotify.
  1570.  
  1571. test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} {
  1572.     catch {destroy .t}
  1573.     toplevel .t -width 200 -height 200
  1574.     wm geom .t +0+0
  1575.     update
  1576.     wm iconify .t
  1577.     set x no
  1578.     after 0 {set x yes}
  1579.     wm deiconify .t
  1580.     set result $x
  1581.     update
  1582.     list $result $x
  1583. } {no yes}
  1584.  
  1585. test unixWm-47.1 {WaitRestrictProc procedure} {
  1586.     catch {destroy .t}
  1587.     toplevel .t -width 300 -height 200
  1588.     frame .t.f -bd 2 -relief raised
  1589.     place .t.f -x 20 -y 30 -width 100 -height 20
  1590.     wm geometry .t +0+0
  1591.     tkwait visibility .t
  1592.     set result {}
  1593.     bind .t.f <Configure> {lappend result {configure on .t.f}}
  1594.     bind .t <Map> {lappend result {map on .t}}
  1595.     bind .t <Unmap> {lappend result {unmap on .t}; bind .t <Unmap> {}}
  1596.     bind .t <Button> {lappend result {button %b on .t}}
  1597.     event generate .t.f <Configure> -when tail
  1598.     event generate .t <Configure> -when tail
  1599.     event generate .t <Button> -button 3 -when tail
  1600.     event generate .t <Map> -when tail
  1601.     lappend result iconify
  1602.     wm iconify .t
  1603.     lappend result done
  1604.     update
  1605.     set result
  1606. } {iconify {unmap on .t} done {configure on .t.f} {button 3 on .t} {map on .t}}
  1607.  
  1608. # I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints.
  1609.  
  1610. catch {destroy .t}
  1611. toplevel .t -width 300 -height 200
  1612. wm geometry .t +0+0
  1613. tkwait visibility .t
  1614.  
  1615. test unixWm-48.1 {ParseGeometry procedure} {
  1616.     wm geometry .t =100x120
  1617.     update
  1618.     list [winfo width .t] [winfo height .t]
  1619. } {100 120}
  1620. test unixWm-48.2 {ParseGeometry procedure} {
  1621.     list [catch {wm geometry .t =10zx120} msg] $msg
  1622. } {1 {bad geometry specifier "=10zx120"}}
  1623. test unixWm-48.3 {ParseGeometry procedure} {
  1624.     list [catch {wm geometry .t x120} msg] $msg
  1625. } {1 {bad geometry specifier "x120"}}
  1626. test unixWm-48.4 {ParseGeometry procedure} {
  1627.     list [catch {wm geometry .t =100x120a} msg] $msg
  1628. } {1 {bad geometry specifier "=100x120a"}}
  1629. test unixWm-48.5 {ParseGeometry procedure} {
  1630.     list [catch {wm geometry .t z} msg] $msg
  1631. } {1 {bad geometry specifier "z"}}
  1632. test unixWm-48.6 {ParseGeometry procedure} {
  1633.     list [catch {wm geometry .t +20&} msg] $msg
  1634. } {1 {bad geometry specifier "+20&"}}
  1635. test unixWm-48.7 {ParseGeometry procedure} {
  1636.     list [catch {wm geometry .t +-} msg] $msg
  1637. } {1 {bad geometry specifier "+-"}}
  1638. test unixWm-48.8 {ParseGeometry procedure} {
  1639.     list [catch {wm geometry .t +20a} msg] $msg
  1640. } {1 {bad geometry specifier "+20a"}}
  1641. test unixWm-48.9 {ParseGeometry procedure} {
  1642.     list [catch {wm geometry .t +20-} msg] $msg
  1643. } {1 {bad geometry specifier "+20-"}}
  1644. test unixWm-48.10 {ParseGeometry procedure} {
  1645.     list [catch {wm geometry .t +20+10z} msg] $msg
  1646. } {1 {bad geometry specifier "+20+10z"}}
  1647. test unixWm-48.11 {ParseGeometry procedure} {
  1648.     catch {wm geometry .t +-10+20}
  1649. } {0}
  1650. test unixWm-48.12 {ParseGeometry procedure} {
  1651.     catch {wm geometry .t +30+-10}
  1652. } {0}
  1653. test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} {
  1654.     catch {destroy .t}
  1655.     toplevel .t -width 200 -height 200
  1656.     wm geom .t +0+0
  1657.     update
  1658.     wm geom .t -0-0
  1659.     update
  1660.     set x [winfo x .t]
  1661.     set y [winfo y .t]
  1662.     wm geometry .t 150x300
  1663.     update
  1664.     list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
  1665.         [winfo width .t] [winfo height .t]
  1666. } {50 -100 150 300}
  1667.  
  1668. test unixWm-49.1 {Tk_GetRootCoords procedure} {
  1669.     catch {destroy .t}
  1670.     toplevel .t -width 300 -height 200
  1671.     frame .t.f -width 150 -height 100 -bd 2 -relief raised
  1672.     place .t.f -x 150 -y 120
  1673.     frame .t.f.f -width 20 -height 20 -bd 2 -relief raised
  1674.     place .t.f.f -x 10 -y 20
  1675.     wm overrideredirect .t 1
  1676.     wm geometry .t +40+50
  1677.     tkwait visibility .t
  1678.     list [winfo rootx .t.f.f] [winfo rooty .t.f.f]
  1679. } {202 192}
  1680. test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} {
  1681.     catch {destroy .t}
  1682.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  1683.     wm geom .t +0+0
  1684.     update
  1685.     set x [winfo rootx .t]
  1686.     set y [winfo rooty .t]
  1687.     frame .t.m -bd 2 -relief raised -width 100 -height 30
  1688.     frame .t.m.f -width 20 -height 10 -bd 2 -relief raised
  1689.     place .t.m.f -x 50 -y 5
  1690.     frame .t.f -width 20 -height 30 -bd 2 -relief raised
  1691.     place .t.f -x 10 -y 30
  1692.     testmenubar window .t .t.m
  1693.     update
  1694.     list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \
  1695.         [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] 
  1696. } {52 7 12 62}
  1697.  
  1698. foreach w [winfo children .] {
  1699.     catch {destroy $w}
  1700. }
  1701. wm iconify .
  1702. test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
  1703.     eval destroy [winfo children .]
  1704.     toplevel .t -width 300 -height 400 -bg green
  1705.     wm geom .t +40+0
  1706.     tkwait visibility .t
  1707.     toplevel .t2 -width 100 -height 80 -bg red
  1708.     wm geom .t2 +140+200
  1709.     tkwait visibility .t2
  1710.     raise .t2
  1711.     set x [winfo rootx .t]
  1712.     set y [winfo rooty .t]
  1713.     list [winfo containing [expr $x - 30] [expr $y + 250]] \
  1714.         [winfo containing [expr $x - 1] [expr $y + 250]] \
  1715.         [winfo containing $x [expr $y + 250]] \
  1716.         [winfo containing [expr $x + 99] [expr $y + 250]] \
  1717.         [winfo containing [expr $x + 100] [expr $y + 250]] \
  1718.         [winfo containing [expr $x + 199] [expr $y + 250]] \
  1719.         [winfo containing [expr $x + 200] [expr $y + 250]] \
  1720.         [winfo containing [expr $x + 220] [expr $y + 250]]
  1721. } {{} {} .t {} .t2 .t2 {} .t}
  1722. test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} {
  1723.     eval destroy [winfo children .]
  1724.     toplevel .t -width 300 -height 400 -bg yellow
  1725.     wm geom .t +0+50
  1726.     tkwait visibility .t
  1727.     toplevel .t2 -width 100 -height 80 -bg blue
  1728.     wm overrideredirect .t2 1
  1729.     wm geom .t2 +100+200
  1730.     tkwait visibility .t2
  1731.     raise .t2
  1732.     set x [winfo rootx .t]
  1733.     set y [winfo rooty .t]
  1734.     set y2 [winfo rooty .t2]
  1735.     list [winfo containing [expr $x +150] 10] \
  1736.         [winfo containing [expr $x +150] [expr $y - 1]] \
  1737.         [winfo containing [expr $x +150] $y] \
  1738.         [winfo containing [expr $x +150] [expr $y2 - 1]] \
  1739.         [winfo containing [expr $x +150] $y2] \
  1740.         [winfo containing [expr $x +150] [expr $y2 + 79]] \
  1741.         [winfo containing [expr $x +150] [expr $y2 + 80]] \
  1742.         [winfo containing [expr $x +150] [expr $y + 450]]
  1743. } {{} {} .t .t .t2 .t2 .t {}}
  1744. test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} {
  1745.     eval destroy [winfo children .]
  1746.     toplevel .t -width 300 -height 400 -bg blue
  1747.     wm geom .t +0+50
  1748.     frame .t.f -container 1
  1749.     place .t.f -x 150 -y 50
  1750.     tkwait visibility .t.f
  1751.     setupbg
  1752.     dobg "
  1753.     wm withdraw .
  1754.     toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow
  1755.     tkwait visibility .x"
  1756.     set result [dobg {
  1757.     set x [winfo rootx .x]
  1758.     set y [winfo rooty .x]
  1759.     list [winfo containing [expr $x - 1] [expr $y + 50]] \
  1760.         [winfo containing $x [expr $y +50]]
  1761.     }]
  1762.     set x [winfo rootx .t]
  1763.     set y [winfo rooty .t]
  1764.     lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \
  1765.         [winfo containing [expr $x + 200] [expr $y +50]]
  1766. } {{} .x .t .t.f}
  1767. cleanupbg
  1768. test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} {
  1769.     catch {destroy .t}
  1770.     catch {interp delete slave}
  1771.     toplevel .t -width 200 -height 200 -bg green
  1772.     wm geometry .t +0+0
  1773.     tkwait visibility .t
  1774.     interp create slave
  1775.     load {} tk slave
  1776.     slave eval {wm geometry . 200x200+0+0; tkwait visibility .}
  1777.     set result [list [winfo containing 100 100] \
  1778.         [slave eval {winfo containing 100 100}]]
  1779.     interp delete slave
  1780.     set result
  1781. } {{} .}
  1782. test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} {
  1783.     eval destroy [winfo children .]
  1784.     toplevel .t -width 300 -height 400 -bd 2 -relief raised
  1785.     frame .t.f -width 150 -height 120 -bg green
  1786.     place .t.f -x 10 -y 150
  1787.     wm geom .t +0+50
  1788.     frame .t.menu -width 100 -height 30 -bd 2 -relief raised
  1789.     frame .t.menu.f -width 40 -height 20 -bg purple
  1790.     place .t.menu.f -x 30 -y 10
  1791.     testmenubar window .t .t.menu
  1792.     tkwait visibility .t.menu
  1793.     update
  1794.     set x [winfo rootx .t]
  1795.     set y [winfo rooty .t]
  1796.     list [winfo containing $x [expr $y - 31]] \
  1797.         [winfo containing $x [expr $y - 30]] \
  1798.         [winfo containing [expr $x + 50] [expr $y - 19]] \
  1799.         [winfo containing [expr $x + 50] [expr $y - 18]] \
  1800.         [winfo containing [expr $x + 50] $y] \
  1801.         [winfo containing [expr $x + 11] [expr $y + 152]] \
  1802.         [winfo containing [expr $x + 12] [expr $y + 152]]
  1803. } {{} .t.menu .t.menu .t.menu.f .t .t .t.f}
  1804. test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} {
  1805.     eval destroy [winfo children .]
  1806.     toplevel .t -width 300 -height 400 -bg orange
  1807.     wm geom .t +0+50
  1808.     frame .t.f -container 1
  1809.     place .t.f -x 150 -y 50
  1810.     tkwait visibility .t.f
  1811.     toplevel .t2 -width 100 -height 80 -bg green -use [winfo id .t.f]
  1812.     tkwait visibility .t2
  1813.     update
  1814.     set x [winfo rootx .t]
  1815.     set y [winfo rooty .t]
  1816.     list [winfo containing [expr $x +149] [expr $y + 80]] \
  1817.         [winfo containing [expr $x +150] [expr $y +80]] \
  1818.         [winfo containing [expr $x +249] [expr $y +80]] \
  1819.         [winfo containing [expr $x +250] [expr $y +80]]
  1820. } {.t .t2 .t2 .t}
  1821. test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} {
  1822.     catch {destroy .t}
  1823.     toplevel .t -width 300 -height 400 -bg green
  1824.     wm geom .t +0+0
  1825.     frame .t.f -width 100 -height 200 -bd 2 -relief raised
  1826.     place .t.f -x 100 -y 100
  1827.     frame .t.f.f -width 100 -height 200 -bd 2 -relief raised
  1828.     place .t.f.f -x 0 -y 100
  1829.     tkwait visibility .t.f.f
  1830.     set x [expr [winfo rootx .t] + 150]
  1831.     set y [winfo rooty .t]
  1832.     list [winfo containing $x [expr $y + 50]] \
  1833.         [winfo containing $x [expr $y + 150]] \
  1834.         [winfo containing $x [expr $y + 250]] \
  1835.         [winfo containing $x [expr $y + 350]] \
  1836.         [winfo containing $x [expr $y + 450]]
  1837. } {.t .t.f .t.f.f .t {}}
  1838. test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} {
  1839.     catch {destroy .t}
  1840.     toplevel .t -width 400 -height 300 -bg green
  1841.     wm geom .t +0+0
  1842.     frame .t.f -width 200 -height 100 -bd 2 -relief raised
  1843.     place .t.f -x 100 -y 100
  1844.     frame .t.f.f -width 200 -height 100 -bd 2 -relief raised
  1845.     place .t.f.f -x 100 -y 0
  1846.     update
  1847.     set x [winfo rooty .t]
  1848.     set y [expr [winfo rooty .t] + 150]
  1849.     list [winfo containing [expr $x + 50] $y] \
  1850.         [winfo containing [expr $x + 150] $y] \
  1851.         [winfo containing [expr $x + 250] $y] \
  1852.         [winfo containing [expr $x + 350] $y] \
  1853.         [winfo containing [expr $x + 450] $y]
  1854. } {.t .t.f .t.f.f .t {}}
  1855. test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {
  1856.     catch {destroy .t}
  1857.     catch {destroy .t2}
  1858.     sleep 500        ;# Give window manager time to catch up.
  1859.     toplevel .t -width 200 -height 200 -bg green
  1860.     wm geometry .t +0+0
  1861.     tkwait visibility .t
  1862.     toplevel .t2 -width 200 -height 200 -bg red
  1863.     wm geometry .t2 +0+0
  1864.     tkwait visibility .t2
  1865.     set result [list [winfo containing 100 100]]
  1866.     wm iconify .t2
  1867.     lappend result [winfo containing 100 100]
  1868. } {.t2 .t}
  1869. test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} {
  1870.     catch {destroy .t}
  1871.     toplevel .t -width 200 -height 200 -bg green
  1872.     wm geometry .t +0+0
  1873.     frame .t.f -width 150 -height 150 -bd 2 -relief raised
  1874.     place .t.f -x 25 -y 25
  1875.     tkwait visibility .t.f
  1876.     set result [list [winfo containing 100 100]]
  1877.     place forget .t.f
  1878.     update
  1879.     lappend result [winfo containing 100 100]
  1880. } {.t.f .t}
  1881. eval destroy [winfo children .]
  1882. wm deiconify .
  1883.  
  1884. # No tests for UpdateVRootGeometry, Tk_GetVRootGeometry,
  1885. # Tk_MoveToplevelWindow, UpdateWmProtocols, or TkWmProtocolEventProc.
  1886.  
  1887. test unixWm-51.1 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
  1888.     makeToplevels
  1889.     update
  1890.     raise .raise1
  1891.     winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
  1892. } .raise1
  1893. test unixWm-51.2 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
  1894.     makeToplevels
  1895.     update
  1896.     raise .raise2
  1897.     winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
  1898. } .raise2
  1899. test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
  1900.     makeToplevels
  1901.     update
  1902.     raise .raise3
  1903.     raise .raise2
  1904.     raise .raise1 .raise3
  1905.     set result [winfo containing [winfo rootx .raise1] \
  1906.         [winfo rooty .raise1]]
  1907.     destroy .raise2
  1908.     sleep 500
  1909.     list $result [winfo containing [winfo rootx .raise1] \
  1910.         [winfo rooty .raise1]]
  1911. } {.raise2 .raise1}
  1912. test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
  1913.     makeToplevels
  1914.     raise .raise2
  1915.     raise .raise1
  1916.     lower .raise3 .raise1
  1917.     set result [winfo containing 100 100]
  1918.     destroy .raise1
  1919.     sleep 500
  1920.     lappend result [winfo containing 100 100]
  1921. } {.raise1 .raise3}
  1922. test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
  1923.     makeToplevels
  1924.     update
  1925.     raise .raise2
  1926.     raise .raise1
  1927.     raise .raise3
  1928.     frame .raise1.f1
  1929.     frame .raise1.f1.f2
  1930.     lower .raise3 .raise1.f1.f2
  1931.     set result [winfo containing [winfo rootx .raise1] \
  1932.         [winfo rooty .raise1]]
  1933.     destroy .raise1
  1934.     sleep 500
  1935.     list $result [winfo containing [winfo rootx .raise2] \
  1936.         [winfo rooty .raise2]]
  1937. } {.raise1 .raise3}
  1938. foreach w [winfo children .] {
  1939.     catch {destroy $w}
  1940. }
  1941. test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} {
  1942.     catch {destroy .t}
  1943.     toplevel .t -width 200 -height 200 -bg green
  1944.     wm geometry .t +0+0
  1945.     tkwait visibility .t
  1946.     catch {destroy .t2}
  1947.     toplevel .t2 -width 200 -height 200 -bg red
  1948.     wm geometry .t2 +0+0
  1949.     winfo containing 100 100
  1950. } {.t}
  1951. test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {
  1952.     foreach w {.t .t2 .t3} {
  1953.     catch {destroy $w}
  1954.     toplevel $w -width 200 -height 200 -bg green
  1955.     wm geometry $w +0+0
  1956.     }
  1957.     raise .t .t2
  1958.     update
  1959.     set result [list [winfo containing 100 100]]
  1960.     lower .t3
  1961.     lappend result [winfo containing 100 100]
  1962. } {.t3 .t}
  1963. test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} {
  1964.     catch {destroy .t}
  1965.     toplevel .t -width 200 -height 200 -bg green
  1966.     wm overrideredirect .t 1
  1967.     wm geometry .t +0+0
  1968.     tkwait visibility .t
  1969.     catch {destroy .t2}
  1970.     toplevel .t2 -width 200 -height 200 -bg red
  1971.     wm overrideredirect .t2 1
  1972.     wm geometry .t2 +0+0
  1973.     tkwait visibility .t2
  1974.  
  1975.     # Need to use vrootx and vrooty to make tests work correctly with
  1976.     # virtual root window measures managers: overrideredirect windows
  1977.     # come up at (0,0) in display coordinates, not virtual root
  1978.     # coordinates.
  1979.  
  1980.     set x [expr 100-[winfo vrootx .]]
  1981.     set y [expr 100-[winfo vrooty .]]
  1982.     set result [list [winfo containing $x $y]]
  1983.     raise .t
  1984.     lappend result [winfo containing $x $y]
  1985.     raise .t2
  1986.     lappend result [winfo containing $x $y]
  1987. } {.t2 .t .t2}
  1988. test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} {
  1989.     foreach w {.t .t2 .t3} {
  1990.     catch {destroy $w}
  1991.     toplevel $w -width 200 -height 200 -bg green
  1992.     wm overrideredirect $w 1
  1993.     wm geometry $w +0+0
  1994.     tkwait visibility $w
  1995.     }
  1996.     lower .t3 .t2
  1997.     update
  1998.  
  1999.     # Need to use vrootx and vrooty to make tests work correctly with
  2000.     # virtual root window measures managers: overrideredirect windows
  2001.     # come up at (0,0) in display coordinates, not virtual root
  2002.     # coordinates.
  2003.  
  2004.     set x [expr 100-[winfo vrootx .]]
  2005.     set y [expr 100-[winfo vrooty .]]
  2006.     set result [list [winfo containing $x $y]]
  2007.     lower .t2
  2008.     lappend result [winfo containing $x $y]
  2009. } {.t2 .t3}
  2010. test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
  2011.     makeToplevels
  2012.     raise .raise1
  2013.     set time [lindex [time {raise .raise1}] 0]
  2014.     expr {$time < 2000000}
  2015. } 1
  2016. test unixWm-51.11 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
  2017.     makeToplevels
  2018.     set time [lindex [time {lower .raise1}] 0]
  2019.     expr {$time < 2000000}
  2020. } 1
  2021. test unixWm-51.12 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
  2022.     makeToplevels
  2023.     set time [lindex [time {raise .raise3 .raise2}] 0]
  2024.     expr {$time < 2000000}
  2025. } 1
  2026. test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
  2027.     makeToplevels
  2028.     set time [lindex [time {lower .raise1 .raise2}] 0]
  2029.     expr {$time < 2000000}
  2030. } 1
  2031.  
  2032. test unixWm-52.1 {TkWmAddToColormapWindows procedure} {
  2033.     catch {destroy .t}
  2034.     toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2
  2035.     wm geom .t +0+0
  2036.     update
  2037.     wm colormap .t
  2038. } {}
  2039. test unixWm-52.2 {TkWmAddToColormapWindows procedure} {
  2040.     catch {destroy .t}
  2041.     toplevel .t -colormap new -relief raised -bd 2
  2042.     wm geom .t +0+0
  2043.     frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
  2044.     pack .t.f
  2045.     update
  2046.     wm colormap .t
  2047. } {.t.f .t}
  2048. test unixWm-52.3 {TkWmAddToColormapWindows procedure} {
  2049.     catch {destroy .t}
  2050.     toplevel .t -colormap new
  2051.     wm geom .t +0+0
  2052.     frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
  2053.     pack .t.f
  2054.     frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
  2055.     pack .t.f2
  2056.     update
  2057.     wm colormap .t
  2058. } {.t.f .t.f2 .t}
  2059. test unixWm-52.4 {TkWmAddToColormapWindows procedure} {
  2060.     catch {destroy .t}
  2061.     toplevel .t -colormap new
  2062.     wm geom .t +0+0
  2063.     frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
  2064.     pack .t.f
  2065.     update
  2066.     wm colormapwindows .t .t.f
  2067.     frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
  2068.     pack .t.f2
  2069.     update
  2070.     wm colormapwindows .t
  2071. } {.t.f}
  2072.  
  2073. test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} {
  2074.     catch {destroy .t}
  2075.     toplevel .t -colormap new
  2076.     wm geom .t +0+0
  2077.     frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
  2078.     pack .t.f
  2079.     frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
  2080.     pack .t.f2
  2081.     update
  2082.     destroy .t.f2
  2083.     wm colormap .t
  2084. } {.t.f .t}
  2085. test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} {
  2086.     catch {destroy .t}
  2087.     toplevel .t -colormap new
  2088.     wm geom .t +0+0
  2089.     frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
  2090.     pack .t.f
  2091.     frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
  2092.     pack .t.f2
  2093.     update
  2094.     wm colormapwindows .t .t.f2
  2095.     destroy .t.f2
  2096.     wm colormap .t
  2097. } {}
  2098.  
  2099. test unixWm-54.1 {TkMakeMenuWindow procedure, setting save_under} {unixOnly} {
  2100.     catch {destroy .t}
  2101.     catch {destroy .m}
  2102.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2103.     bind .t <Expose> {set x exposed}
  2104.     wm geom .t +0+0
  2105.     update
  2106.     menu .m
  2107.     .m add command -label First
  2108.     .m add command -label Second
  2109.     .m add command -label Third
  2110.     .m post 30 30
  2111.     update
  2112.     set x {no event}
  2113.     destroy .m
  2114.     set x
  2115. } {no event}
  2116.  
  2117. # No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize.
  2118.  
  2119. test unixWm-54.1 {TkUnixSetMenubar procedure} {unixOnly} {
  2120.     catch {destroy .t}
  2121.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2122.     wm geom .t +0+0
  2123.     update
  2124.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2125.     testmenubar window .t .t.f
  2126.     update
  2127.     list [winfo ismapped .t.f] [winfo geometry .t.f] \
  2128.         [expr [winfo rootx .t] - [winfo rootx .t.f]] \
  2129.         [expr [winfo rooty .t] - [winfo rooty .t.f]]
  2130. } {1 300x30+0+0 0 30}
  2131. test unixWm-54.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} {
  2132.     catch {destroy .t}
  2133.     catch {destroy .f}
  2134.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2135.     wm geom .t +0+0
  2136.     update
  2137.     set x [winfo rootx .t]
  2138.     set y [winfo rooty .t]
  2139.     frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
  2140.     testmenubar window .t .f
  2141.     update
  2142.     testmenubar window .t {}
  2143.     update
  2144.     list [winfo ismapped .f] [winfo geometry .f] \
  2145.         [expr [winfo rootx .t] - $x] \
  2146.         [expr [winfo rooty .t] - $y] \
  2147.         [expr [winfo rootx .] - [winfo rootx .f]] \
  2148.         [expr [winfo rooty .] - [winfo rooty .f]]
  2149. } {0 300x30+0+0 0 0 0 0}
  2150. test unixWm-54.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOnly} {
  2151.     catch {destroy .t}
  2152.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2153.     wm geom .t +0+0
  2154.     update
  2155.     set x [winfo rootx .t]
  2156.     set y [winfo rooty .t]
  2157.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2158.     testmenubar window .t .t.f
  2159.     update
  2160.     testmenubar window .t {}
  2161.     update
  2162.     set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
  2163.     .t.f configure -height 100
  2164.     update
  2165.     lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
  2166. } {0 0 0 0}
  2167. test unixWm-54.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} {
  2168.     catch {destroy .t}
  2169.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2170.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2171.     testmenubar window .t .t.f
  2172.     wm geom .t +0+0
  2173.     update
  2174.     list [winfo ismapped .t.f] [winfo geometry .t.f] \
  2175.         [expr [winfo rootx .t] - [winfo rootx .t.f]] \
  2176.         [expr [winfo rooty .t] - [winfo rooty .t.f]]
  2177. } {1 300x30+0+0 0 30}
  2178. test unixWm-54.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} {
  2179.     catch {destroy .t}
  2180.     catch {destroy .f}
  2181.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2182.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2183.     wm geom .t +0+0
  2184.     update
  2185.     set y [winfo rooty .t]
  2186.     frame .f -width 400 -height 50 -bd 2 -relief raised -bg green
  2187.     testmenubar window .t .t.f
  2188.     update
  2189.     set result {}
  2190.     lappend result [winfo ismapped .f] [winfo ismapped .t.f]
  2191.     lappend result [expr [winfo rooty .t.f] - $y]
  2192.     testmenubar window .t .f
  2193.     update
  2194.     lappend result [winfo ismapped .f] [winfo ismapped .t.f]
  2195.     lappend result [expr [winfo rooty .f] - $y]
  2196. } {0 1 0 1 0 0}
  2197. test unixWm-54.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} {
  2198.     catch {destroy .t}
  2199.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2200.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2201.     testmenubar window .t .t.f
  2202.     wm geom .t +0+0
  2203.     update
  2204.     testmenubar window .t .t.f
  2205.     update
  2206.     list [winfo ismapped .t.f] [winfo geometry .t.f] \
  2207.         [expr [winfo rootx .t] - [winfo rootx .t.f]] \
  2208.         [expr [winfo rooty .t] - [winfo rooty .t.f]]
  2209. } {1 300x30+0+0 0 30}
  2210. test unixWm-54.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} {
  2211.     catch {destroy .t}
  2212.     catch {destroy .f}
  2213.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2214.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2215.     frame .f -width 400 -height 40 -bd 2 -relief raised -bg blue
  2216.     wm geom .t +0+0
  2217.     update
  2218.     set y [winfo rooty .t]
  2219.     testmenubar window .t .t.f
  2220.     update
  2221.     set result [expr [winfo rooty .t] - $y]
  2222.     testmenubar window .t .f
  2223.     update
  2224.     lappend result [expr [winfo rooty .t] - $y]
  2225.     destroy .t.f
  2226.     update
  2227.     lappend result [expr [winfo rooty .t] - $y]
  2228. } {30 40 40}
  2229.  
  2230. test unixWm-55.1 {MenubarDestroyProc procedure} {unixOnly} {
  2231.     catch {destroy .t}
  2232.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2233.     wm geom .t +0+0
  2234.     update
  2235.     set y [winfo rooty .t]
  2236.     frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
  2237.     testmenubar window .t .t.f
  2238.     update
  2239.     set result [expr [winfo rooty .t] - $y]
  2240.     destroy .t.f
  2241.     update
  2242.     lappend result [expr [winfo rooty .t] - $y]
  2243. } {30 0}
  2244.  
  2245. test unixWm-56.1 {MenubarReqProc procedure} {unixOnly} {
  2246.     catch {destroy .t}
  2247.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2248.     wm geom .t +0+0
  2249.     update
  2250.     set x [winfo rootx .t]
  2251.     set y [winfo rooty .t]
  2252.     frame .t.f -width 400 -height 10 -bd 2 -relief raised -bg green
  2253.     testmenubar window .t .t.f
  2254.     update
  2255.     set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
  2256.     .t.f configure -height 100
  2257.     update
  2258.     lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
  2259. } {0 10 0 100}
  2260. test unixWm-56.2 {MenubarReqProc procedure} {unixOnly} {
  2261.     catch {destroy .t}
  2262.     toplevel .t -width 300 -height 200 -bd 2 -relief raised
  2263.     wm geom .t +0+0
  2264.     update
  2265.     set x [winfo rootx .t]
  2266.     set y [winfo rooty .t]
  2267.     frame .t.f -width 400 -height 20 -bd 2 -relief raised -bg green
  2268.     testmenubar window .t .t.f
  2269.     update
  2270.     set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
  2271.     .t.f configure -height 0
  2272.     update
  2273.     lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
  2274. } {0 20 0 1}
  2275.  
  2276. # Test exit processing and cleanup:
  2277.  
  2278. test unixWm-57.1 {exit processing} {
  2279.     catch {removeFile script}
  2280.     set fd [open script w]
  2281.     puts $fd {
  2282.     update
  2283.     exit
  2284.     }
  2285.     close $fd
  2286.     if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
  2287.     set error 1
  2288.     } else {
  2289.     set error 0
  2290.     }
  2291.     list $error $msg
  2292. } {0 {}}
  2293. test unixWm-57.2 {exit processing} {
  2294.     catch {removeFile script}
  2295.     set fd [open script w]
  2296.     puts $fd {
  2297.     interp create x
  2298.     x eval {set argc 2}
  2299.     x eval {set argv "-geometry 10x10+0+0"}
  2300.     x eval {load {} Tk}
  2301.     update
  2302.     exit
  2303.     }
  2304.     close $fd
  2305.     if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
  2306.     set error 1
  2307.     } else {
  2308.     set error 0
  2309.     }
  2310.     list $error $msg
  2311. } {0 {}}
  2312. test unixWm-57.3 {exit processing} {
  2313.     catch {removeFile script}
  2314.     set fd [open script w]
  2315.     puts $fd {
  2316.     interp create x
  2317.     x eval {set argc 2}
  2318.     x eval {set argv "-geometry 10x10+0+0"}
  2319.     x eval {load {} Tk}
  2320.     x eval {
  2321.         button .b -text hello
  2322.         bind .b <Destroy> foo
  2323.     }
  2324.     x alias foo destroy_x
  2325.     proc destroy_x {} {interp delete x}
  2326.     update
  2327.     exit
  2328.     }
  2329.     close $fd
  2330.     if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
  2331.     set error 1
  2332.     } else {
  2333.     set error 0
  2334.     }
  2335.     list $error $msg
  2336. } {0 {}}
  2337.  
  2338.     
  2339. catch {destroy .t}
  2340. concat {}
  2341.