frame.test

linux系统下的音频通信

	catch {destroy .t}
	toplevel .t -width 300 -height 200 -bg #475601
	wm geometry .t +0+0
	update
	colorsFree .t
    } {0}
    test frame-3.12 {TkCreateFrame procedure} {nonPortable} {
	catch {destroy .t}
	toplevel .t -width 300 -height 200 -bg #475601 -colormap new
	wm geometry .t +0+0
	update
	colorsFree .t
    } {1}
    test frame-3.13 {TkCreateFrame procedure} {nonPortable} {
	catch {destroy .t}
	option add *t.class Toplevel2
	option add *Toplevel2.colormap new
	toplevel .t -width 300 -height 200 -bg #475601
	wm geometry .t +0+0
	update
	option clear
	colorsFree .t
    } {1}
    test frame-3.14 {TkCreateFrame procedure} {nonPortable} {
	catch {destroy .t}
	option add *t.class Toplevel3
	option add *Toplevel3.Colormap new
	toplevel .t -width 300 -height 200 -bg #475601 -colormap new
	wm geometry .t +0+0
	update
	option clear
	colorsFree .t
    } {1}
    test frame-3.15 {TkCreateFrame procedure, -use and -colormap} {unixOnly nonPortable} {
	catch {destroy .t}
	catch {destroy .x}
	toplevel .t -container 1 -width 300 -height 120
	wm geometry .t +0+0
	toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
	tkwait visibility .x
	set result "[colorsFree .t] [colorsFree .x]"
	destroy .t
	set result
    } {0 1}
    test frame-3.16 {TkCreateFrame procedure} {nonPortable} {
	catch {destroy .t}
	toplevel .t -width 300 -height 200 -bg #475601 -visual default
	wm geometry .t +0+0
	update
	colorsFree .t
    } {0}
    test frame-3.17 {TkCreateFrame procedure} {nonPortable} {
	catch {destroy .t}
	toplevel .t -width 300 -height 200 -bg #475601 -visual default \
		-colormap new
	wm geometry .t +0+0
	update
	colorsFree .t
    } {1}
    if {[lsearch -exact [winfo visualsavailable .] {grayscale 8}] >= 0} {
        test frame-3.18 {TkCreateFrame procedure} {nonPortable} {
	    catch {destroy .t}
	    toplevel .t -visual {grayscale 8} -width 300 -height 200 \
		    -bg #434343 
	    wm geometry .t +0+0
	    update
	    colorsFree .t 131 131 131
	} {1}
        test frame-3.19 {TkCreateFrame procedure} {nonPortable} {
	    catch {destroy .t}
	    option add *t.class T4
	    option add *T4.visual {grayscale 8}
	    toplevel .t -width 300 -height 200 -bg #434343
	    wm geometry .t +0+0
	    update
	    option clear
	    list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
	} {1 {grayscale 8}}
        test frame-3.20 {TkCreateFrame procedure} {nonPortable} {
	    catch {destroy .t}
	    set x ok
	    option add *t.class T5
	    option add *T5.Visual {grayscale 8}
	    toplevel .t -width 300 -height 200 -bg #434343
	    wm geometry .t +0+0
	    update
	    option clear
	    list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
	} {1 {grayscale 8}}
        test frame-3.21 {TkCreateFrame procedure} {nonPortable} {
	    catch {destroy .t}
	    set x ok
	    toplevel .t -visual {grayscale 8} -width 300 -height 200 \
		    -bg #434343 
	    wm geometry .t +0+0
	    update
	    colorsFree .t 131 131 131
	} {1}
    }
    destroy .t1
}
test frame-3.22 {TkCreateFrame procedure, default dimensions} {
    catch {destroy .t}
    toplevel .t
    wm geometry .t +0+0
    update
    set result "[winfo reqwidth .t] [winfo reqheight .t]"
    frame .t.f -bg red
    pack .t.f
    update
    lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
    destroy .t
    set result
} {200 200 1 1}
test frame-3.23 {TkCreateFrame procedure} {
    catch {destroy .f}
    list [catch {frame .f -gorp glob} msg] $msg
} {1 {unknown option "-gorp"}}
test frame-3.24 {TkCreateFrame procedure} {
    catch {destroy .t}
    list [catch {
	toplevel .t -width 300 -height 200 -colormap new -bogus option
	wm geometry .t +0+0
    } msg] $msg
} {1 {unknown option "-bogus"}}

test frame-4.1 {TkCreateFrame procedure} {
    catch {destroy .f}
    catch {frame .f -gorp glob}
    winfo exists .f
} 0
test frame-4.2 {TkCreateFrame procedure} {
    catch {destroy .f}
    list [frame .f -width 200 -height 100] [winfo exists .f]
} {.f 1}

catch {destroy .f}
frame .f -highlightcolor black
test frame-5.1 {FrameWidgetCommand procedure} {
    list [catch .f msg] $msg
} {1 {wrong # args: should be ".f option ?arg arg ...?"}}
test scale-5.2 {FrameWidgetCommand procedure, cget option} {
    list [catch {.f cget} msg] $msg
} {1 {wrong # args: should be ".f cget option"}}
test scale-5.3 {FrameWidgetCommand procedure, cget option} {
    list [catch {.f cget a b} msg] $msg
} {1 {wrong # args: should be ".f cget option"}}
test scale-5.4 {FrameWidgetCommand procedure, cget option} {
    list [catch {.f cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test scale-5.5 {FrameWidgetCommand procedure, cget option} {
    .f cget -highlightcolor
} {black}
test scale-5.6 {FrameWidgetCommand procedure, cget option} {
    list [catch {.f cget -screen} msg] $msg
} {1 {unknown option "-screen"}}
test scale-5.7 {FrameWidgetCommand procedure, cget option} {
    catch {destroy .t}
    toplevel .t
    catch {.t cget -screen}
} {0}
catch {destroy .t}
test frame-5.8 {FrameWidgetCommand procedure, configure option} {
    llength [.f configure]
} {16}
test frame-5.9 {FrameWidgetCommand procedure, configure option} {
    list [catch {.f configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test frame-5.10 {FrameWidgetCommand procedure, configure option} {
    list [catch {.f configure -gorp bogus} msg] $msg
} {1 {unknown option "-gorp"}}
test frame-5.11 {FrameWidgetCommand procedure, configure option} {
    list [catch {.f configure -width 200 -height} msg] $msg
} {1 {value for "-height" missing}}
test frame-5.12 {FrameWidgetCommand procedure} {
    list [catch {.f swizzle} msg] $msg
} {1 {bad option "swizzle": must be cget or configure}}

test frame-6.1 {ConfigureFrame procedure} {
    catch {destroy .f}
    frame .f -width 150
    list [winfo reqwidth .f] [winfo reqheight .f]
} {150 1}
test frame-6.2 {ConfigureFrame procedure} {
    catch {destroy .f}
    frame .f -height 97
    list [winfo reqwidth .f] [winfo reqheight .f]
} {1 97}
test frame-6.3 {ConfigureFrame procedure} {
    catch {destroy .f}
    frame .f
    set result {}
    lappend result [winfo reqwidth .f] [winfo reqheight .f]
    .f configure -width 100 -height 180
    lappend result [winfo reqwidth .f] [winfo reqheight .f]
    .f configure -width 0 -height 0
    lappend result [winfo reqwidth .f] [winfo reqheight .f]
} {1 1 100 180 100 180}

test frame-7.1 {FrameEventProc procedure} {
    frame .frame2
    set result [info commands .frame2]
    destroy .frame2
    lappend result [info commands .frame2]
} {.frame2 {}}
test frame-7.2 {FrameEventProc procedure} {
    eval destroy [winfo children .]
    frame .f1 -bg #543210
    rename .f1 .f2
    set x {}
    lappend x [winfo children .]
    lappend x [.f2 cget -bg]
    destroy .f1
    lappend x [info command .f*] [winfo children .]
} {.f1 #543210 {} {}}

test frame-8.1 {FrameCmdDeletedProc procedure} {
    eval destroy [winfo children .]
    frame .f1
    rename .f1 {}
    list [info command .f*] [winfo children .]
} {{} {}}
test frame-8.2 {FrameCmdDeletedProc procedure} {
    eval destroy [winfo children .]
    toplevel .f1 -menu .m
    wm geometry .f1 +0+0
    update
    rename .f1 {}
    update
    list [info command .f*] [winfo children .]
} {{} {}}
test frame-8.3 {FrameCmdDeletedProc procedure} {
    eval destroy [winfo children .]
    toplevel .f1 -menu .m
    wm geometry .f1 +0+0
    menu .m
    update
    rename .f1 {}
    update
    set result [list [info command .f*] [winfo children .]]
    eval destroy [winfo children .]
    set result
} {{} .m}

test frame-9.1 {MapFrame procedure} {
    catch {destroy .t}
    toplevel .t -width 100 -height 400
    wm geometry .t +0+0
    set result [winfo ismapped .t]
    update idletasks
    lappend result [winfo ismapped .t]
} {0 1}
test frame-9.2 {MapFrame procedure} {
    catch {destroy .t}
    toplevel .t -width 100 -height 400
    wm geometry .t +0+0
    destroy .t
    update
    winfo exists .t
} {0}
test frame-9.3 {MapFrame procedure, window deleted while mapping} {
    toplevel .t2 -width 200 -height 200
    wm geometry .t2 +0+0
    tkwait visibility .t2
    catch {destroy .t}
    toplevel .t -width 100 -height 400
    wm geometry .t +0+0
    frame .t2.f -width 50 -height 50
    bind .t2.f <Configure> {destroy .t}
    pack .t2.f -side top
    update idletasks
    winfo exists .t
} {0}

set l [interp hidden]
eval destroy [winfo children .]

test frame-10.1 {frame widget vs hidden commands} {
    catch {destroy .t}
    frame .t
    interp hide {} .t
    destroy .t
    list [winfo children .] [interp hidden]
} [list {} $l]

test frame-11.1 {TkInstallFrameMenu} {
    catch {destroy .t}
    menu .m1
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    .m1.system add command -label foo
    list [toplevel .t -menu .m1] [destroy .m1] [destroy .t]
} {.t {} {}}
test frame-11.2 {TkInstallFrameMenu - frame renamed} {
    catch {destroy .t}
    catch {rename foo {}}
    menu .m1
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    .m1.system add command -label foo
    toplevel .t
    list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1]
} {{} {} {} {}}


catch {destroy .f}
rename eatColors {}
rename colorsFree {}