1# This file tests is a Tcl script to test the procedures in the file 2# tkWinWm.c. It is organized in the standard fashion for Tcl tests. 3# 4# This file contains a collection of tests for one or more of the Tcl 5# built-in commands. Sourcing this file into Tcl runs the tests and 6# generates output for errors. No output means no errors were found. 7# 8# Copyright (c) 1996 by Sun Microsystems, Inc. 9# Copyright (c) 1998-1999 by Scriptics Corporation. 10# All rights reserved. 11# 12# RCS: @(#) $Id: winWm.test,v 1.9.2.4 2006/12/01 19:47:42 hobbs Exp $ 13 14package require tcltest 2.1 15namespace import -force tcltest::configure 16namespace import -force tcltest::testsDirectory 17configure -testdir [file join [pwd] [file dirname [info script]]] 18configure -loadfile [file join [testsDirectory] constraints.tcl] 19tcltest::loadTestedCommands 20 21# Measure the height of a single menu line 22 23toplevel .t 24frame .t.f -width 100 -height 50 25pack .t.f 26menu .t.m 27.t.m add command -label "thisisreallylong" 28.t conf -menu .t.m 29wm geom .t -0-0 30update 31set menuheight [winfo y .t] 32.t.m add command -label "thisisreallylong" 33wm geom .t -0-0 34update 35set menuheight [expr $menuheight - [winfo y .t]] 36destroy .t 37 38test winWm-1.1 {TkWmMapWindow} {pcOnly} { 39 toplevel .t 40 wm override .t 1 41 wm geometry .t +0+0 42 update 43 set result [list [winfo rootx .t] [winfo rooty .t]] 44 destroy .t 45 set result 46} {0 0} 47test winWm-1.2 {TkWmMapWindow} {pcOnly} { 48 toplevel .t 49 wm transient .t . 50 update 51 wm iconify . 52 update 53 wm deiconify . 54 update 55 catch {wm iconify .t} msg 56 destroy .t 57 set msg 58} {can't iconify ".t": it is a transient} 59test winWm-1.3 {TkWmMapWindow} {pcOnly} { 60 toplevel .t 61 update 62 toplevel .t2 63 update 64 set result [expr [winfo x .t] != [winfo x .t2]] 65 destroy .t .t2 66 set result 67} 1 68test winWm-1.4 {TkWmMapWindow} {pcOnly} { 69 toplevel .t 70 wm geometry .t +10+10 71 update 72 toplevel .t2 73 wm geometry .t2 +40+10 74 update 75 set result [list [winfo x .t] [winfo x .t2]] 76 destroy .t .t2 77 set result 78} {10 40} 79test winWm-1.5 {TkWmMapWindow} {pcOnly} { 80 toplevel .t 81 wm iconify .t 82 update 83 set result [wm state .t] 84 destroy .t 85 set result 86} iconic 87 88test winWm-2.1 {TkpWmSetState} {pcOnly} { 89 toplevel .t 90 wm geometry .t 150x50+10+10 91 update 92 set result [wm state .t] 93 wm iconify .t 94 update 95 lappend result [wm state .t] 96 wm deiconify .t 97 update 98 lappend result [wm state .t] 99 destroy .t 100 set result 101} {normal iconic normal} 102test winWm-2.2 {TkpWmSetState} {pcOnly} { 103 toplevel .t 104 wm geometry .t 150x50+10+10 105 update 106 set result [wm state .t] 107 wm withdraw .t 108 update 109 lappend result [wm state .t] 110 wm iconify .t 111 update 112 lappend result [wm state .t] 113 wm deiconify .t 114 update 115 lappend result [wm state .t] 116 destroy .t 117 set result 118} {normal withdrawn iconic normal} 119test winWm-2.2 {TkpWmSetState} {pcOnly} { 120 toplevel .t 121 wm geometry .t 150x50+10+10 122 update 123 set result [wm state .t] 124 wm state .t withdrawn 125 update 126 lappend result [wm state .t] 127 wm state .t iconic 128 update 129 lappend result [wm state .t] 130 wm state .t normal 131 update 132 lappend result [wm state .t] 133 destroy .t 134 set result 135} {normal withdrawn iconic normal} 136test winWm-2.4 {TkpWmSetState} {pcOnly} { 137 set result {} 138 toplevel .t 139 wm geometry .t 150x50+10+10 140 update 141 lappend result [list [wm state .t] [wm geometry .t]] 142 wm iconify .t 143 update 144 lappend result [list [wm state .t] [wm geometry .t]] 145 wm geometry .t 200x50+10+10 146 update 147 lappend result [list [wm state .t] [wm geometry .t]] 148 wm deiconify .t 149 update 150 lappend result [list [wm state .t] [wm geometry .t]] 151 destroy .t 152 set result 153} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} 154 155test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} { 156 toplevel .t 157 wm geometry .t +0+0 158 button .t.b 159 pack .t.b 160 update 161 set x [winfo x .t.b] 162 destroy .t 163 toplevel .t 164 wm geometry .t +0+0 165 button .t.b 166 update 167 pack .t.b 168 update 169 set x [expr $x == [winfo x .t.b]] 170 destroy .t 171 set x 172} 1 173 174test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} { 175 set result {} 176 toplevel .t 177 frame .t.f -width 150 -height 50 -bg red 178 pack .t.f 179 wm geometry .t -0-0 180 update 181 set y [winfo y .t] 182 menu .t.m 183 .t.m add command -label foo 184 .t conf -menu .t.m 185 update 186 set result [expr $y - [winfo y .t]] 187 destroy .t 188 set result 189} [expr $menuheight + 1] 190 191test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} { 192 set result {} 193 toplevel .t 194 frame .t.f -width 150 -height 50 -bg red 195 pack .t.f 196 update 197 set result [winfo height .t] 198 menu .t.m 199 .t.m add command -label foo 200 .t conf -menu .t.m 201 update 202 lappend result [winfo height .t] 203 .t.m add command -label "thisisreallylong" 204 .t.m add command -label "thisisreallylong" 205 update 206 lappend result [winfo height .t] 207 destroy .t 208 set result 209} {50 50 50} 210test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} { 211 set result {} 212 toplevel .t 213 frame .t.f -width 150 -height 50 -bg red 214 pack .t.f 215 wm geom .t -0-0 216 update 217 set y [winfo rooty .t] 218 lappend result [winfo height .t] 219 menu .t.m 220 .t conf -menu .t.m 221 .t.m add command -label foo 222 .t.m add command -label "thisisreallylong" 223 .t.m add command -label "thisisreallylong" 224 update 225 lappend result [winfo height .t] 226 lappend result [expr $y - [winfo rooty .t]] 227 destroy .t 228 set result 229} {50 50 0} 230 231test winWm-6.1 {wm attributes} win { 232 destroy .t 233 toplevel .t 234 wm attributes .t 235} {-alpha 1.0 -transparentcolor {} -disabled 0 -toolwindow 0 -topmost 0} 236test winWm-6.2 {wm attributes} win { 237 destroy .t 238 toplevel .t 239 wm attributes .t -disabled 240} {0} 241test winWm-6.3 {wm attributes} win { 242 # This isn't quite the correct error message yet, but it works. 243 destroy .t 244 toplevel .t 245 list [catch {wm attributes .t -foo} msg] $msg 246} {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} 247 248test winWm-6.4 {wm attributes -alpha} win { 249 # Expect this to return all 1.0 {} on pre-2K/XP 250 destroy .t 251 toplevel .t 252 set res [wm attributes .t -alpha] 253 # we don't return on set yet 254 lappend res [wm attributes .t -alpha 0.5] 255 lappend res [wm attributes .t -alpha] 256 lappend res [wm attributes .t -alpha -100] 257 lappend res [wm attributes .t -alpha] 258 lappend res [wm attributes .t -alpha 100] 259 lappend res [wm attributes .t -alpha] 260 set res 261} {1.0 {} 0.5 {} 0.0 {} 1.0} 262 263test winWm-6.5 {wm attributes -alpha} win { 264 destroy .t 265 toplevel .t 266 list [catch {wm attributes .t -alpha foo} msg] $msg 267} {1 {expected floating-point number but got "foo"}} 268 269test winWm-6.6 {wm attributes -alpha} win { 270 # This test is just to show off -alpha 271 destroy .t 272 toplevel .t 273 wm attributes .t -alpha 0.2 274 pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"] 275 tk::PlaceWindow .t center 276 update 277 if {$::tcl_platform(osVersion) >= 5.0} { 278 for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} { 279 wm attributes .t -alpha $i 280 update idle 281 after 20 282 } 283 for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} { 284 wm attributes .t -alpha $i 285 update idle 286 after 20 287 } 288 } 289} {} 290 291test winWm-6.7 {wm attributes -transparentcolor} win { 292 # Expect this to return all "" on pre-2K/XP 293 destroy .t 294 toplevel .t 295 set res {} 296 lappend res [wm attributes .t -transparentcolor] 297 # we don't return on set yet 298 lappend res [wm attributes .t -trans black] 299 lappend res [wm attributes .t -trans] 300 lappend res [wm attributes .t -trans "#FFFFFF"] 301 lappend res [wm attributes .t -trans] 302 destroy .t 303 set res 304} [list {} {} black {} "#FFFFFF"] 305 306test winWm-6.8 {wm attributes -transparentcolor} win { 307 destroy .t 308 toplevel .t 309 list [catch {wm attributes .t -tr foo} msg] $msg 310} {1 {unknown color name "foo"}} 311 312test winWm-7.1 {deiconify on an unmapped toplevel 313 will raise the window and set the focus} {pcOnly} { 314 destroy .t 315 toplevel .t 316 lower .t 317 focus -force . 318 wm deiconify .t 319 update 320 list [wm stackorder .t isabove .] [focus] 321} {1 .t} 322 323test winWm-7.2 {deiconify on an already mapped toplevel 324 will raise the window and set the focus} {pcOnly} { 325 destroy .t 326 toplevel .t 327 lower .t 328 update 329 focus -force . 330 wm deiconify .t 331 update 332 list [wm stackorder .t isabove .] [focus] 333} {1 .t} 334 335test winWm-7.3 {UpdateWrapper must maintain Z order} win { 336 destroy .t 337 toplevel .t 338 lower .t 339 update 340 set res [wm stackorder .t isbelow .] 341 wm resizable .t 0 0 342 update 343 list $res [wm stackorder .t isbelow .] 344} {1 1} 345 346test winWm-7.4 {UpdateWrapper must maintain focus} win { 347 destroy .t 348 toplevel .t 349 focus -force .t 350 update 351 set res [focus] 352 wm resizable .t 0 0 353 update 354 list $res [focus] 355} {.t .t} 356 357test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win { 358 list [catch {wm iconph .} msg] $msg 359} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} 360test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win { 361 destroy .t 362 toplevel .t 363 image create photo blank16 -width 16 -height 16 364 image create photo blank32 -width 32 -height 32 365 # This should just make blank icons for the window 366 wm iconphoto .t blank16 blank32 367 image delete blank16 blank32 368} {} 369 370destroy .t 371 372# cleanup 373::tcltest::cleanupTests 374return 375