Import Tk 8.6.8

2018-02-22 14:31:15 -05:00
parent b1c28856bb
commit 8e57feeeb9
193 changed files with 6172 additions and 4033 deletions
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -279,9 +279,9 @@ destroy .m1
 # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton, 
 # 5 radiobutton
 deleteWindows
-menu .m1
+menu .m1 -tearoff 1
 .m1 add command -label "command"
-menu .m2
+menu .m2 -tearoff 1
 .m2 add command -label "test"
 .m1 add cascade -label "cascade" -menu .m2
 .m1 add separator
@@ -1398,7 +1398,7 @@ test menu-3.23 {MenuWidgetCmd procedure, "delete" option} -setup {
 test menu-3.24 {MenuWidgetCmd procedure, "delete" option} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 delete 0 "foo"
 } -returnCodes error -result {bad menu entry index "foo"}
 test menu-3.25 {MenuWidgetCmd procedure, "delete" option} -setup {
@@ -1546,7 +1546,7 @@ test menu-3.40 {MenuWidgetCmd procedure, "index" option} -setup {
 test menu-3.41 {MenuWidgetCmd procedure, "index" option} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add command -label "test"
    .m1 add command -label "3"
    .m1 add command -label "another label"
@@ -1739,7 +1739,7 @@ test menu-3.61 {MenuWidgetCmd procedure, "type" option} -setup {
 test menu-3.62 {MenuWidgetCmd procedure, "type" option} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 type 0
 } -cleanup {
 	destroy .m1
@@ -1772,14 +1772,38 @@ test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} -setup {
 } -cleanup {
 	destroy .m1
 } -returnCodes error -result {wrong # args: should be ".m1 yposition index"}
-test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} -setup {
+test menu-3.66a {MenuWidgetCmd procedure, "yposition" option, no tearoff} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 0
+    .m1 yposition 1
+} -cleanup {
+	destroy .m1
+} -result {0}
+test menu-3.66b {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints {
+    notAqua
+} -setup {
+	destroy .m1
+} -body {
+    # on Win or Linux, tearoff menus are supported
+    # see menu-3.66c for aqua
+    menu .m1 -tearoff 1
    .m1 yposition 1
 } -cleanup {
 	destroy .m1
 } -result {1}
+test menu-3.66c {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints {
+    aqua
+} -setup {
+	destroy .m1
+} -body {
+    # on OS X, tearoff menus are not supported
+    # see menu-3.66b for win or linux
+    menu .m1 -tearoff 1
+    .m1 yposition 1
+} -cleanup {
+	destroy .m1
+} -result {0}
 test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup {
 	destroy .m1
 } -body {
@@ -1883,7 +1907,7 @@ test menu-4.6 {TkInvokeMenu: radiobutton} -setup {
    destroy .m1
 } -body {
    catch {unset foo}
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
@@ -1895,7 +1919,7 @@ test menu-4.7 {TkInvokeMenu: radiobutton} -setup {
    destroy .m1
 } -body {
    catch {unset foo}
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
@@ -1949,7 +1973,7 @@ test menu-4.11 {TkInvokeMenu} -setup {
 test menu-4.12 {TkInvokeMenu} -setup {
    destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add command -label "test" -command ".m1 delete 1"
    list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2
 } -cleanup {
@@ -2337,7 +2361,7 @@ test menu-8.5 {DestroyMenuEntry} -setup {
 test menu-8.6 {DestroyMenuEntry} -setup {
    destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add command -label "one"
    .m1 add command -label "two"
    list [.m1 delete 1] [.m1 entrycget 1 -label] [destroy .m1]
@@ -2737,7 +2761,7 @@ test menu-12.4 {ConfigureMenuCloneEntries} -setup {
 test menu-13.1 {TkGetMenuIndex} -setup {
    deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
@@ -2804,7 +2828,7 @@ test menu-13.6 {TkGetMenuIndex} -setup {
 test menu-13.7 {TkGetMenuIndex} -setup {
    deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
@@ -2937,7 +2961,7 @@ test menu-16.3 {MenuAddOrInsert} -setup {
 test menu-16.4 {MenuAddOrInsert} -setup {
 	deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    .m1 add command -label "test"
    .m1 insert 0 command -label "test2"
    .m1 entrycget 1 -label
@@ -3277,7 +3301,7 @@ test menu-20.9 {CloneMenu - cascades entries} -setup {
 test menu-20.10 {CloneMenu - tearoff fields} -setup {
 	deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
    list [.m1 clone .m2 normal] [.m2 cget -tearoff]
 } -cleanup {
 	deleteWindows
@@ -3328,7 +3352,7 @@ test menu-22.2 {GetIndexFromCoords} -setup {
 } -result {0}
 test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup {
 	deleteWindows
-} -constraints {unix} -body {
+} -constraints {x11} -body {
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
@@ -3340,7 +3364,7 @@ test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup {
 } -result {0}
 test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup {
 	deleteWindows
-} -constraints {unix} -body {
+} -constraints {x11} -body {
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
@@ -3354,7 +3378,7 @@ test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup {
 } -result {0}
 test menu-22.5 {GetIndexFromCoords: mapped wide window} -setup {
 	deleteWindows
-} -constraints {unix} -body {
+} -constraints {x11} -body {
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
@@ -3878,6 +3902,35 @@ test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup {
    destroy .m
 } -result {1 {a menubar menu cannot be posted}}

+test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over it - bug fa32290898} -setup {
+} -constraints {userInteraction} -body {
+    toplevel .top
+    ttk::menubutton .top.mb -text "Some menu";
+    menu .top.mb.m;
+    .top.mb.m add command -label "Item 1";
+    .top.mb.m add command -label "Item 2";
+    .top.mb configure -menu .top.mb.m;
+    pack .top.mb
+    update
+    # simulate mouse click on the menubutton, which posts its menu
+    event generate .top.mb <ButtonPress-1> -warp 1
+    update
+    after 50
+    event generate .top.mb <ButtonRelease-1>
+    update
+    # simulate mouse click on the menu again, i.e. without
+    # entering/leaving the posted menu
+    event generate .top.mb <ButtonPress-1>
+    update
+    after 50
+    event generate .top.mb <ButtonRelease-1>
+    update
+    # the menu shall have been unposted by the second click
+    winfo ismapped .top.mb.m
+} -cleanup {
+    destroy .top.mb.m .top.m .top
+} -result {0}
+

 # cleanup
 imageFinish