menudraw.test

linux系统下的音频通信

    image create test image1
    image create test image2
    menu .m1
    .m1 add checkbutton -image image1 -selectimage image2
    set tearoff [tkTearOffMenu .m1 40 40]
    update idletasks
    list [image delete image2] [destroy .m1] [eval image delete [image names]]
} {{} {} {}}

#Don't know how to test missing tkwin in DisplayMenu
test menuDraw-12.1 {DisplayMenu - menubar background} {unixOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo -menu .m2
    . configure -menu .m1
    list [update] [. configure -menu ""] [destroy .m1]
} {{} {} {}}
test menuDraw-12.2 {Display menu - no entries} {
    catch {destroy .m1}
    menu .m1
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test menuDraw-12.3 {DisplayMenu - one entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test menuDraw-12.4 {DisplayMenu - two entries} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    .m1 add command -label "two"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test menuDraw.12.5 {DisplayMenu - two columns - first bigger} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    .m1 add command -label "two"
    .m1 add command -label "three" -columnbreak 1
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test menuDraw-12.5 {DisplayMenu - two column - second  bigger} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    .m1 add command -label "two" -columnbreak 1
    .m1 add command -label "three"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test menuDraw.12.7 {DisplayMenu - three columns} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    .m1 add command -label "two" -columnbreak 1
    .m1 add command -label "three"
    .m1 add command -label "four"
    .m1 add command -label "five"
    .m1 add command -label "six"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test menuDraw-12.6 {Display menu - testing for extra space and menubars} {unixOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo
    . configure -menu .m1
    list [update] [. configure -menu ""] [destroy .m1]
} {{} {} {}}
test menuDraw-12.7 {Display menu - extra space at end of menu} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    wm geometry $tearoff 200x100
    list [update] [destroy .m1]
} {{} {}}

test menuDraw-13.1 {TkMenuEventProc - Expose} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label "one"
    menu .m2
    .m2 add command -label "two"
    set tearoff1 [tkTearOffMenu .m1 40 40]
    set tearoff2 [tkTearOffMenu .m2 40 40]
    list [raise $tearoff2] [update] [destroy .m1] [destroy .m2]
} {{} {} {} {}}
test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [wm geometry $tearoff 200x100] [update] [destroy .m1]
} {{} {} {}}
test menuDraw-13.3 {TkMenuEventProc - ActivateNotify} {macOnly} {
    catch {destroy .t2}
    toplevel .t2 -menu .t2.m1
    menu .t2.m1
    .t2.m1 add command -label foo
    tkTearOffMenu .t2.m1 40 40
    list [catch {update} msg] $msg [destroy .t2]
} {0 {} {}}
# Testing deletes is hard, and I am going to do my best. Don't know how
# to test the case where we have already cleared the tkwin field in the
# menuPtr.
test menuDraw-13.4 {TkMenuEventProc - simple delete} {
    catch {destroy .m1}
    menu .m1
    list [destroy .m1]
} {{}}
test menuDraw-13.5 {TkMenuEventProc - nothing pending} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    update idletasks
    list [destroy .m1]
} {{}}

test menuDraw-14.1 {TkMenuImageProc} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    image create test image1
    .m1 add command -image image1
    update idletasks
    list [image delete image1] [destroy .m1]
} {{} {}}
test menuDraw-14.2 {TkMenuImageProc} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    image create test image1
    .m1 add command -image image1
    list [image delete image1] [destroy .m1]
} {{} {}}

test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo" -state active
    set tearoff [tkTearOffMenu .m1 40 40]
    list [$tearoff index active] [destroy .m1]
} {none {}}
test menuDraw-15.3 {TkPostTearoffMenu - post command} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1 -postcommand "set foo .m1"
    .m1 add command -label "foo"
    list [catch {tkTearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1]
} {0 .m1 {} {}}
test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    .m1 add command -label "foo"
    list [catch {tkTearOffMenu .m1 40 40} msg] $msg [winfo exists .m1]
} {0 {} 0}
test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    set height [winfo screenheight .m1]
    list [catch {tkTearOffMenu .m1 40 $height}] [destroy .m1]
} {0 {}}
test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    set width [winfo screenwidth .m1]
    list [catch {tkTearOffMenu .m1 $width 40}] [destroy .m1]
} {0 {}}


test menuDraw-16.1 {TkPostSubmenu} {unixOnly} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to make this menu go away."
    set tearoff [tkTearOffMenu .m1 40 40]
    $tearoff postcascade 0
    list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}
test menuDraw-16.2 {TkPostSubMenu} {unixOnly} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 add cascade -label "two" -menu .m2
    .m1 add cascade -label "three" -menu .m3
    menu .m2
    .m2 add command -label "two"
    menu .m3
    .m3 add command -label "three"
    set tearoff [tkTearOffMenu .m1 40 40]
    $tearoff postcascade 0
    list [$tearoff postcascade 1] [destroy .m1] [destroy .m2] [destroy .m3]
} {{} {} {} {}}
test menuDraw-16.3 {TkPostSubMenu} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label test -menu .m2
    list [.m1 postcascade 1] [destroy .m1]
} {{} {}}
test menuDraw-16.4 {TkPostSubMenu} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label test
    set tearoff [tkTearOffMenu .m1 40 40]
    list [$tearoff postcascade 0] [destroy .m1]
} {{} {}}
test menuDraw-16.5 {TkPostSubMenu} {unixOnly} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2 -postcommand "glorp"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
} {1 {invalid command name "glorp"} {} {}}
test menuDraw-16.6 {TkPostSubMenu} {menuInteractive} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to get rid of this menu"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}

test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1 -tearoff 0
    .m1 add cascade -label test -menu .m2
    menu .m2 -tearoff 0
    .m2 add command -label foo
    . configure -menu .m1
    foreach w [winfo children .] {
	if {[$w cget -type] == "menubar"} {
		break
	}
    }
    list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2]
} {{} {} {} {}}
test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to make this menu go away"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}

deleteWindows