unixwm.test

linux系统下的音频通信

test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} {
    wm protocol .t foo {a b c}
    wm protocol .t foo {test script}
    set result [wm protocol .t foo]
    wm protocol .t foo {}
    set result
} {test script}

test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . a} msg]  $msg
} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . a b c} msg]  $msg
} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable .foo a b c} msg]  $msg
} {1 {bad window path name ".foo"}}
test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . x 1} msg]  $msg
} {1 {expected boolean value but got "x"}}
test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . 0 gorp} msg]  $msg
} {1 {expected boolean value but got "gorp"}}
test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} {
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 100
    wm geom .t2 +0+0
    set result ""
    lappend result [wm resizable .t2]
    wm resizable .t2 1 0
    lappend result [wm resizable .t2]
    wm resizable .t2 no off
    lappend result [wm resizable .t2]
    wm resizable .t2 false true
    lappend result [wm resizable .t2]
    destroy .t2
    set result
} {{1 1} {1 0} {0 0} {0 1}}

test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} {
    list [catch {wm sizefrom .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}}
test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} {
    set result {}
    lappend result [wm sizefrom .t]
    wm sizefrom .t program
    update
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
	    WM_NORMAL_HINTS] 0]]]
    lappend result [wm sizefrom .t] $bit
    wm sizefrom .t user
    update
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
	    WM_NORMAL_HINTS] 0]]]
    lappend result [wm sizefrom .t] $bit
} {{} program 0x8 user 0x2}
test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} {
    list [catch {wm sizefrom .t none} msg]  $msg
} {1 {bad argument "none": must be program or user}}

test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {
    list [catch {wm state .t 1} msg]  $msg
} {1 {wrong # arguments: must be "wm state window"}}
test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
    set result {}
    catch {destroy .t2}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    lappend result [wm state .t2]
    update
    lappend result [wm state .t2]
    wm withdraw .t2
    lappend result [wm state .t2]
    wm iconify .t2
    lappend result [wm state .t2]
    wm deiconify .t2
    lappend result [wm state .t2]
    destroy .t2
    set result
} {normal normal withdrawn iconic normal}

test unixWm-36.1 {Tk_WmCmd procedure, "title" option} {
    list [catch {wm title .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm title window ?newTitle?"}}
test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} {
    set result {}
    lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
    wm title .t "Test window"
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
	    WM_NORMAL_HINTS] 0]]]
    lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
} {t t {Test window} {Test window}}

test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} {
    list [catch {wm transient .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm transient window ?master?"}}
test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} {
    list [catch {wm transient .t foo} msg]  $msg
} {1 {bad window path name "foo"}}
test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} {
    set result {}
    catch {destroy .t2}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    update
    lappend result [wm transient .t2] \
	    [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
    wm transient .t2 .t
    set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
    lappend result [wm transient .t2] [expr [testwrapper .t] - $transient]
    wm transient .t2 {}
    lappend result [wm transient .t2] \
	    [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
    destroy .t2
    set result
} {{} {} .t 0 {} 0x0}
test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} {
    catch {destroy .t2}
    catch {destroy .t3}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    toplevel .t3 -width 120 -height 300
    wm geometry .t2 +0+0
    set result [list [testwrapper .t2]]
    wm transient .t3 .t2
    lappend result [expr {[testwrapper .t2] == ""}]
    destroy .t2 .t3
    set result
} {{} 0}

test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} {
    list [catch {wm withdraw .t 1} msg]  $msg
} {1 {wrong # arguments: must be "wm withdraw window"}}
test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} {
    catch {destroy .t2}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    wm iconwindow .t .t2
    set result [list [catch {wm withdraw .t2} msg]  $msg]
    destroy .t2
    set result
} {1 {can't withdraw .t2: it is an icon for .t}}
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} {
    set result {}
    wm withdraw .t
    lappend result [wm state .t] [winfo ismapped .t]
    wm deiconify .t
    lappend result [wm state .t] [winfo ismapped .t]
} {withdrawn 0 normal 1}

test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} {
    list [catch {wm unknown .t} msg] $msg
} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}

catch {destroy .t}
catch {destroy .icon}

test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {nonPortable} {
    catch {destroy .t}
    toplevel .t
    wm geometry .t 30x10+0+0
    listbox .t.l -height 20 -width 20 -setgrid 1 
    pack .t.l -fill both -expand 1
    update
    wm geometry .t
} {30x10+0+0}
test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} {
    catch {destroy .t}
    toplevel .t
    wm geometry .t 200x100+0+0
    listbox .t.l -height 20 -width 20 
    pack .t.l -fill both -expand 1
    update
    .t.l configure -setgrid 1
    update
    wm geometry .t
} {20x20+0+0}

test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
    catch {destroy .t}
    toplevel .t -width 400 -height 150
    wm geometry .t +0+0
    tkwait visibility .t
    set result {}
    lappend result [winfo width .t] [winfo height .t]
    .t configure -width 200 -height 300
    sleep 500
    lappend result [winfo width .t] [winfo height .t]
} {400 150 200 300}
test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.m -bd 2 -relief raised -height 20
    testmenubar window .t .t.m
    update
    set result {}
    bind .t <Configure> {
	if {"%W" == ".t"} {
	    lappend result "%W: %wx%h"
	}
    }
    bind .t.m <Configure> {lappend result "%W: %wx%h"}
    wm geometry .t 200x300
    update
    lappend result [expr [winfo rootx .t.m] - $x] \
	    [expr [winfo rooty .t.m] - $y] \
	    [winfo width .t.m] [winfo height .t.m] \
	    [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] \
	    [winfo width .t] [winfo height .t]
} {{.t.m: 200x20} {.t: 200x300} 0 0 200 20 0 20 200 300}
test unixWm-41.3 {ConfigureEvent procedure, synthesized Configure events} {
    catch {destroy .t}
    toplevel .t -width 400 -height 150
    wm geometry .t +0+0
    tkwait visibility .t
    set result {no event}
    bind .t <Configure> {set result "configured: %w %h"}
    wm geometry .t +10+20
    update
    set result
} {configured: 400 150}
test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} {
    catch {destroy .t}
    toplevel .t -width 400 -height 150
    wm geometry .t +0+0
    tkwait visibility .t
    set result {no event}
    bind .t <Configure> {set result "configured: %w %h"}
    wm geometry .t 130x200
    update
    set result
} {configured: 130 200}

# No tests for ReparentEvent or ComputeReparentGeometry; I can't figure
# out how to exercise these procedures reliably.

test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {
    catch {destroy .t}
    toplevel .t -width 400 -height 150
    wm geometry .t +0+0
    tkwait visibility .t
    set result {}
    bind .t <Map> {set x "mapped"}
    bind .t <Unmap> {set x "unmapped"}
    set x {no event}
    wm iconify .t
    lappend result $x [winfo ismapped .t]
    set x {no event}
    wm deiconify .t
    lappend result $x [winfo ismapped .t]
} {unmapped 0 mapped 1}

test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200
    wm geom .t +0+0
    frame .t.f -container 1 -bd 2 -relief raised
    place .t.f -x 20 -y 10
    tkwait visibility .t.f
    toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -bg blue
    tkwait visibility .t2
    set result {}
    .t2 configure -width 70 -height 120
    update
    lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
    lappend result [winfo width .t2] [winfo height .t2]
    # destroy .t2
    set result
} {70 120 70 120}
test unixWm-43.2 {TopLevelReqProc procedure, resize causes window to move} \
	{nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200
    wm geom .t +0+0
    update
    wm geom .t -0-0
    update
    set x [winfo x .t]
    set y [winfo y .t]
    .t configure -width 300 -height 150
    update
    list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
	    [winfo width .t] [winfo height .t]
} {-100 50 300 150}

test unixWm-44.1 {UpdateGeometryInfo procedure, width/height computation} {
    catch {destroy .t}
    toplevel .t -width 100 -height 200
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    .t configure  -width 180 -height 20
    update
    list [winfo width .t] [winfo height .t]
} {180 20}
test unixWm-44.2 {UpdateGeometryInfo procedure, width/height computation} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm grid .t 5 4 10 12
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 10x2
    update
    list [winfo width .t] [winfo height .t]
} {130 36}
test unixWm-44.3 {UpdateGeometryInfo procedure, width/height computation} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm grid .t 5 4 10 12
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 1x10
    update
    list [winfo width .t] [winfo height .t]
} {40 132}
test unixWm-44.4 {UpdateGeometryInfo procedure, width/height computation} {
    catch {destroy .t}
    toplevel .t -width 100 -height 200
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 300x150
    update
    list [winfo width .t] [winfo height .t]
} {300 150}
test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm grid .t 18 7 10 12
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 5x8
    update
    list [winfo width .t] [winfo height .t]
} {1 72}
test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm grid .t 18 7 10 12
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 20x1
    update
    list [winfo width .t] [winfo height .t]
} {100 1}
test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm geometry .t +5-10
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} "5 [expr [winfo screenheight .t] - 70]"
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm geometry .t -30+2
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} "[expr [winfo screenwidth .t] - 110] 2"
test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm resizable .t 0 0
    wm geometry .t +0+0