unixwm.test

linux系统下的音频通信

    testprop [testwrapper .t] WM_COMMAND
} {test
command
}
test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} {
    catch {destroy .t}
    toplevel .t -width 100 -height 300 -bg blue
    wm geom .t +0+0
    wm iconify .t
    sleep 500
    winfo ismapped .t
} {0}
test unixWm-9.4 {TkWmMapWindow procedure, icon windows} {
    catch {destroy .t}
    sleep 500
    toplevel .t -width 100 -height 50 -bg blue
    wm iconwindow . .t
    update
    set result [winfo ismapped .t]
} {0}
test unixWm-9.5 {TkWmMapWindow procedure, normal windows} {
    catch {destroy .t}
    toplevel .t -width 200 -height 20
    wm geom .t +0+0
    update
    winfo ismapped .t
} {1}

test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} {
    catch {destroy .t}
    toplevel .t -width 100 -height 50
    wm geom .t +0+0
    update
    .t configure -width 200 -height 100
    destroy .t
} {}
test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} {
    catch {destroy .t}
    catch {destroy .f}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
    bind .f <Destroy> {lappend result destroyed}
    testmenubar window .t .f
    update
    set result {}
    destroy .t
    lappend result [winfo exists .f]
} {destroyed 0}

test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} {
    list [catch {wm} msg] $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} {
    list [catch {wm foo} msg] $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} {
    list [catch {wm foo bogus} msg] $msg
} {1 {bad window path name "bogus"}}
test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} {
    catch {destroy .b}
    button .b -text hello
    list [catch {wm geometry .b} msg] $msg
} {1 {window ".b" isn't a top-level window}}

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

toplevel .t -width 100 -height 50
wm geom .t +0+0
update

test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 12} msg] $msg
} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 12 13 14 15 16} msg] $msg
} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} {
    set result {}
    lappend result [wm aspect .t]
    wm aspect .t 3 4 10 2
    lappend result [wm aspect .t]
    wm aspect .t {} {} {} {}
    lappend result [wm aspect .t]
} {{} {3 4 10 2} {}}
test unixWm-12.4 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t bad 14 15 16} msg] $msg
} {1 {expected integer but got "bad"}}
test unixWm-12.5 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 13 foo 15 16} msg] $msg
} {1 {expected integer but got "foo"}}
test unixWm-12.6 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 13 14 bar 16} msg] $msg
} {1 {expected integer but got "bar"}}
test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 13 14 15 baz} msg] $msg
} {1 {expected integer but got "baz"}}
test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 0 14 15 16} msg] $msg
} {1 {aspect number can't be <= 0}}
test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 13 0 15 16} msg] $msg
} {1 {aspect number can't be <= 0}}
test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 13 14 0 16} msg] $msg
} {1 {aspect number can't be <= 0}}
test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} {
    list [catch {wm aspect .t 13 14 15 0} msg] $msg
} {1 {aspect number can't be <= 0}}

test unixWm-13.1 {Tk_WmCmd procedure, "client" option} {
    list [catch {wm client .t x y} msg] $msg
} {1 {wrong # arguments: must be "wm client window ?name?"}}
test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} {
    set result {}
    lappend result [wm client .t]
    wm client .t Test_String
    lappend result [testprop [testwrapper .t] WM_CLIENT_MACHINE]
    wm client .t New
    lappend result [wm client .t]
    wm client .t {}
    lappend result [wm client .t] [testprop [testwrapper .t] WM_CLIENT_MACHINE]
} {{} Test_String New {} {}}
test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} {
    catch {destroy .t2}
    toplevel .t2
    wm client .t2 Test_String
    wm client .t2 {}
    wm client .t2 Test_String
    destroy .t2
} {}

test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} {
    list [catch {wm colormapwindows .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}}
test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} {
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 200 -colormap new
    wm geom .t2 +0+0
    frame .t2.a -width 100 -height 30
    frame .t2.b -width 100 -height 30 -colormap new
    pack .t2.a .t2.b -side top
    update
    set x [wm colormapwindows .t2]
    frame .t2.c -width 100 -height 30 -colormap new
    pack .t2.c -side top
    update
    list $x [wm colormapwindows .t2]
} {{.t2.b .t2} {.t2.b .t2.c .t2}}
test unixWm-14.3 {Tk_WmCmd procedure, "colormapwindows" option} {
    list [catch {wm col . "a \{"} msg] $msg
} {1 {unmatched open brace in list}}
test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} {
    list [catch {wm colormapwindows . foo} msg] $msg
} {1 {bad window path name "foo"}}
test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} {
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 200 -colormap new
    wm geom .t2 +0+0
    frame .t2.a -width 100 -height 30
    frame .t2.b -width 100 -height 30
    frame .t2.c -width 100 -height 30
    pack .t2.a .t2.b .t2.c -side top
    wm colormapwindows .t2 {.t2.c .t2 .t2.a}
    wm colormapwindows .t2
} {.t2.c .t2 .t2.a}
test unixWm-14.6 {Tk_WmCmd procedure, "colormapwindows" option} {
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 200
    wm geom .t2 +0+0
    frame .t2.a -width 100 -height 30
    frame .t2.b -width 100 -height 30
    frame .t2.c -width 100 -height 30
    pack .t2.a .t2.b .t2.c -side top
    wm colormapwindows .t2 {.t2.b .t2.a}
    wm colormapwindows .t2
} {.t2.b .t2.a}
test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} {
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 200 -colormap new
    wm geom .t2 +0+0
    set x [wm colormapwindows .t2]
    wm colormapwindows .t2 {}
    list $x [wm colormapwindows .t2]
} {{} {}}
catch {destroy .t2}

test unixWm-15.1 {Tk_WmCmd procedure, "command" option} {
    list [catch {wm command .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm command window ?value?"}}
test unixWm-15.2 {Tk_WmCmd procedure, "command" option} {
    list [catch {wm command .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm command window ?value?"}}
test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} {
    set result {}
    lappend result [wm command .t]
    wm command .t "test command"
    lappend result [testprop [testwrapper .t] WM_COMMAND]
    wm command .t "new command"
    lappend result [wm command .t]
    wm command .t {}
    lappend result [wm command .t] [testprop [testwrapper .t] WM_COMMAND]
} {{} {test
command
} {new command} {} {}}
test unixWm-15.4 {Tk_WmCmd procedure, "command" option, window not mapped} {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 +0+0
    wm command .t2 "test command"
    wm command .t2 "new command"
    wm command .t2 {}
    destroy .t2
} {}
test unixWm-15.5 {Tk_WmCmd procedure, "command" option} {
    list [catch {wm command .t "a \{b"} msg] $msg
} {1 {unmatched open brace in list}}

test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} {
    list [catch {wm deiconify .t 12} msg] $msg
} {1 {wrong # arguments: must be "wm deiconify window"}}
test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg red
    wm iconwindow .t .icon
    set result [list [catch {wm deiconify .icon} msg] $msg]
    destroy .icon
    set result
} {1 {can't deiconify .icon: it is an icon for .t}}
test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {
    wm iconify .t
    set result {}
    lappend result [winfo ismapped .t] [wm state .t]
    wm deiconify .t
    lappend result [winfo ismapped .t] [wm state .t]
} {0 iconic 1 normal}

test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} {
    list [catch {wm focusmodel .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}}
test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} {
    list [catch {wm focusmodel .t bogus} msg] $msg
} {1 {bad argument "bogus": must be active or passive}}
test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} {
    set result {} 
    lappend result [wm focusmodel .t]
    wm focusmodel .t active
    lappend result [wm focusmodel .t]
    wm focusmodel .t passive
    lappend result [wm focusmodel .t]
    set result
} {passive active passive}

test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} {
    list [catch {wm frame .t 12} msg] $msg
} {1 {wrong # arguments: must be "wm frame window"}}
test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable {
    expr [wm frame .t] == [winfo id .t]
} {0}
test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 +0+0
    wm overrideredirect .t2 1
    update
    set result [expr [wm frame .t2] == [winfo id .t2]]
    destroy .t2
    set result
} {1}

test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} {
    list [catch {wm geometry .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}}
test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable {
    wm geometry .t -1+5
    update
    wm geometry .t
} {100x50-1+5}
test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} nonPortable {
    wm geometry .t +10-4
    update
    wm geometry .t
} {100x50+10-4}
test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} nonPortable {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 -5+10
    listbox .t2.l -width 30 -height 12 -setgrid 1
    pack .t2.l
    update
    set result [wm geometry .t2]
    destroy .t2
    set result
} {30x12-5+10}
test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} nonPortable {
    wm geometry .t 150x300+5+6
    update
    set result {}
    lappend result [wm geometry .t]
    wm geometry .t {}
    update
    lappend result [wm geometry .t]
} {150x300+5+6 100x50+5+6}
test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} {
    list [catch {wm geometry .t qrs} msg] $msg
} {1 {bad geometry specifier "qrs"}}

test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 12 13 14 15 16} msg] $msg
} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} {
    set result {}
    lappend result [wm grid .t]
    wm grid .t 5 6 20 10
    lappend result [wm grid .t]
    wm grid .t {} {} {} {}
    lappend result [wm grid .t]
} {{} {5 6 20 10} {}}
test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t bad 10 11 12} msg] $msg
} {1 {expected integer but got "bad"}}
test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t -1 11 12 13} msg] $msg
} {1 {baseWidth can't be < 0}}
test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 10 foo 12 13} msg] $msg
} {1 {expected integer but got "foo"}}
test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 10 -11 12 13} msg] $msg
} {1 {baseHeight can't be < 0}}
test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 10 11 bar 13} msg] $msg
} {1 {expected integer but got "bar"}}
test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 10 11 -2 13} msg] $msg
} {1 {widthInc can't be < 0}}
test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 10 11 12 bogus} msg] $msg
} {1 {expected integer but got "bogus"}}
test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} {
    list [catch {wm grid .t 10 11 12 -1} msg] $msg
} {1 {heightInc can't be < 0}}

catch {destroy .t}
catch {destroy .icon}
toplevel .t -width 100 -height 50
wm geom .t +0+0
update

test unixWm-21.1 {Tk_WmCmd procedure, "group" option} {
    list [catch {wm group .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm group window ?pathName?"}}
test unixWm-21.2 {Tk_WmCmd procedure, "group" option} {
    list [catch {wm group .t bogus} msg] $msg
} {1 {bad window path name "bogus"}}
test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} {
    set result {}
    lappend result [wm group .t]
    wm group .t .
    set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm group .t] $bit
    wm group .t {}
    set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm group .t] $bit
} {{} . 0x40 {} 0x0}
test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} {
    catch {destroy .t2}