开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
unixWm.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：81k
源码类别：

通讯编程

开发平台：

Visual C++

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