unixwm.test

linux系统下的音频通信

    toplevel .t2
    wm geom .t2 +0+0
    wm group .t .t2
    set hints [testprop [testwrapper .t] WM_HINTS]
    set result [expr [testwrapper .t2] - [lindex $hints 8]]
    destroy .t2
    set result
} {0}
test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader 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 group .t3 .t2
    lappend result [expr {[testwrapper .t2] == ""}]
    destroy .t2 .t3
    set result
} {{} 0}

test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} {
    list [catch {wm iconbitmap .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}}
test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} {
    set result {}
    lappend result [wm iconbitmap .t]
    wm iconbitmap .t questhead
    set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm iconbitmap .t] $bit
    wm iconbitmap .t {}
    set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm iconbitmap .t] $bit
} {{} questhead 0x4 {} 0x0}
test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} {
    list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
} {1 {bitmap "bad-bitmap" not defined}}

test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} {
    list [catch {wm iconify .t 12} msg] $msg
} {1 {wrong # arguments: must be "wm iconify window"}}
test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} {
    catch {destroy .t2}
    toplevel .t2
    wm overrideredirect .t2 1
    set result [list [catch {wm iconify .t2} msg] $msg]
    destroy .t2
    set result
} {1 {can't iconify ".t2": override-redirect flag is set}}
test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 +0+0
    wm transient .t2 .t
    set result [list [catch {wm iconify .t2} msg] $msg]
    destroy .t2
    set result
} {1 {can't iconify ".t2": it is a transient}}
test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 +0+0
    wm iconwindow .t .t2
    set result [list [catch {wm iconify .t2} msg] $msg]
    destroy .t2
    set result
} {1 {can't iconify .t2: it is an icon for .t}}
test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 +0+0
    wm iconify .t2
    update
    set result [winfo ismapped .t2]
    destroy .t2
    set result
} {0}
test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 -0+0
    update
    set result [winfo ismapped .t2]
    wm iconify .t2
    lappend result [winfo ismapped .t2]
    destroy .t2
    set result
} {1 0}

test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} {
    list [catch {wm iconmask .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}}
test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} {
    set result {}
    lappend result [wm iconmask .t]
    wm iconmask .t questhead
    set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm iconmask .t] $bit
    wm iconmask .t {}
    set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm iconmask .t] $bit
} {{} questhead 0x20 {} 0x0}
test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} {
    list [catch {wm iconmask .t bogus} msg] $msg
} {1 {bitmap "bogus" not defined}}

test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} {
    list [catch {wm icon .t} msg] $msg
} {1 {unknown or ambiguous option "icon": 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}}
test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} {
    list [catch {wm iconname .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconname window ?newName?"}}
test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} {
    set result {}
    lappend result [wm iconname .t]
    wm iconname .t test_name
    lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
    wm iconname .t {}
    lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
} {{} test_name test_name {} {}}

test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t 12} msg] $msg
} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t 12 13 14} msg] $msg
} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} {
    set result {}
    lappend result [wm iconposition .t]
    wm iconposition .t 10 15
    set prop [testprop [testwrapper .t] WM_HINTS]
    lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6]
    lappend result  [format 0x%x [expr 0x10 & [lindex $prop 0]]]
    wm iconposition .t {} {}
    set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm iconposition .t] $bit
} {{} {10 15} 0xa 0xf 0x10 {} 0x0}
test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t bad 13} msg] $msg
} {1 {expected integer but got "bad"}}
test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t 13 lousy} msg] $msg
} {1 {expected integer but got "lousy"}}

test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} {
    list [catch {wm iconwindow .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg green
    set result {}
    lappend result [wm iconwindow .t]
    wm iconwindow .t .icon
    set prop [testprop [testwrapper .t] WM_HINTS]
    lappend result [wm iconwindow .t] [wm state .icon]
    lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]]
    lappend result [expr [testwrapper .icon] == [lindex $prop 4]]
    wm iconwindow .t {}
    set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \
	    WM_HINTS] 0]]]
    lappend result [wm iconwindow .t]  [wm state .icon] $bit
    destroy .icon
    set result
} {{} .icon icon 0x8 1 {} withdrawn 0x0}
test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} {
    list [catch {wm iconwindow .t bogus} msg] $msg
} {1 {bad window path name "bogus"}}
test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} {
    catch {destroy .b}
    button .b -text Help
    set result [list [catch {wm iconwindow .t .b} msg] $msg]
    destroy .b
    set result
} {1 {can't use .b as icon window: not at top level}}
test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg green
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 -0+0
    wm iconwindow .t2 .icon
    set result [list [catch {wm iconwindow .t .icon} msg] $msg]
    destroy .t2
    destroy .icon
    set result
} {1 {.icon is already an icon for .t2}}
test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} {
    catch {destroy .icon}
    catch {destroy .icon2}
    toplevel .icon -width 50 -height 50 -bg green
    toplevel .icon2 -width 50 -height 50 -bg red
    set result {}
    wm iconwindow .t .icon
    lappend result [wm state .icon] [wm state .icon2]
    wm iconwindow .t .icon2
    lappend result [wm state .icon] [wm state .icon2]
    destroy .icon .icon2
    set result
} {icon normal withdrawn icon}
test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg green
    wm geometry .icon +0+0
    update
    set result {}
    lappend result [wm state .icon] [winfo viewable .icon]
    wm iconwindow .t .icon
    lappend result [wm state .icon] [winfo viewable .icon]
    destroy .icon
    set result
} {normal 1 icon 0}

test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize} msg]  $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . a} msg]  $msg
} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . a b c} msg]  $msg
} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
    wm maxsize .t
}  {1137 870}
test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . x 100} msg]  $msg
} {1 {expected integer but got "x"}}
test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . 100 bogus} msg]  $msg
} {1 {expected integer but got "bogus"}}
test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} {
    wm maxsize .t 200 150
    wm maxsize .t
} {200 150}
test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
    # Not portable, because some window managers let applications override
    # minsize and maxsize.

    wm maxsize .t 200 150
    wm geom .t 300x200
    update
    list [winfo width .t] [winfo height .t]
} {200 150}

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

test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize} msg]  $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . a} msg]  $msg
} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . a b c} msg]  $msg
} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} {
    wm minsize .t
}  {1 1}
test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . x 100} msg]  $msg
} {1 {expected integer but got "x"}}
test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . 100 bogus} msg]  $msg
} {1 {expected integer but got "bogus"}}
test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} {
    wm minsize .t 200 150
    wm minsize .t
} {200 150}
test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} {
    # Not portable, because some window managers let applications override
    # minsize and maxsize.

    wm minsize .t 150 100
    wm geom .t 50x50
    update
    list [winfo width .t] [winfo height .t]
} {150 100}

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

test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} {
    list [catch {wm overrideredirect .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}}
test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} {
    list [catch {wm overrideredirect .t boo} msg]  $msg
} {1 {expected boolean value but got "boo"}}
test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} {
    set result {}
    lappend result [wm overrideredirect .t]
    wm overrideredirect .t true
    lappend result [wm overrideredirect .t]
    wm overrideredirect .t off
    lappend result [wm overrideredirect .t]
} {0 1 0}

test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} {
    list [catch {wm positionfrom .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}}
test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} {
    set result {}
    lappend result [wm positionfrom .t]
    wm positionfrom .t program
    update
    set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
	    WM_NORMAL_HINTS] 0]]]
    lappend result [wm positionfrom .t] $bit
    wm positionfrom .t user
    update
    set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
	    WM_NORMAL_HINTS] 0]]]
    lappend result [wm positionfrom .t] $bit
} {user program 0x4 user 0x1}
test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} {
    list [catch {wm positionfrom .t none} msg]  $msg
} {1 {bad argument "none": must be program or user}}

test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} {
    list [catch {wm protocol .t 1 2 3} msg]  $msg
} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}}
test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} {
    wm protocol .t {foo a} {a b c}
    wm protocol .t bar {test script for bar}
    set result [wm protocol .t]
    wm protocol .t {foo a} {}
    wm protocol .t bar {}
    set result
} {bar {foo a}}
test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} {
    set result {}
    lappend result [wm protocol .t]
    set x {}
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
	lappend x [winfo atomname $i]
    }
    lappend result $x
    wm protocol .t foo {test script}
    wm protocol .t bar {test script}
    set x {}
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
	lappend x [winfo atomname $i]
    }
    lappend result [wm protocol .t] $x
    wm protocol .t foo {}
    wm protocol .t bar {}
    set x {}
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
	lappend x [winfo atomname $i]
    }
    lappend result [wm protocol .t] $x
} {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW}
test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} {
    set result {}
    wm protocol .t foo {a b c}
    wm protocol .t bar {test script for bar}
    lappend result [wm protocol .t foo] [wm protocol .t bar]
    wm protocol .t foo {}
    wm protocol .t bar {}
    lappend result [wm protocol .t foo] [wm protocol .t bar]
} {{a b c} {test script for bar} {} {}}