# This file tests is a Tcl script to test the procedures in the file # tkWinWm.c. It is organized in the standard fashion for Tcl tests. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: winWm.test,v 1.18.4.2 2009/06/23 14:26:49 dgp Exp $ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands # Measure the height of a single menu line toplevel .t frame .t.f -width 100 -height 50 pack .t.f menu .t.m .t.m add command -label "thisisreallylong" .t configure -menu .t.m wm geometry .t -0-0 update set menuheight [winfo y .t] .t.m add command -label "thisisreallylong" wm geometry .t -0-0 update set menuheight [expr {$menuheight - [winfo y .t]}] destroy .t test winWm-1.1 {TkWmMapWindow} win { toplevel .t wm override .t 1 wm geometry .t +0+0 update set result [list [winfo rootx .t] [winfo rooty .t]] destroy .t set result } {0 0} test winWm-1.2 {TkWmMapWindow} win { toplevel .t wm transient .t . update wm iconify . update wm deiconify . update catch {wm iconify .t} msg destroy .t set msg } {can't iconify ".t": it is a transient} test winWm-1.3 {TkWmMapWindow} win { toplevel .t update toplevel .t2 update set result [expr {[winfo x .t] != [winfo x .t2]}] destroy .t .t2 set result } 1 test winWm-1.4 {TkWmMapWindow} win { toplevel .t wm geometry .t +10+10 update toplevel .t2 wm geometry .t2 +40+10 update set result [list [winfo x .t] [winfo x .t2]] destroy .t .t2 set result } {10 40} test winWm-1.5 {TkWmMapWindow} win { toplevel .t wm iconify .t update set result [wm state .t] destroy .t set result } iconic test winWm-2.1 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update set result [wm state .t] wm iconify .t update lappend result [wm state .t] wm deiconify .t update lappend result [wm state .t] destroy .t set result } {normal iconic normal} test winWm-2.2 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update set result [wm state .t] wm withdraw .t update lappend result [wm state .t] wm iconify .t update lappend result [wm state .t] wm deiconify .t update lappend result [wm state .t] destroy .t set result } {normal withdrawn iconic normal} test winWm-2.3 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update set result [wm state .t] wm state .t withdrawn update lappend result [wm state .t] wm state .t iconic update lappend result [wm state .t] wm state .t normal update lappend result [wm state .t] destroy .t set result } {normal withdrawn iconic normal} test winWm-2.4 {TkpWmSetState} win { set result {} toplevel .t wm geometry .t 150x50+10+10 update lappend result [list [wm state .t] [wm geometry .t]] wm iconify .t update lappend result [list [wm state .t] [wm geometry .t]] wm geometry .t 200x50+10+10 update lappend result [list [wm state .t] [wm geometry .t]] wm deiconify .t update lappend result [list [wm state .t] [wm geometry .t]] destroy .t set result } {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win { toplevel .t wm geometry .t +0+0 button .t.b pack .t.b update set x [winfo x .t.b] destroy .t toplevel .t wm geometry .t +0+0 button .t.b update pack .t.b update set x [expr {$x == [winfo x .t.b]}] destroy .t set x } 1 test winWm-4.1 {ConfigureTopLevel: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f wm geometry .t -0-0 update set y [winfo y .t] menu .t.m .t.m add command -label foo .t configure -menu .t.m update set result [expr {$y - [winfo y .t]}] destroy .t set result } [expr {$menuheight + 1}] # This test works on 8.0p2 but has not worked on anything since 8.2. # It would be very strange to have a windows application increase the size # of the clientarea when a menu wraps so I believe this test to be wrong. # Original result was {50 50 50} new result may depend on the default menu # font test winWm-5.1 {UpdateGeometryInfo: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f update set result [winfo height .t] menu .t.m .t.m add command -label foo .t configure -menu .t.m update lappend result [winfo height .t] .t.m add command -label "thisisreallylong" .t.m add command -label "thisisreallylong" update lappend result [winfo height .t] destroy .t set result } {50 50 31} test winWm-5.2 {UpdateGeometryInfo: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f wm geometry .t -0-0 update set y [winfo rooty .t] lappend result [winfo height .t] menu .t.m .t configure -menu .t.m .t.m add command -label foo .t.m add command -label "thisisreallylong" .t.m add command -label "thisisreallylong" update lappend result [winfo height .t] lappend result [expr {$y - [winfo rooty .t]}] destroy .t set result } {50 50 0} test winWm-6.1 {wm attributes} win { destroy .t toplevel .t wm attributes .t } {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0} test winWm-6.2 {wm attributes} win { destroy .t toplevel .t wm attributes .t -disabled } {0} test winWm-6.3 {wm attributes} win { # This isn't quite the correct error message yet, but it works. destroy .t toplevel .t list [catch {wm attributes .t -foo} msg] $msg } {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} test winWm-6.4 {wm attributes -alpha} win { # Expect this to return all 1.0 {} on pre-2K/XP destroy .t toplevel .t set res [wm attributes .t -alpha] # we don't return on set yet lappend res [wm attributes .t -alpha 0.5] lappend res [wm attributes .t -alpha] lappend res [wm attributes .t -alpha -100] lappend res [wm attributes .t -alpha] lappend res [wm attributes .t -alpha 100] lappend res [wm attributes .t -alpha] set res } {1.0 {} 0.5 {} 0.0 {} 1.0} test winWm-6.5 {wm attributes -alpha} win { destroy .t toplevel .t list [catch {wm attributes .t -alpha foo} msg] $msg } {1 {expected floating-point number but got "foo"}} test winWm-6.6 {wm attributes -alpha} win { # This test is just to show off -alpha destroy .t toplevel .t wm attributes .t -alpha 0.2 pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"] tk::PlaceWindow .t center update if {$::tcl_platform(osVersion) >= 5.0} { for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} { wm attributes .t -alpha $i update idle after 20 } for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} { wm attributes .t -alpha $i update idle after 20 } } } {} test winWm-6.7 {wm attributes -transparentcolor} win { # Expect this to return all "" on pre-2K/XP destroy .t toplevel .t set res {} lappend res [wm attributes .t -transparentcolor] # we don't return on set yet lappend res [wm attributes .t -trans black] lappend res [wm attributes .t -trans] lappend res [wm attributes .t -trans "#FFFFFF"] lappend res [wm attributes .t -trans] destroy .t set res } [list {} {} black {} "#FFFFFF"] test winWm-6.8 {wm attributes -transparentcolor} win { destroy .t toplevel .t list [catch {wm attributes .t -tr foo} msg] $msg } {1 {unknown color name "foo"}} test winWm-7.1 {deiconify on an unmapped toplevel\ will raise the window and set the focus} win { destroy .t toplevel .t lower .t focus -force . wm deiconify .t update list [wm stackorder .t isabove .] [focus] } {1 .t} test winWm-7.2 {deiconify on an already mapped toplevel\ will raise the window and set the focus} win { destroy .t toplevel .t lower .t update focus -force . wm deiconify .t update list [wm stackorder .t isabove .] [focus] } {1 .t} test winWm-7.3 {UpdateWrapper must maintain Z order} win { destroy .t toplevel .t lower .t update set res [wm stackorder .t isbelow .] wm resizable .t 0 0 update list $res [wm stackorder .t isbelow .] } {1 1} test winWm-7.4 {UpdateWrapper must maintain focus} win { destroy .t toplevel .t focus -force .t update set res [focus] wm resizable .t 0 0 update list $res [focus] } {.t .t} test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win { list [catch {wm iconph .} msg] $msg } {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win { destroy .t toplevel .t image create photo blank16 -width 16 -height 16 image create photo blank32 -width 32 -height 32 # This should just make blank icons for the window wm iconphoto .t blank16 blank32 image delete blank16 blank32 } {} test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constraints win -setup { proc winwm90click {w} { if {![winfo ismapped $w]} { update } event generate $w focus -force $w event generate $w -x 5 -y 5 event generate $w -x 5 -y 5 } proc winwm90proc3 {} { global winwm90done winwm90check set w .sd toplevel $w pack [button $w.b -text "OK" -command {set winwm90check 1}] bind $w.b {after idle {winwm90click %W}} update idletasks tkwait visibility $w grab $w tkwait variable winwm90check grab release $w destroy $w after idle {set winwm90done ok} } proc winwm90proc2 {w} { winwm90proc3; destroy $w } proc winwm90proc1 {w} { toplevel $w pack [button $w.b -text "Do dialog" -command [list winwm90proc2 $w]] bind $w.b {bind %W {}; after idle {winwm90click %W}} } destroy .t global winwm90done set winwm90done wait toplevel .t } -body { pack [button .t.b -text "Show" -command {winwm90proc1 .tx}] bind .t.b {bind %W {}; after idle {winwm90click %W}} after 5000 {set winwm90done timeout} vwait winwm90done set winwm90done } -cleanup { foreach cmd {proc1 proc2 proc3 click} { rename winwm90$cmd {} } destroy .tx .t .sd } -result {ok} destroy .t # cleanup cleanupTests return # Local variables: # mode: tcl # End: