tk/tests/menu.test

   1 # This file is a Tcl script to test menus in Tk.  It is
   2 # organized in the standard fashion for Tcl tests.
   3 #
   4 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
   5 # Copyright (c) 1998-1999 by Scriptics Corporation.
   6 # All rights reserved.
   7 #
   8 # RCS: @(#) $Id$
   9
  10 package require tcltest 2.1
  11 namespace import -force tcltest::configure
  12 namespace import -force tcltest::testsDirectory
  13 configure -testdir [file join [pwd] [file dirname [info script]]]
  14 configure -loadfile [file join [testsDirectory] constraints.tcl]
  15 tcltest::loadTestedCommands
  16
  17 test menu-1.1 {Tk_MenuCmd procedure} {
  18     list [catch menu msg] $msg
  19 } {1 {wrong # args: should be "menu pathName ?options?"}}
  20 test menu-1.2 {Tk_MenuCmd procedure} {
  21     list [catch "menu bogus" msg] $msg
  22 } {1 {bad window path name "bogus"}}
  23 test menu-1.3 {Tk_MenuCmd procedure} {
  24     list [catch "menu .m1 foo" msg] $msg
  25 } {1 {unknown option "foo"}}
  26 test menu-1.4 {Tk_MenuCmd procedure} {
  27     catch {destroy .m1}
  28     list [catch {menu .m1} msg] $msg [destroy .m1]
  29 } {0 .m1 {}}
  30 test menu-1.5 {Tk_MenuCmd - creating menubar} {
  31     catch {destroy .m1}
  32     menu .m1
  33     .m1 add cascade -label Test -menu ""
  34     list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
  35 } {{} {} {}}
  36 test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} {
  37     catch {destroy .t2}
  38     catch {destroy .m1}
  39     toplevel .t2 -menu .m1
  40     wm geometry .t2 +0+0
  41     list [catch {menu .m1} msg] $msg [destroy .m1 .t2]
  42 } {0 .m1 {}}
  43 test menu-1.7 {Tk_MenuCmd procedure one clone cascade} {
  44     catch {destroy .m1}
  45     catch {destroy .m2}
  46     catch {destroy .t2}
  47     toplevel .t2 -menu .m1
  48     wm geometry .t2 +0+0
  49     menu .m1
  50     .m1 add cascade -menu .m2
  51     list [catch {menu .m2} msg] $msg [destroy .t2 .m1 .m2]
  52 } {0 .m2 {}}
  53 test menu-1.8 {Tk_MenuCmd procedure two clone cascades} {
  54     catch {destroy .m1}
  55     catch {destroy .t2}
  56     catch {destroy .t3}
  57     catch {destroy .m2}
  58     menu .m1
  59     .m1 add cascade -menu .m2
  60     toplevel .t2 -menu .m1
  61     wm geometry .t2 +0+0
  62     toplevel .t3 -menu .m1
  63     wm geometry .t3 +0+0
  64     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  65 } {0 .m2 {}}
  66 test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} {
  67     catch {destroy .t2}
  68     catch {destroy .m1}
  69     catch {destroy .t3}
  70     catch {destroy .m2}
  71     toplevel .t2 -menu .m1
  72     wm geometry .t2 +0+0
  73     menu .m1
  74     .m1 add cascade -menu .m2
  75     toplevel .t3 -menu .m1
  76     wm geometry .t3 +0+0
  77     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  78 } {0 .m2 {}}
  79 test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} {
  80     catch {destroy .t2}
  81     catch {destroy .t3}
  82     catch {destroy .m1}
  83     catch {destroy .m2}
  84     toplevel .t2 -menu .m1
  85     wm geometry .t2 +0+0
  86     toplevel .t3 -menu .m1
  87     wm geometry .t3 +0+0
  88     menu .m1
  89     .m1 add cascade -menu .m2
  90     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  91 } {0 .m2 {}}
  92 test menu-1.11 {Tk_MenuCmd procedure three clones cascades} {
  93     catch {destroy .t2}
  94     catch {destroy .t3}
  95     catch {destroy .t4}
  96     catch {destroy .m1}
  97     catch {destroy .m2}
  98     toplevel .t2 -menu .m1
  99     wm geometry .t2 +0+0
 100     toplevel .t3 -menu .m1
 101     wm geometry .t3 +0+0
 102     toplevel .t4 -menu .m1
 103     wm geometry .t4 +0+0
 104     menu .m1
 105     .m1 add cascade -menu .m2
 106     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .t4 .m1 .m2]
 107 } {0 .m2 {}}
 108 test menu-1.12 {Tk_MenuCmd procedure} {
 109     catch {destroy .t2}
 110     catch {destroy .m1}
 111     toplevel .t2 -menu .m1
 112     wm geometry .t2 +0+0
 113     list [catch {menu .m1} msg] $msg [destroy .t2 .m1]
 114 } {0 .m1 {}}
 115 test menu-1.13 {Tk_MenuCmd procedure} {
 116     catch {destroy .t2}
 117     catch {destroy .t3}
 118     catch {destroy .m1}
 119     toplevel .t2 -menu .m1
 120     wm geometry .t2 +0+0
 121     toplevel .t3 -menu .m1
 122     wm geometry .t3 +0+0
 123     list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .m1]
 124 } {0 .m1 {}}
 125 test menu-1.14 {Tk_MenuCmd procedure} {
 126     catch {destroy .t2}
 127     catch {destroy .t3}
 128     catch {destroy .t4}
 129     catch {destroy .m1}
 130     toplevel .t2 -menu .m1
 131     wm geometry .t2 +0+0
 132     toplevel .t3 -menu .m1
 133     wm geometry .t3 +0+0
 134     toplevel .t4 -menu .m1
 135     wm geometry .t4 +0+0
 136     list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1]
 137 } {0 .m1 {}}
 138
 139 catch {destroy .m1}
 140 menu .m1
 141 set i 1
 142 foreach configTest {
 143     {-activebackground #012345 #012345 non-existent
 144             {unknown color name "non-existent"}}
 145     {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
 146     {-activeforeground #ff0000 #ff0000 non-existent
 147             {unknown color name "non-existent"}}
 148     {-background #ff0000 #ff0000 non-existent
 149             {unknown color name "non-existent"}}
 150     {-bg #110022 #110022 bogus {unknown color name "bogus"}}
 151     {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
 152     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
 153     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
 154     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
 155     {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 156             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
 157             {font "" doesn't exist}}
 158     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
 159     {-postcommand "any old string" "any old string" {} {}}
 160     {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
 161     {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
 162     {-takefocus "any string" "any string" {} {}}
 163     {-tearoff 0 0}
 164     {-tearoff 1 1}
 165     {-tearoffcommand "any old string" "any old string" {} {}}
 166 } {
 167     set name [lindex $configTest 0]
 168     set value [lindex $configTest 1]
 169     set result [lindex $configTest 2]
 170     test menu-2.$i [list configuration options $name $value $result] {
 171         .m1 configure $name $value
 172         lindex [.m1 configure $name] 4
 173     } $result
 174     incr i
 175     if {[lindex $configTest 3] != ""} {
 176         set value [lindex $configTest 3]
 177         set result [lindex $configTest 4]
 178         test menu-2.$i [list configuration options $name $value $result] {
 179             list [catch {.m1 configure $name $value} msg] $msg
 180         } [list 1 $result]
 181     }
 182     .m1 configure $name [lindex [.m1 configure $name] 3]
 183     incr i
 184 }
 185 destroy .m1
 186
 187 # We need to test all of the options with all of the different types of
 188 # menu entries. The following code sets up .m1 with 6 items. It then
 189 # runs through the big table below it.
 190 # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton,
 191 # 5 radiobutton
 192
 193 menu .m1
 194 .m1 add command -label "command"
 195 menu .m2
 196 .m2 add command -label "test"
 197 .m1 add cascade -label "cascade" -menu .m2
 198 .m1 add separator
 199 .m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
 200 .m1 add radiobutton -label "radiobutton" -variable radio
 201 image create photo image1 -file [file join $tk_library demos images earth.gif]
 202
 203 foreach configTest {
 204     {-activebackground
 205         {{#012345
 206             {{unknown option "-activebackground"} #012345 #012345
 207             {unknown option "-activebackground"} #012345 #012345
 208             }
 209         }
 210         {non-existent
 211             {{unknown option "-activebackground"}
 212             {unknown color name "non-existent"}
 213             {unknown color name "non-existent"}
 214             {unknown option "-activebackground"}
 215             {unknown color name "non-existent"}
 216             {unknown color name "non-existent"}
 217             }
 218         }}
 219     }
 220     {-activeforeground
 221         {{#ff0000
 222             {{unknown option "-activeforeground"}
 223             #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
 224             }
 225         }
 226         {non-existent
 227             {{unknown option "-activeforeground"}
 228             {unknown color name "non-existent"}
 229             {unknown color name "non-existent"}
 230             {unknown option "-activeforeground"}
 231             {unknown color name "non-existent"}
 232             {unknown color name "non-existent"}
 233             }
 234         }}
 235     }
 236     {-accelerator
 237         {{"Ctrl+S"
 238             {{unknown option "-accelerator"}
 239             "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"}
 240             "Ctrl+S" "Ctrl+S"
 241             }
 242         }}
 243     }
 244     {-background
 245         {{#ff0000
 246             {#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000
 247             }
 248         }
 249         {non-existent
 250             {{unknown color name "non-existent"}
 251             {unknown color name "non-existent"}
 252             {unknown color name "non-existent"}
 253             {unknown color name "non-existent"}
 254             {unknown color name "non-existent"}
 255             {unknown color name "non-existent"}
 256             }
 257         }}
 258     }
 259     {-bitmap
 260         {{questhead
 261             {{unknown option "-bitmap"} questhead questhead
 262             {unknown option "-bitmap"} questhead questhead
 263             }
 264         }
 265         {badValue
 266             {{unknown option "-bitmap"}
 267             {bitmap "badValue" not defined}
 268             {bitmap "badValue" not defined}
 269             {unknown option "-bitmap"}
 270             {bitmap "badValue" not defined}
 271             {bitmap "badValue" not defined}
 272             }
 273         }}
 274     }
 275     {-columnbreak
 276         {{1
 277             {{unknown option "-columnbreak"} 1 1
 278             {unknown option "-columnbreak"} 1 1}
 279         }}
 280     }
 281     {-command
 282         {{beep
 283             {{unknown option "-command"} beep beep
 284             {unknown option "-command"} beep beep
 285             }
 286         }}
 287     }
 288     {-font
 289         {{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 290             {{unknown option "-font"}
 291             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 292             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 293             {unknown option "-font"}
 294             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 295             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 296             }
 297         }
 298         {{kill rock stars}
 299             {{unknown option "-font"}
 300             {expected integer but got "rock"}
 301             {expected integer but got "rock"}
 302             {unknown option "-font"}
 303             {expected integer but got "rock"}
 304             {expected integer but got "rock"}
 305             }
 306         }}
 307     }
 308     {-foreground
 309         {{#110022
 310             {{unknown option "-foreground"} #110022 #110022
 311             {unknown option "-foreground"} #110022 #110022
 312             }
 313         }
 314         {non-existent
 315             {{unknown option "-foreground"}
 316             {unknown color name "non-existent"}
 317             {unknown color name "non-existent"}
 318             {unknown option "-foreground"}
 319             {unknown color name "non-existent"}
 320             {unknown color name "non-existent"}
 321             }
 322         }}
 323     }
 324     {-image
 325         {{image1
 326             {{unknown option "-image"} image1 image1
 327             {unknown option "-image"} image1 image1
 328             }
 329         }
 330         {bogus
 331             {{unknown option "-image"}
 332             {image "bogus" doesn't exist}
 333             {image "bogus" doesn't exist}
 334             {unknown option "-image"}
 335             {image "bogus" doesn't exist}
 336             {image "bogus" doesn't exist}
 337             }
 338         }
 339         {""
 340             {{unknown option "-image"}
 341             {}
 342             {}
 343             {unknown option "-image"}
 344             {}
 345             {}
 346             }
 347         }}
 348     }
 349     {-indicatoron
 350         {{1
 351             {{unknown option "-indicatoron"}
 352             {unknown option "-indicatoron"}
 353             {unknown option "-indicatoron"}
 354             {unknown option "-indicatoron"} 1 1
 355             }
 356         }}
 357     }
 358     {-label
 359         {{test
 360             {{unknown option "-label"} test test
 361             {unknown option "-label"} test test
 362             }
 363         }}
 364     }
 365     {-menu
 366         {{.m2
 367             {{unknown option "-menu"}
 368             {unknown option "-menu"} .m2
 369             {unknown option "-menu"}
 370             {unknown option "-menu"}
 371             {unknown option "-menu"}
 372             }
 373         }}
 374     }
 375     {-offvalue
 376         {{off
 377             {{unknown option "-offvalue"}
 378             {unknown option "-offvalue"}
 379             {unknown option "-offvalue"}
 380             {unknown option "-offvalue"}
 381             off
 382             {unknown option "-offvalue"}
 383             }
 384         }}
 385     }
 386     {-onvalue
 387         {{on
 388             {{unknown option "-onvalue"}
 389             {unknown option "-onvalue"}
 390             {unknown option "-onvalue"}
 391             {unknown option "-onvalue"}
 392             on
 393             {unknown option "-onvalue"}
 394             }
 395         }}
 396     }
 397     {-selectcolor
 398         {{#110022
 399             {{unknown option "-selectcolor"}
 400             {unknown option "-selectcolor"}
 401             {unknown option "-selectcolor"}
 402             {unknown option "-selectcolor"}
 403             #110022
 404             #110022
 405             }
 406         }
 407         {non-existent
 408             {{unknown option "-selectcolor"}
 409             {unknown option "-selectcolor"}
 410             {unknown option "-selectcolor"}
 411             {unknown option "-selectcolor"}
 412             {unknown color name "non-existent"}
 413             {unknown color name "non-existent"}
 414             }
 415         }}
 416     }
 417     {-selectimage
 418         {{image1
 419             {{unknown option "-selectimage"}
 420             {unknown option "-selectimage"}
 421             {unknown option "-selectimage"}
 422             {unknown option "-selectimage"} image1 image1
 423             }
 424         }
 425         {bogus
 426             {{unknown option "-selectimage"}
 427             {unknown option "-selectimage"}
 428             {unknown option "-selectimage"}
 429             {unknown option "-selectimage"}
 430             {image "bogus" doesn't exist}
 431             {image "bogus" doesn't exist}
 432             }
 433         }
 434         {""
 435             {{unknown option "-selectimage"}
 436             {unknown option "-selectimage"}
 437             {unknown option "-selectimage"}
 438             {unknown option "-selectimage"}
 439             {}
 440             {}
 441             }
 442         }}
 443     }
 444     {-state
 445         {{normal
 446             {normal normal normal {unknown option "-state"} normal normal
 447             }
 448         }}
 449     }
 450     {-value
 451         {{"any string"
 452             {{unknown option "-value"}
 453             {unknown option "-value"}
 454             {unknown option "-value"}
 455             {unknown option "-value"}
 456             {unknown option "-value"} "any string"
 457             }
 458         }}
 459     }
 460     {-variable
 461         {{"any string"
 462             {{unknown option "-variable"}
 463             {unknown option "-variable"}
 464             {unknown option "-variable"}
 465             {unknown option "-variable"}
 466             "any string"
 467             "any string"
 468             }
 469         }}
 470     }
 471     {-underline
 472         {{0
 473             {{unknown option "-underline"} 0 0
 474             {unknown option "-underline"} 0 0
 475             }
 476         }
 477         {3p
 478             {{unknown option "-underline"}
 479             {expected integer but got "3p"}
 480             {expected integer but got "3p"}
 481             {unknown option "-underline"}
 482             {expected integer but got "3p"}
 483             {expected integer but got "3p"}
 484             }
 485         }}
 486     }
 487 } {
 488     set name [lindex $configTest 0]
 489     foreach attempt [lindex $configTest 1] {
 490         set value [lindex $attempt 0]
 491         set options [lindex $attempt 1]
 492         foreach item {0 1 2 3 4 5} {
 493             catch {unset msg}
 494             test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] {
 495                 set result [catch {.m1 entryconfigure $item $name $value} msg]
 496                 if {$result == 1} {
 497                     set msg
 498                 } else {
 499                     lindex [.m1 entryconfigure $item $name] 4
 500                 }
 501             } [lindex $options $item]
 502             incr i
 503         }
 504     }
 505 }
 506
 507 image delete image1
 508 destroy .m1
 509 destroy .m2
 510
 511 test menu-3.1 {MenuWidgetCmd procedure} {
 512     catch {destroy .m1}
 513     menu .m1
 514     list [catch {.m1} msg] $msg [destroy .m1]
 515 } {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
 516 test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } {
 517     catch {destroy .m1}
 518     menu .m1 -postcommand "destroy .m1"
 519     .m1 add command -label "menu-3.2: Hit Escape"
 520     list [catch {.m1 post 40 40} msg] $msg
 521 } {0 {}}
 522 test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
 523     catch {destroy .m1}
 524     menu .m1
 525     .m1 add command -label "test"
 526     list [catch {.m1 activate} msg] $msg [destroy .m1]
 527 } {1 {wrong # args: should be ".m1 activate index"} {}}
 528 test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
 529     catch {destroy .m1}
 530     menu .m1
 531     list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
 532 } {1 {bad menu entry index "foo"} {}}
 533 test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
 534     catch {destroy .m1}
 535     menu .m1
 536     .m1 add command -label "test"
 537     .m1 add separator
 538     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
 539 } {0 {} {}}
 540 test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
 541     catch {destroy .m1}
 542     menu .m1
 543     .m1 add command -label "test"
 544     .m1 entryconfigure 1 -state disabled
 545     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
 546 } {0 {} {}}
 547 test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
 548     catch {destroy .m1}
 549     menu .m1
 550     .m1 add command -label "test"
 551     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
 552 } {0 {} {}}
 553 test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
 554     catch {destroy .m1}
 555     menu .m1
 556     list [catch {.m1 add} msg] $msg [destroy .m1]
 557 } {1 {wrong # args: should be ".m1 add type ?options?"} {}}
 558 test menu-3.9 {MenuWidgetCmd procedure, "add" option} {
 559     catch {destroy .m1}
 560     menu .m1
 561     list [catch {.m1 add foo} msg] $msg [destroy .m1]
 562 } {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}}
 563 test menu-3.10 {MenuWidgetCmd procedure, "add" option} {
 564     catch {destroy .m1}
 565     menu .m1
 566     list [catch {.m1 add separator} msg] $msg [destroy .m1]
 567 } {0 {} {}}
 568 test menu-3.11 {MenuWidgetCmd procedure, "cget" option} {
 569     catch {destroy .m1}
 570     menu .m1
 571     list [catch {.m1 cget} msg] $msg [destroy .m1]
 572 } {1 {wrong # args: should be ".m1 cget option"} {}}
 573 test menu-3.12 {MenuWidgetCmd procedure, "cget" option} {
 574     catch {destroy .m1}
 575     menu .m1
 576     list [catch {.m1 cget -gorp} msg] $msg [destroy .m1]
 577 } {1 {unknown option "-gorp"} {}}
 578 test menu-3.13 {MenuWidgetCmd procedure, "cget" option} {
 579     catch {destroy .m1}
 580     menu .m1
 581     .m1 configure -postcommand "Some string"
 582     list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1]
 583 } {0 {Some string} {}}
 584 test menu-3.14 {MenuWidgetCmd procedure, "clone" option} {
 585     catch {destroy .m1}
 586     menu .m1
 587     list [catch {.m1 clone} msg] $msg [destroy .m1]
 588 } {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
 589 test menu-3.15 {MenuWidgetCmd procedure, "clone" option} {
 590     catch {destroy .m1}
 591     menu .m1
 592     list [catch {.m1 clone a b c d} msg] $msg [destroy .m1]
 593 } {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
 594 test menu-3.16 {MenuWidgetCmd procedure, "clone" option} {
 595     catch {destroy .m1}
 596     menu .m1
 597     list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1]
 598 } {0 {} {}}
 599 test menu-3.17 {MenuWidgetCmd procedure, "clone" option} {
 600     catch {destroy .m1}
 601     menu .m1
 602     list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1]
 603 } {0 {} {}}
 604 test menu-3.18 {MenuWidgetCmd procedure, "configure" option} {
 605     catch {destroy .m1}
 606     menu .m1
 607     list [catch {llength [.m1 configure]} msg] $msg [destroy .m1]
 608 } {0 20 {}}
 609 test menu-3.19 {MenuWidgetCmd procedure, "configure" option} {
 610     catch {destroy .m1}
 611     menu .m1
 612     list [catch {.m1 configure -gorp} msg] $msg [destroy .m1]
 613 } {1 {unknown option "-gorp"} {}}
 614 test menu-3.20 {MenuWidgetCmd procedure, "configure" option} {
 615     catch {destroy .m1}
 616     menu .m1
 617     list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1]
 618 } {0 {} {}}
 619 test menu-3.21 {MenuWidgetCmd procedure, "configure" option} {
 620     catch {destroy .m1}
 621     menu .m1
 622     .m1 configure -postcommand "Another string"
 623     list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1]
 624 } {0 {Another string} {}}
 625 test menu-3.22 {MenuWidgetCmd procedure, "delete" option} {
 626     catch {destroy .m1}
 627     menu .m1
 628     list [catch {.m1 delete} msg] $msg [destroy .m1]
 629 } {1 {wrong # args: should be ".m1 delete first ?last?"} {}}
 630 test menu-3.23 {MenuWidgetCmd procedure, "delete" option} {
 631     catch {destroy .m1}
 632     menu .m1
 633     list [catch {.m1 delete foo} msg] $msg [destroy .m1]
 634 } {1 {bad menu entry index "foo"} {}}
 635 test menu-3.24 {MenuWidgetCmd procedure, "delete" option} {
 636     catch {destroy .m1}
 637     menu .m1
 638     list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1]
 639 } {1 {bad menu entry index "foo"} {}}
 640 test menu-3.25 {MenuWidgetCmd procedure, "delete" option} {
 641     catch {destroy .m1}
 642     menu .m1
 643     list [catch {.m1 delete 0} msg] $msg [destroy .m1]
 644 } {0 {} {}}
 645 test menu-3.26 {MenuWidgetCmd procedure, "delete" option} {
 646     catch {destroy .m1}
 647     menu .m1
 648     .m1 add command -label "foo"
 649     list [catch {.m1 delete 1 0} msg] $msg [destroy .m1]
 650 } {0 {} {}}
 651 test menu-3.27 {MenuWidgetCmd procedure, "delete" option} {
 652     catch {destroy .m1}
 653     menu .m1
 654     .m1 add command -label "1"
 655     .m1 add command -label "2"
 656     .m1 add command -label "3"
 657     list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
 658 } {0 {} {}}
 659 test menu-3.28 {MenuWidgetCmd procedure, "delete" option} {
 660     catch {destroy .m1}
 661     menu .m1
 662     .m1 add command -label "1"
 663     .m1 add command -label "2"
 664     .m1 add command -label "3"
 665     .m1 activate 2
 666     list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
 667 } {0 {} {}}
 668 test menu-3.29 {MenuWidgetCmd procedure, "delete" option} {
 669     catch {destroy .m1}
 670     menu .m1
 671     .m1 add command -label "1"
 672     .m1 add command -label "2"
 673     .m1 add command -label "3"
 674     .m1 activate 3
 675     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
 676 } {0 {} {}}
 677 test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} {
 678     catch {destroy .m1}
 679     menu .m1
 680     list [catch {.m1 entrycget} msg] $msg [destroy .m1]
 681 } {1 {wrong # args: should be ".m1 entrycget index option"} {}}
 682 test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} {
 683     catch {destroy .m1}
 684     menu .m1
 685     list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1]
 686 } {1 {wrong # args: should be ".m1 entrycget index option"} {}}
 687 test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} {
 688     catch {destroy .m1}
 689     menu .m1
 690     list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1]
 691 } {1 {bad menu entry index "foo"} {}}
 692 test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} {
 693     catch {destroy .m1}
 694     menu .m1
 695     .m1 add command -label "test"
 696     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
 697 } {0 test {}}
 698 test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} {
 699     catch {destroy .m1}
 700     menu .m1
 701     list [catch {.m1 entryconfigure} msg] $msg [destroy .m1]
 702 } {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}}
 703 test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} {
 704     catch {destroy .m1}
 705     menu .m1
 706     list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1]
 707 } {1 {bad menu entry index "foo"} {}}
 708 test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} {
 709     catch {destroy .m1}
 710     menu .m1
 711     .m1 add command -label "test"
 712     list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1]
 713 } {0 15 {}}
 714 test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} {
 715     catch {destroy .m1}
 716     menu .m1
 717     .m1 add command -label "test"
 718     list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
 719 } {0 test {}}
 720 test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} {
 721     catch {destroy .m1}
 722     menu .m1
 723     .m1 add command -label "test"
 724     .m1 entryconfigure 1 -label "changed"
 725     list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
 726 } {0 changed {}}
 727 test menu-3.39 {MenuWidgetCmd procedure, "index" option} {
 728     catch {destroy .m1}
 729     menu .m1
 730     list [catch {.m1 index} msg] $msg [destroy .m1]
 731 } {1 {wrong # args: should be ".m1 index string"} {}}
 732 test menu-3.40 {MenuWidgetCmd procedure, "index" option} {
 733     catch {destroy .m1}
 734     menu .m1
 735     list [catch {.m1 index foo} msg] $msg [destroy .m1]
 736 } {1 {bad menu entry index "foo"} {}}
 737 test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
 738     catch {destroy .m1}
 739     menu .m1
 740     .m1 add command -label "test"
 741     list [catch {.m1 index "test"} msg] $msg [destroy .m1]
 742 } {0 1 {}}
 743 test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
 744     catch {destroy .m1}
 745     menu .m1
 746     list [catch {.m1 insert} msg] $msg [destroy .m1]
 747 } {1 {wrong # args: should be ".m1 insert index type ?options?"} {}}
 748 test menu-3.43 {MenuWidgetCmd procedure, "insert" option} {
 749     catch {destroy .m1}
 750     menu .m1
 751     .m1 insert 1 command -label "test"
 752     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
 753 } {0 test {}}
 754 test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} {
 755     catch {destroy .m1}
 756     menu .m1
 757     list [catch {.m1 invoke} msg] $msg [destroy .m1]
 758 } {1 {wrong # args: should be ".m1 invoke index"} {}}
 759 test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} {
 760     catch {destroy .m1}
 761     menu .m1
 762     list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
 763 } {1 {bad menu entry index "foo"} {}}
 764 test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} {
 765     catch {destroy .m1}
 766     catch {unset foo}
 767     menu .m1
 768     .m1 add command -label "set foo" -command "set foo hello"
 769     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 770 } {0 hello 0 hello 0 {} {}}
 771 test menu-3.47 {MenuWidgetCmd procedure, "post" option} {
 772     catch {destroy .m1}
 773     menu .m1
 774     .m1 add command -label "On Windows, hit Escape to get this menu to go away"
 775     list [catch {.m1 post} msg] $msg [destroy .m1]
 776 } {1 {wrong # args: should be ".m1 post x y"} {}}
 777 test menu-3.48 {MenuWidgetCmd procedure, "post" option} {
 778     catch {destroy .m1}
 779     menu .m1
 780     list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
 781 } {1 {expected integer but got "foo"} {}}
 782 test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
 783     catch {destroy .m1}
 784     menu .m1
 785     list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
 786 } {1 {expected integer but got "bar"} {}}
 787 test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } {
 788     catch {destroy .m1}
 789     menu .m1
 790     .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
 791     list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
 792 } {0 {} {}}
 793 test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
 794     catch {destroy .m1}
 795     menu .m1
 796     list [catch {.m1 postcascade} msg] $msg [destroy .m1]
 797 } {1 {wrong # args: should be ".m1 postcascade index"} {}}
 798 test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
 799     catch {destroy .m1}
 800     menu .m1
 801     list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
 802 } {1 {bad menu entry index "foo"} {}}
 803 test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
 804     catch {destroy .m1}
 805     catch {destroy .m2}
 806     menu .m1
 807     .m1 add command -label "menu-3.56 - hit Escape"
 808     menu .m2
 809     .m1 post 40 40
 810     .m1 add cascade -menu .m2
 811     list [catch {.m1 postcascade 1} msg] $msg [destroy .m1 .m2]
 812 } {0 {} {}}
 813 test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} {
 814     catch {destroy .m1}
 815     catch {destroy .m2}
 816     menu .m1
 817     menu .m2
 818     .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape"
 819     .m1 postcascade 1
 820     list [catch {.m1 postcascade none} msg] $msg [destroy .m1 .m2]
 821 } {0 {} {}}
 822 test menu-3.55 {MenuWidgetCmd procedure, "type" option} {
 823     catch {destroy .m1}
 824     menu .m1
 825     list [catch {.m1 type} msg] $msg [destroy .m1]
 826 } {1 {wrong # args: should be ".m1 type index"} {}}
 827 test menu-3.56 {MenuWidgetCmd procedure, "type" option} {
 828     catch {destroy .m1}
 829     menu .m1
 830     list [catch {.m1 type foo} msg] $msg [destroy .m1]
 831 } {1 {bad menu entry index "foo"} {}}
 832 test menu-3.57 {MenuWidgetCmd procedure, "type" option} {
 833     catch {destroy .m1}
 834     menu .m1
 835     .m1 add command -label "test"
 836     list [catch {.m1 type 1} msg] $msg [destroy .m1]
 837 } {0 command {}}
 838 test menu-3.58 {MenuWidgetCmd procedure, "type" option} {
 839     catch {destroy .m1}
 840     menu .m1
 841     .m1 add separator
 842     list [catch {.m1 type 1} msg] $msg [destroy .m1]
 843 } {0 separator {}}
 844 test menu-3.59 {MenuWidgetCmd procedure, "type" option} {
 845     catch {destroy .m1}
 846     menu .m1
 847     .m1 add checkbutton -label "test"
 848     list [catch {.m1 type 1} msg] $msg [destroy .m1]
 849 } {0 checkbutton {}}
 850 test menu-3.60 {MenuWidgetCmd procedure, "type" option} {
 851     catch {destroy .m1}
 852     menu .m1
 853     .m1 add radiobutton -label "test"
 854     list [catch {.m1 type 1} msg] $msg [destroy .m1]
 855 } {0 radiobutton {}}
 856 test menu-3.61 {MenuWidgetCmd procedure, "type" option} {
 857     catch {destroy .m1}
 858     menu .m1
 859     .m1 add cascade -label "test"
 860     list [catch {.m1 type 1} msg] $msg [destroy .m1]
 861 } {0 cascade {}}
 862 test menu-3.62 {MenuWidgetCmd procedure, "type" option} {
 863     catch {destroy .m1}
 864     menu .m1
 865     list [catch {.m1 type 0} msg] $msg [destroy .m1]
 866 } {0 tearoff {}}
 867 test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
 868     catch {destroy .m1}
 869     menu .m1
 870     list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
 871 } {1 {wrong # args: should be ".m1 unpost"} {}}
 872 test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } {
 873     catch {destroy .m1}
 874     menu .m1
 875     .m1 add command -label "menu-3.68 - hit Escape"
 876     .m1 post 40 40
 877     list [catch {.m1 unpost} msg] $msg [destroy .m1]
 878 } {0 {} {}}
 879 test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {
 880     catch {destroy .m1}
 881     menu .m1
 882     list [catch {.m1 yposition} msg] $msg [destroy .m1]
 883 } {1 {wrong # args: should be ".m1 yposition index"} {}}
 884 test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} {
 885     catch {destroy .m1}
 886     menu .m1
 887     list [catch {.m1 yposition 1}] [destroy .m1]
 888 } {0 {}}
 889 test menu-3.67 {MenuWidgetCmd procedure, bad option} {
 890     catch {destroy .m1}
 891     menu .m1
 892     list [catch {.m1 foo} msg] $msg [destroy .m1]
 893 } {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
 894 test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} {
 895     set t .t
 896     set m1 .t.m1
 897     set c1 .t.c1
 898     set c2 .t.c2
 899     toplevel .t
 900     menu $m1 -tearoff 1
 901     menu $c1 -tearoff 1
 902     $c1 add command -label c1
 903     menu $c2 -tearoff 1
 904     $c2 add command -label c2
 905     $m1 add cascade -label c1 -menu $c1
 906     $t configure -menu $m1
 907     $m1 entryconfigure 1 -menu $c2 -label c2
 908     $t configure -menu ""
 909     set l [list [winfo exists $c1] [winfo exists $c2]]
 910     destroy $t;
 911     set l;
 912 } {1 1}
 913
 914 test menu-4.1 {TkInvokeMenu: disabled} {
 915     catch {destroy .m1}
 916     catch {unset foo}
 917     menu .m1
 918     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \
 919         -state disabled
 920     list [catch {.m1 invoke 1} msg] [destroy .m1] $foo
 921 } {0 {} off}
 922 test menu-4.2 {TkInvokeMenu: tearoff} {
 923     catch {destroy .m1}
 924     menu .m1
 925     list [catch {.m1 invoke 0} msg] [destroy .m1]
 926 } {0 {}}
 927 test menu-4.3 {TkInvokeMenu: checkbutton -on} {
 928     catch {destroy .m1}
 929     catch {unset foo}
 930     menu .m1
 931     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
 932     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 933 } {0 {} 0 on 0 {} {}}
 934 test menu-4.4 {TkInvokeMenu: checkbutton -off} {
 935     catch {destroy .m1}
 936     catch {unset foo}
 937     menu .m1
 938     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
 939     .m1 invoke 1
 940     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 941 } {0 {} 0 off 0 {} {}}
 942 test menu-4.5 {TkInvokeMenu: checkbutton array element} {
 943     catch {destroy .m1}
 944     catch {unset foo}
 945     menu .m1
 946     .m1 add checkbutton -label "test" -variable foo(1) -onvalue on
 947     list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 948 } {0 {} 0 on 0 {} {}}
 949 test menu-4.6 {TkInvokeMenu: radiobutton} {
 950     catch {destroy .m1}
 951     catch {unset foo}
 952     menu .m1
 953     .m1 add radiobutton -label "1" -variable foo -value one
 954     .m1 add radiobutton -label "2" -variable foo -value two
 955     .m1 add radiobutton -label "3" -variable foo -value three
 956     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 957 } {0 {} 0 one 0 {} {}}
 958 test menu-4.7 {TkInvokeMenu: radiobutton} {
 959     catch {destroy .m1}
 960     catch {unset foo}
 961     menu .m1
 962     .m1 add radiobutton -label "1" -variable foo -value one
 963     .m1 add radiobutton -label "2" -variable foo -value two
 964     .m1 add radiobutton -label "3" -variable foo -value three
 965     list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 966 } {0 {} 0 two 0 {} {}}
 967 test menu-4.8 {TkInvokeMenu: radiobutton} {
 968     catch {destroy .m1}
 969     catch {unset foo}
 970     menu .m1
 971     .m1 add radiobutton -label "1" -variable foo -value one
 972     .m1 add radiobutton -label "2" -variable foo -value two
 973     .m1 add radiobutton -label "3" -variable foo -value three
 974     list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 975 } {0 {} 0 three 0 {} {}}
 976 test menu-4.9 {TkInvokeMenu: radiobutton array element} {
 977     catch {destroy .m1}
 978     catch {unset foo}
 979     menu .m1
 980     .m1 add radiobutton -label "1" -variable foo(2) -value one
 981     .m1 add radiobutton -label "2" -variable foo(2) -value two
 982     .m1 add radiobutton -label "3" -variable foo(2) -value three
 983     list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 984 } {0 {} 0 three 0 {} {}}
 985 test menu-4.10 {TkInvokeMenu} {
 986     catch {destroy .m1}
 987     catch {unset menu_test}
 988     menu .m1
 989     .m1 add command -label "test" -command "set menu_test menu-4.8"
 990     list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
 991 } {0 menu-4.8 0 menu-4.8 0 {} {}}
 992 test menu-4.11 {TkInvokeMenu} {
 993     catch {destroy .m1}
 994     menu .m1
 995     .m1 add cascade -label "test" -menu .m1.m2
 996     list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
 997 } {0 {} {}}
 998 test menu-4.12 {TkInvokeMenu} {
 999     catch {destroy .m1}
1000     menu .m1
1001     .m1 add command -label "test" -command ".m1 delete 1"
1002     list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
1003 } {0 {} 1 {bad menu entry index "test"} {}}
1004
1005 test menu-5.1 {DestroyMenuInstance} {
1006     catch {destroy .m1}
1007     menu .m1
1008     list [catch {destroy .m1} msg] $msg
1009 } {0 {}}
1010 test menu-5.2 {DestroyMenuInstance - cascade menu} {
1011     catch {destroy .m1}
1012     catch {destroy .m2}
1013     menu .m1
1014     .m1 add cascade -menu .m2
1015     menu .m2
1016     list [catch {destroy .m2} msg] $msg [destroy .m1]
1017 } {0 {} {}}
1018 test menu-5.3 {DestroyMenuInstance - multiple cascade parents} {
1019     catch {destroy .m1}
1020     catch {destroy .m2}
1021     catch {destroy .m3}
1022     menu .m1
1023     .m1 add cascade -menu .m3
1024     menu .m2
1025     .m2 add cascade -menu .m3
1026     menu .m3
1027     list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
1028 } {0 {} {}}
1029 test menu-5.4 {DestroyMenuInstance - multiple cascade parents} {
1030     catch {destroy .m1}
1031     catch {destroy .m2}
1032     catch {destroy .m3}
1033     catch {destroy .m4}
1034     menu .m1
1035     .m1 add cascade -menu .m4
1036     menu .m2
1037     .m2 add cascade -menu .m4
1038     menu .m3
1039     .m3 add cascade -menu .m4
1040     menu .m4
1041     list [catch {destroy .m4} msg] $msg [destroy .m1 .m2 .m3]
1042 } {0 {} {}}
1043 test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} {
1044     catch {destroy .m1}
1045     catch {destroy .m2}
1046     menu .m1
1047     menu .m2
1048     .m1 add cascade -menu .m2
1049     . configure -menu .m1
1050     list [catch {destroy .m2} msg] $msg [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1]
1051 } {0 {} .m2 {} {}}
1052 test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} {
1053     catch {destroy .m1}
1054     catch {destroy .m2}
1055     catch {destroy .t2}
1056     menu .m1
1057     .m1 add cascade -menu .m2
1058     menu .m2
1059     . configure -menu .m1
1060     toplevel .t2
1061     wm geometry .t2 +0+0
1062     .t2 configure -menu .m1
1063     list [catch {destroy .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
1064 } {0 {} {} {}}
1065 test menu-5.7 {DestroyMenuInstance - basic clones} {
1066     catch {destroy .m1}
1067     menu .m1
1068     set tearoff [tk::TearOffMenu .m1]
1069     list [catch {destroy $tearoff} msg] $msg [destroy .m1]
1070 } {0 {} {}}
1071 test menu-5.8 {DestroyMenuInstance - multiple clones} {
1072     catch {destroy .m1}
1073     menu .m1
1074     set tearoff1 [tk::TearOffMenu .m1]
1075     set tearoff2 [tk::TearOffMenu .m1]
1076     list [catch {destroy $tearoff1} msg] $msg [destroy .m1]
1077 } {0 {} {}}
1078 test menu-5.9 {DestroyMenuInstace - master menu} {
1079     catch {destroy .m1}
1080     menu .m1
1081     tk::TearOffMenu .m1
1082     list [catch {destroy .m1} msg] $msg
1083 } {0 {}}
1084 test menu-5.10 {DestroyMenuInstance - freeing entries} {
1085     catch {destroy .m1}
1086     menu .m1
1087     .m1 add command -label "foo"
1088     list [catch {destroy .m1} msg] $msg
1089 } {0 {}}
1090 test menu-5.11 {DestroyMenuInstace - no entries} {
1091     catch {destroy .m1}
1092     menu .m1
1093     .m1 configure -tearoff 0
1094     list [catch {destroy .m1} msg] $msg
1095 } {0 {}}
1096 test menu-5.12 {DestroyMenuInstance - platform data} {
1097     catch {destroy .m1}
1098     menu .m1
1099     list [catch {destroy .m1} msg] $msg
1100 } {0 {}}
1101 test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} {
1102     catch {destroy .m1}
1103     catch {destroy .m2}
1104     menu .m1
1105     menu .m2
1106     .m1 add cascade -menu .m2
1107     set tearoff [tk::TearOffMenu .m1 40 40]
1108     list [destroy .m2] [destroy .m1]
1109 } {{} {}}
1110
1111 test menu-6.1 {TkDestroyMenu} {
1112     catch {destroy .m1}
1113     menu .m1
1114     list [catch {destroy .m1} msg] $msg
1115 } {0 {}}
1116 test menu-6.2 {TkDestroyMenu - reentrancy} {
1117     catch {destroy .m1}
1118     catch {destroy .m2}
1119     menu .m1
1120     bind .m1 <Destroy> {destroy .m1}
1121     menu .m2
1122     bind .m2 <Destroy> {destroy .m2}
1123     list [catch {destroy .m1} msg] $msg [destroy .m2]
1124 } {0 {} {}}
1125 test menu-6.3 {TkDestroyMenu - reentrancy} {
1126     catch {destroy .m1}
1127     catch {destroy .m2}
1128     catch {destroy .m3}
1129     menu .m1
1130     bind .m1 <Destroy> {destroy .m2}
1131     .m1 clone .m2
1132     .m1 clone .m3
1133     list [catch {destroy .m1} msg] $msg [winfo exists .m2]
1134 } {0 {} 0}
1135 test menu-6.4 {TkDestroyMenu - reentrancy - clones} {
1136     catch {destroy .m1}
1137     catch {destroy .m2}
1138     menu .m1
1139     .m1 clone .m2
1140     .m1 clone .m1.m3
1141     list [catch {destroy .m1} msg] $msg
1142 } {0 {}}
1143 test menu-6.5 {TkDestroyMenu} {
1144     catch {destroy .m1}
1145     catch {destroy .m2}
1146     menu .m1
1147     .m1 clone .m2
1148     destroy .m1
1149     winfo exists .m2
1150 } {0}
1151 test menu-6.6 {TkDestroyMenu} {
1152     catch {destroy .m1}
1153     catch {destroy .m2}
1154     menu .m1
1155     .m1 clone .m2 tearoff
1156     list [catch {destroy .m1} msg] $msg
1157 } {0 {}}
1158 test menu-6.7 {TkDestroyMenu} {
1159     catch {destroy .m1}
1160     catch {destroy .m2}
1161     menu .m1
1162     .m1 clone .m2
1163     destroy .m2
1164     list [catch {destroy .m1} msg] $msg
1165 } {0 {}}
1166 test menu-6.8 {TkDestroyMenu} {
1167     catch {destroy .m1}
1168     catch {destroy .m2}
1169     catch {destroy .m3}
1170     menu .m1
1171     .m1 clone .m2
1172     .m1 clone .m3
1173     destroy .m1
1174     list [winfo exists .m2] [winfo exists .m3]
1175 } {0 0}
1176 test menu-6.9 {TkDestroyMenu} {
1177     catch {destroy .m1}
1178     catch {destroy .m2}
1179     catch {destroy .m3}
1180     menu .m1
1181     .m1 clone .m2
1182     .m1 clone .m3
1183     list [catch {destroy .m2} msg] $msg [catch {destroy .m3} msg2] $msg2 [catch {destroy .m1} msg3] $msg3
1184 } {0 {} 0 {} 0 {}}
1185 test menu-6.10 {TkDestroyMenu} {
1186     catch {destroy .m1}
1187     catch {destroy .m2}
1188     catch {destroy .m3}
1189     menu .m1
1190     .m1 clone .m2
1191     .m1 clone .m3
1192     list [catch {destroy .m3} msg] $msg [catch {destroy .m1} msg2] $msg2
1193 } {0 {} 0 {}}
1194 test menu-6.11 {TkDestroyMenu} {
1195     catch {destroy .m1}
1196     catch {destroy .m2}
1197     catch {destroy .m3}
1198     catch {destroy .m4}
1199     menu .m1
1200     .m1 clone .m2
1201     .m1 clone .m3
1202     .m1 clone .m4
1203     list [catch {destroy .m2} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
1204 } {0 {} 0 {}}
1205 test menu-6.12 {TkDestroyMenu} {
1206     catch {destroy .m1}
1207     catch {destroy .m2}
1208     catch {destroy .m3}
1209     catch {destroy .m4}
1210     menu .m1
1211     .m1 clone .m2
1212     .m1 clone .m3
1213     .m1 clone .m4
1214     list [catch {destroy .m3} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
1215 } {0 {} 0 {}}
1216 test menu-6.13 {TkDestroyMenu} {
1217     catch {destroy .m1}
1218     catch {destroy .m2}
1219     catch {destroy .m3}
1220     catch {destroy .m4}
1221     menu .m1
1222     .m1 clone .m2
1223     .m1 clone .m3
1224     .m1 clone .m4
1225     list [catch {destroy .m4} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
1226 } {0 {} 0 {}}
1227 test menu-6.14 {TkDestroyMenu} {
1228     catch {destroy .m1}
1229     menu .m1
1230     . configure -menu .m1
1231     list [catch {destroy .m1} msg] $msg [. configure -menu ""]
1232 } {0 {} {}}
1233 test menu-6.15 {TkDestroyMenu} {
1234     catch {destroy .m1}
1235     catch {destroy .t2}
1236     menu .m1
1237     toplevel .t2
1238     wm geometry .t2 +0+0
1239     . configure -menu .m1
1240     .t2 configure -menu .m1
1241     list [catch {destroy .m1} msg] $msg [destroy .t2] [. configure -menu ""]
1242 } {0 {} {} {}}
1243 test menu-6.16 {TkDestroyMenu} {
1244     catch {destroy .m1}
1245     catch {destroy .t2}
1246     catch {destroy .t3}
1247     menu .m1
1248     toplevel .t2
1249     wm geometry .t2 +0+0
1250     toplevel .t3
1251     wm geometry .t3 +0+0
1252     . configure -menu .m1
1253     .t2 configure -menu .m1
1254     .t3 configure -menu .m1
1255     list [catch {destroy .m1} msg] $msg [destroy .t2] [destroy .t3] [. configure -menu ""]
1256 } {0 {} {} {} {}}
1257
1258 test menu-7.1 {UnhookCascadeEntry} {
1259     catch {destroy .m1}
1260     menu .m1
1261     .m1 add command -label "test"
1262     list [catch {destroy .m1} msg] $msg
1263 } {0 {}}
1264 test menu-7.2 {UnhookCascadeEntry} {
1265     catch {destroy .m1}
1266     menu .m1
1267     .m1 add cascade -menu .m2
1268     list [catch {destroy .m1} msg] $msg
1269 } {0 {}}
1270 test menu-7.3 {UnhookCascadeEntry} {
1271     catch {destroy .m1}
1272     catch {destroy .m2}
1273     menu .m1
1274     menu .m2
1275     .m2 add cascade -menu .cascade
1276     .m1 add cascade -menu .cascade
1277     list [catch {destroy .m1} msg] $msg [destroy .m2]
1278 } {0 {} {}}
1279 test menu-7.4 {UnhookCascadeEntry} {
1280     catch {destroy .m1}
1281     catch {destroy .m2}
1282     menu .m1
1283     menu .m2
1284     .m1 add cascade -menu .cascade
1285     .m2 add cascade -menu .cascade
1286     list [catch {destroy .m1} msg] $msg [destroy .m2]
1287 } {0 {} {}}
1288 test menu-7.5 {UnhookCascadeEntry} {
1289     catch {destroy .m1}
1290     catch {destroy .m2}
1291     catch {destroy .m3}
1292     menu .m1
1293     menu .m2
1294     menu .m3
1295     .m1 add cascade -menu .cascade
1296     .m2 add cascade -menu .cascade
1297     .m3 add cascade -menu .cascade
1298     list [catch {destroy .m1} msg] $msg [destroy .m2 .m3]
1299 } {0 {} {}}
1300 test menu-7.6 {UnhookCascadeEntry} {
1301     catch {destroy .m1}
1302     catch {destroy .m2}
1303     catch {destroy .m3}
1304     menu .m1
1305     menu .m2
1306     menu .m3
1307     .m1 add cascade -menu .cascade
1308     .m2 add cascade -menu .cascade
1309     .m3 add cascade -menu .cascade
1310     list [catch {destroy .m2} msg] $msg [destroy .m1 .m3]
1311 } {0 {} {}}
1312 test menu-7.7 {UnhookCascadeEntry} {
1313     catch {destroy .m1}
1314     catch {destroy .m2}
1315     catch {destroy .m3}
1316     menu .m1
1317     menu .m2
1318     menu .m3
1319     .m1 add cascade -menu .cascade
1320     .m2 add cascade -menu .cascade
1321     .m3 add cascade -menu .cascade
1322     list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
1323 } {0 {} {}}
1324 test menu-7.8 {UnhookCascadeEntry} {
1325     catch {destroy .m1}
1326     catch {destroy .m2}
1327     menu .m1
1328     menu .m2
1329     .m1 add cascade -menu .m2
1330     list [catch {destroy .m1} msg] $msg [destroy .m2]
1331 } {0 {} {}}
1332 test menu-7.9 {UnhookCascadeEntry} {
1333     catch {destroy .m1}
1334     catch {destroy .m2}
1335     menu .m1
1336     menu .m2
1337     .m1 add cascade -menu .m2
1338     destroy .m1
1339     list [catch {destroy .m2} msg] $msg
1340 } {0 {}}
1341
1342 test menu-8.1 {DestroyMenuEntry} {
1343     catch {destroy .m1}
1344     catch {destroy .m2}
1345     menu .m1
1346     menu .m2
1347     .m1 add cascade -menu .m2
1348     list [catch {.m1 delete 1} msg] $msg [destroy .m1 .m2]
1349 } {0 {} {}}
1350 test menu-8.2 {DestroyMenuEntry} {
1351     catch {image delete image1a}
1352     catch {destroy .m1}
1353     image create photo image1a -file [file join $tk_library demos images earth.gif]
1354     menu .m1
1355     .m1 add command -image image1a
1356     list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a]
1357 } {0 {} {} {}}
1358 test menu-8.3 {DestroyMenuEntry} testImageType {
1359     catch {eval image delete [image names]}
1360     catch {destroy .m1}
1361     image create test image1
1362     image create test image2
1363     menu .m1
1364     .m1 add checkbutton -image image1 -selectimage image2
1365     .m1 invoke 1
1366     list [catch {.m1 delete 1} msg] $msg [destroy .m1] [eval image delete [image names]]
1367 } {0 {} {} {}}
1368 test menu-8.4 {DestroyMenuEntry} {
1369     catch {destroy .m1}
1370     menu .m1
1371     .m1 add checkbutton -variable foo
1372     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
1373 } {0 {} {}}
1374 test menu-8.5 {DestroyMenuEntry} {
1375     catch {destroy .m1}
1376     menu .m1
1377     .m1 add command -label "test"
1378     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
1379 } {0 {} {}}
1380 test menu-8.6 {DestroyMenuEntry} {
1381     catch {destroy .m1}
1382     menu .m1
1383     .m1 add command -label "one"
1384     .m1 add command -label "two"
1385     list [catch {.m1 delete 1} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1386 } {0 {} two {}}
1387 test menu-8.7 {DestroyMenuEntry} {
1388     catch {destroy .m1}
1389     catch {destroy .m2}
1390     menu .m1
1391     .m1 add command -label "one"
1392     .m1 clone .m2 tearoff
1393     list [catch {.m2 delete 0} msg] $msg [destroy .m1]
1394 } {0 {} {}}
1395
1396 # test menu-9 - Can only change when fonts change on system, which cannot
1397 # be done from tcl.
1398
1399 test menu-9.1 {ConfigureMenu} {
1400     catch {destroy .m1}
1401     menu .m1
1402     list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
1403 } {0 {} beep {}}
1404 test menu-9.2 {ConfigureMenu} {
1405     catch {destroy .m1}
1406     menu .m1
1407     .m1 add command -label "test"
1408     list [catch {.m1 configure -tearoff 0} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1409 } {0 {} test {}}
1410 test menu-9.3 {ConfigureMenu} {
1411     catch {destroy .m1}
1412     menu .m1
1413     list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
1414 } {0 {} beep {}}
1415 test menu-9.4 {ConfigureMenu} {
1416     catch {destroy .m1}
1417     menu .m1
1418     .m1 add command -label "test"
1419     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
1420 } {0 {} {}}
1421 test menu-9.5 {ConfigureMenu} {
1422     catch {destroy .m1}
1423     menu .m1
1424     .m1 add command -label "test"
1425     .m1 add command -label "two"
1426     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
1427 } {0 {} {}}
1428 test menu-9.6 {ConfigureMenu} {
1429     catch {destroy .m1}
1430     menu .m1
1431     .m1 add command -label "test"
1432     .m1 add command -label "two"
1433     .m1 add command -label "three"
1434     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
1435 } {0 {} {}}
1436 test menu-9.7 {ConfigureMenu} {
1437     catch {destroy .m1}
1438     catch {destroy .m2}
1439     menu .m1
1440     .m1 clone .m2 tearoff
1441     list [catch {.m1 configure -fg red} msg] $msg [.m2 cget -fg] [destroy .m1]
1442 } {0 {} red {}}
1443 test menu-9.8 {ConfigureMenu} {
1444     catch {destroy .m1}
1445     catch {destroy .m2}
1446     menu .m1
1447     .m1 clone .m2 tearoff
1448     list [catch {.m2 configure -fg red} msg] $msg [.m1 cget -fg] [destroy .m1]
1449 } {0 {} red {}}
1450 test menu-9.9 {ConfigureMenu} {
1451     catch {destroy .m1}
1452     menu .m1
1453     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
1454 } {0 {} {} {}}
1455
1456 test menu-10.1 {PostProcessEntry: array variable} {
1457     catch {destroy .m1}
1458     catch {unset foo}
1459     menu .m1
1460     set foo(1) on
1461     .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
1462     list [catch {set foo(1)} msg] $msg [destroy .m1]
1463 } {0 on {}}
1464 test menu-10.2 {PostProcessEntry: array variable} {
1465     catch {destroy .m1}
1466     catch {unset foo}
1467     menu .m1
1468     .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
1469     list [catch {set foo(1)} msg] $msg [destroy .m1]
1470 } {0 off {}}
1471
1472 test menu-11.1 {ConfigureMenuEntry} {
1473     catch {destroy .m1}
1474     catch {unset foo}
1475     menu .m1
1476     .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
1477     list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
1478 } {0 {} bar {}}
1479 test menu-11.2 {ConfigureMenuEntry} {
1480     catch {destroy .m1}
1481     menu .m1
1482     .m1 add command -label "test"
1483     list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1484 } {0 {} {} {}}
1485 test menu-11.3 {ConfigureMenuEntry} {
1486     catch {destroy .m1}
1487     menu .m1
1488     .m1 add command
1489     list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
1490 } {0 {} test {}}
1491 test menu-11.4 {ConfigureMenuEntry} {
1492     catch {destroy .m1}
1493     menu .m1
1494     .m1 add command
1495     list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
1496 } {0 {} S {}}
1497 test menu-11.5 {ConfigureMenuEntry} {
1498     catch {destroy .m1}
1499     menu .m1
1500     .m1 add command
1501     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1502 } {0 {} test {}}
1503 test menu-11.6 {ConfigureMenuEntry} {
1504     catch {destroy .m1}
1505     menu .m1
1506     .m1 add command
1507     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
1508 } {0 {} {}}
1509 test menu-11.7 {ConfigureMenuEntry} {
1510     catch {destroy .m1}
1511     catch {destroy .m2}
1512     menu .m2
1513     menu .m1
1514     .m1 add cascade
1515     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
1516 } {0 {} {}}
1517 test menu-11.8 {ConfigureMenuEntry} {
1518     catch {destroy .m1}
1519     menu .m1
1520     .m1 add cascade
1521     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1522 } {0 {} {}}
1523 test menu-11.9 {ConfigureMenuEntry} {
1524     catch {destroy .m1}
1525     menu .m1
1526     .m1 add cascade -menu .m3
1527     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1528 } {0 {} {}}
1529 test menu-11.10 {ConfigureMenuEntry} {
1530     catch {destroy .m1}
1531     menu .m1
1532     .m1 add cascade
1533     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1534 } {0 {} {}}
1535 test menu-11.11 {ConfigureMenuEntry} {
1536     catch {destroy .m1}
1537     menu .m1
1538     .m1 add cascade -menu .m2
1539     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1540 } {0 {} {}}
1541 test menu-11.12 {ConfigureMenuEntry} {
1542     catch {destroy .m1}
1543     catch {destroy .m2}
1544     catch {destroy .m3}
1545     catch {destroy .m4}
1546     catch {destroy .m5}
1547     menu .m1
1548     menu .m2
1549     .m2 add cascade -menu .m1
1550     menu .m3
1551     .m3 add cascade -menu .m1
1552     menu .m4
1553     .m4 add cascade -menu .m1
1554     menu .m5
1555     .m5 add cascade
1556     list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
1557 } {0 {} {}}
1558 test menu-11.13 {ConfigureMenuEntry} {
1559     catch {destroy .m1}
1560     catch {destroy .m2}
1561     catch {destroy .m3}
1562     catch {destroy .m4}
1563     menu .m1
1564     menu .m2
1565     .m2 add cascade -menu .m1
1566     menu .m3
1567     .m3 add cascade -menu .m1
1568     menu .m4
1569     .m4 add cascade -menu .m1
1570     list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
1571 } {0 {} {}}
1572 test menu-11.14 {ConfigureMenuEntry} {
1573     catch {destroy .m1}
1574     menu .m1
1575     .m1 add checkbutton
1576     list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
1577 } {0 {} test {}}
1578 test menu-11.15 {ConfigureMenuEntry} {
1579     catch {destroy .m1}
1580     menu .m1
1581     list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
1582 } {0 {} test {}}
1583 test menu-11.16 {ConfigureMenuEntry} {
1584     catch {destroy .m1}
1585     menu .m1
1586     list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
1587 } {0 {} {}}
1588 test menu-11.17 {ConfigureMenuEntry} {
1589     catch {destroy .m1}
1590     menu .m1
1591     .m1 add checkbutton
1592     list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
1593 } {0 {} test {}}
1594 test menu-11.18 {ConfigureMenuEntry} testImageType {
1595     catch {destroy .m1}
1596     catch {image delete image1}
1597     menu .m1
1598     .m1 add command
1599     image create test image1
1600     list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
1601 } {0 {} {} {}}
1602 test menu-11.19 {ConfigureMenuEntry} testImageType {
1603     catch {destroy .m1}
1604     catch {image delete image1}
1605     catch {image delete image2}
1606     image create test image1
1607     image create photo image2 -file [file join $tk_library demos images earth.gif]
1608     menu .m1
1609     .m1 add command -image image1
1610     list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
1611 } {0 {} {} {} {}}
1612 test menu-11.20 {ConfigureMenuEntry} testImageType {
1613     catch {destroy .m1}
1614     catch {image delete image1}
1615     catch {image delete image2}
1616     image create photo image1 -file [file join $tk_library demos images earth.gif]
1617     image create test image2
1618     menu .m1
1619     .m1 add checkbutton -image image1
1620     list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
1621 } {0 {} {} {} {}}
1622 test menu-11.21 {ConfigureMenuEntry} testImageType {
1623     catch {destroy .m1}
1624     catch {image delete image1}
1625     catch {image delete image2}
1626     catch {image delete image3}
1627     image create photo image1 -file [file join $tk_library demos images earth.gif]
1628     image create test image2
1629     image create test image3
1630     menu .m1
1631     .m1 add checkbutton -image image1 -selectimage image2
1632     list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
1633 } {0 {} {} {} {} {}}
1634
1635 test menu-12.1 {ConfigureMenuCloneEntries} {
1636     catch {destroy .m1}
1637     catch {destroy .m2}
1638     catch {destroy .m3}
1639     menu .m1
1640     .m1 clone .m2
1641     .m2 configure -tearoff 0
1642     .m1 clone .m3
1643     .m1 add command -label "test"
1644     .m1 add command -label "test2"
1645     list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
1646 } {{1 {unknown option "-gork"}} {}}
1647 test menu-12.2 {ConfigureMenuCloneEntries} {
1648     catch {destroy .m1}
1649     catch {destroy .m2}
1650     catch {destroy .m3}
1651     catch {destroy .m4}
1652     menu .m1
1653     .m1 clone .m2
1654     menu .m3
1655     .m1 add cascade -menu .m3
1656     menu .m4
1657     list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
1658 } {0 {} {} {} {}}
1659 test menu-12.3 {ConfigureMenuCloneEntries} {
1660     catch {destroy .m1}
1661     catch {destroy .m2}
1662     menu .m1
1663     .m1 clone .m2
1664     .m1 add cascade -label dummy
1665     list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
1666 } {0 {} {}}
1667
1668 test menu-12.4 {ConfigureMenuCloneEntries} {
1669      catch {destroy .m1}
1670      catch {destroy .m2}
1671      menu .m1
1672      .m1 add cascade -label File -menu .m1.foo
1673      menu .m1.foo
1674      .m1.foo add command -label bar
1675      .m1 clone .m2
1676      list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1]
1677 } {0 {} {}}
1678
1679 test menu-13.1 {TkGetMenuIndex} {
1680     catch {destroy .m1}
1681     menu .m1
1682     .m1 add command -label "active"
1683     .m1 add command -label "test2"
1684     .m1 add command -label "test3"
1685     .m1 activate 2
1686     list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
1687 } {0 test2 {}}
1688 test menu-13.2 {TkGetMenuIndex} {
1689     catch {destroy .m1}
1690     menu .m1
1691     .m1 add command -label "last"
1692     .m1 add command -label "test2"
1693     .m1 add command -label "test3"
1694     .m1 activate 2
1695     list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
1696 } {0 test3 {}}
1697 test menu-13.3 {TkGetMenuIndex} {
1698     catch {destroy .m1}
1699     menu .m1
1700     .m1 add command -label "last"
1701     .m1 add command -label "test2"
1702     .m1 add command -label "test3"
1703     .m1 activate 2
1704     list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
1705 } {0 test3 {}}
1706 test menu-13.4 {TkGetMenuIndex} {
1707     catch {destroy .m1}
1708     menu .m1
1709     .m1 add command -label "test"
1710     list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
1711 } {0 {} test2 {}}
1712 test menu-13.5 {TkGetMenuIndex} {
1713     catch {destroy .m1}
1714     menu .m1
1715     .m1 add command -label "test"
1716     list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
1717 } {0 {} test2 {}}
1718 test menu-13.6 {TkGetMenuIndex} {
1719     catch {destroy .m1}
1720     menu .m1
1721     .m1 add command -label "active"
1722     .m1 add command -label "test2"
1723     .m1 add command -label "test3"
1724     .m1 activate 2
1725     list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
1726 } {0 {} {}}
1727 #test menu-13.7 - Need to add @test here.
1728 test menu-13.7 {TkGetMenuIndex} {
1729     catch {destroy .m1}
1730     menu .m1
1731     .m1 add command -label "active"
1732     .m1 add command -label "test2"
1733     .m1 add command -label "test3"
1734     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
1735 } {0 active {}}
1736 test menu-13.8 {TkGetMenuIndex} {
1737     catch {destroy .m1}
1738     menu .m1
1739     .m1 add command -label "active"
1740     list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
1741 } {1 {bad menu entry index "-1"} {}}
1742 test menu-13.9 {TkGetMenuIndex} {
1743     catch {destroy .m1}
1744     menu .m1
1745     .m1 add command -label "test"
1746     .m1 add command -label "test2"
1747     list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
1748 } {0 test2 {}}
1749 test menu-13.10 {TkGetMenuIndex} {
1750     catch {destroy .m1}
1751     menu .m1
1752     .m1 insert 999 command -label "test"
1753     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
1754 } {0 test {}}
1755 test menu-13.11 {TkGetMenuIndex} {
1756     catch {destroy .m1}
1757     menu .m1
1758     .m1 add command -label "1test"
1759     list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
1760 } {0 1test {}}
1761 test menu-13.12 {TkGetMenuIndex} {
1762     catch {destroy .m1}
1763     menu .m1
1764     .m1 add command -label "test"
1765     .m1 add command -label "test2" -command "beep"
1766     .m1 add command -label "test3"
1767     list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
1768 } {0 beep {}}
1769
1770 test menu-14.1 {MenuCmdDeletedProc} {
1771     catch {destroy .m1}
1772     menu .m1
1773     list [catch {destroy .m1} msg] $msg
1774 } {0 {}}
1775 test menu-14.2 {MenuCmdDeletedProc} {
1776     catch {destroy .m1}
1777     menu .m1
1778     .m1 clone .m2
1779     list [catch {destroy .m1} msg] $msg
1780 } {0 {}}
1781
1782 test menu-15.1 {MenuNewEntry} {
1783     catch {destroy .m1}
1784     menu .m1
1785     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
1786 } {0 {} {}}
1787 test menu-15.2 {MenuNewEntry} {
1788     catch {destroy .m1}
1789     menu .m1
1790     .m1 add command -label "test"
1791     .m1 add command -label "test3"
1792     list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
1793 } {0 {} {}}
1794 test menu-15.3 {MenuNewEntry} {
1795     catch {destroy .m1}
1796     menu .m1
1797     .m1 add command -label "test"
1798     list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
1799 } {0 {} {}}
1800 test menu-15.4 {MenuNewEntry} {
1801     catch {destroy .m1}
1802     menu .m1
1803     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
1804 } {0 {} {}}
1805
1806 test menu-16.1 {MenuAddOrInsert} {
1807     catch {destroy .m1}
1808     menu .m1
1809     list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
1810 } {1 {bad menu entry index "foo"} {}}
1811 test menu-16.2 {MenuAddOrInsert} {
1812     catch {destroy .m1}
1813     menu .m1
1814     .m1 add command -label "test"
1815     list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
1816 } {0 {} {}}
1817 test menu-16.3 {MenuAddOrInsert} {
1818     catch {destroy .m1}
1819     menu .m1
1820     list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
1821 } {1 {bad menu entry index "-1"} {}}
1822 test menu-16.4 {MenuAddOrInsert} {
1823     catch {destroy .m1}
1824     menu .m1
1825     .m1 add command -label "test"
1826     .m1 insert 0 command -label "test2"
1827     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
1828 } {0 test2 {}}
1829 test menu-16.5 {MenuAddOrInsert} {
1830     catch {destroy .m1}
1831     menu .m1
1832     list [catch {.m1 add cascade} msg] $msg [destroy .m1]
1833 } {0 {} {}}
1834 test menu-16.6 {MenuAddOrInsert} {
1835     catch {destroy .m1}
1836     menu .m1
1837     list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
1838 } {0 {} {}}
1839 test menu-16.7 {MenuAddOrInsert} {
1840     catch {destroy .m1}
1841     menu .m1
1842     list [catch {.m1 add command} msg] $msg [destroy .m1]
1843 } {0 {} {}}
1844 test menu-16.8 {MenuAddOrInsert} {
1845     catch {destroy .m1}
1846     menu .m1
1847     list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
1848 } {0 {} {}}
1849 test menu-16.9 {MenuAddOrInsert} {
1850     catch {destroy .m1}
1851     menu .m1
1852     list [catch {.m1 add separator} msg] $msg [destroy .m1]
1853 } {0 {} {}}
1854 test menu-16.10 {MenuAddOrInsert} {
1855     catch {destroy .m1}
1856     menu .m1
1857     list [catch {.m1 add blork} msg] $msg [destroy .m1]
1858 } {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
1859 test menu-16.11 {MenuAddOrInsert} {
1860     catch {destroy .m1}
1861     menu .m1
1862     list [catch {.m1 add command} msg] $msg [destroy .m1]
1863 } {0 {} {}}
1864 test menu-16.12 {MenuAddOrInsert} {
1865     catch {destroy .m1}
1866     catch {destroy .m2}
1867     catch {destroy .m3}
1868     menu .m1
1869     .m1 clone .m2
1870     .m2 clone .m3
1871     list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
1872 } {0 {} 0 test 0 test {}}
1873 test menu-16.13 {MenuAddOrInsert} {
1874     catch {destroy .m1}
1875     catch {destroy .m2}
1876     catch {destroy .m3}
1877     menu .m1
1878     .m1 clone .m2
1879     .m2 clone .m3
1880     list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
1881 } {0 {} 0 test 0 test {}}
1882 test menu-16.14 {MenuAddOrInsert} {
1883     catch {destroy .m1}
1884     menu .m1
1885     list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
1886 } {1 {unknown option "-blork"} {}}
1887 test menu-16.15 {MenuAddOrInsert} {
1888     catch {destroy .m1}
1889     catch {destroy .container}
1890     menu .m1
1891     .m1 add command -label "File"
1892     menu .container
1893     . configure -menu .container
1894     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
1895 } {0 {} {} {}}
1896 test menu-16.16 {MenuAddOrInsert} {
1897     catch {destroy .m1}
1898     catch {destroy .m2}
1899     menu .m1
1900     menu .m2
1901     set tearoff [tk::TearOffMenu .m2]
1902     list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
1903 } {0 {} {} 0 {} 0 {}}
1904 test menu-16.17 {MenuAddOrInsert} {
1905     catch {destroy .m1}
1906     catch {destroy .container}
1907     menu .m1
1908     menu .container
1909     . configure -menu .container
1910     set tearoff [tk::TearOffMenu .container]
1911     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
1912 } {0 {} {} {}}
1913 test menu-16.18 {MenuAddOrInsert} {
1914     catch {destroy .m1}
1915     catch {destroy .container}
1916     menu .m1
1917     menu .container
1918     .container add cascade -menu .m1
1919     . configure -menu .container
1920     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
1921 } {0 {} {} {}}
1922 test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
1923     catch {destroy .menubar}
1924     menu .menubar
1925     menu .menubar.test -tearoff 0
1926     .menubar add cascade -label Test -underline 0 -menu .menubar.test
1927     menu .menubar.test.cascade -tearoff 0
1928     .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
1929     . configure -menu .menubar
1930     list [catch {.menubar.test add cascade -label SubMenu \
1931         -menu .menubar.test.cascade} msg] \
1932         [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
1933         [. configure -menu ""] [destroy .menubar]
1934 } {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
1935
1936 test menu-17.1 {MenuVarProc} {
1937     catch {destroy .m1}
1938     catch {unset foo}
1939     menu .m1
1940     set foo "hello"
1941     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
1942 } {0 {} 0 {} {}}
1943 # menu-17.2 - Don't know how to generate the flags in the if
1944 test menu-17.2 {MenuVarProc} {
1945     catch {destroy .m1}
1946     catch {unset foo}
1947     menu .m1
1948     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
1949 } {0 {} {} {}}
1950 test menu-17.3 {MenuVarProc} {
1951     catch {destroy .m1}
1952     catch {unset foo}
1953     menu .m1
1954     set foo "hello"
1955     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
1956 } {0 {} hello {} 0 {}}
1957 test menu-17.4 {MenuVarProc} {
1958     catch {destroy .m1}
1959     menu .m1
1960     set foo "goodbye"
1961     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
1962 } {0 {} hello {} 0 {}}
1963 test menu-17.5 {MenuVarProc} {
1964     catch {destroy .m1}
1965     menu .m1
1966     set foo "hello"
1967     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
1968 } {0 {} goodbye {} 0 {}}
1969
1970 test menu-18.1 {TkActivateMenuEntry} {
1971     catch {destroy .m1}
1972     menu .m1
1973     .m1 add command -label "test"
1974     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
1975 } {0 {} {}}
1976 test menu-18.2 {TkActivateMenuEntry} {
1977     catch {destroy .m1}
1978     menu .m1
1979     .m1 add command -label "test"
1980     list [catch {.m1 activate 0} msg] $msg [destroy .m1]
1981 } {0 {} {}}
1982 test menu-18.3 {TkActivateMenuEntry} {
1983     catch {destroy .m1}
1984     menu .m1
1985     .m1 add command -label "test"
1986     .m1 add command -label "test2"
1987     .m1 activate 1
1988     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
1989 } {0 {} {}}
1990 test menu-18.4 {TkActivateMenuEntry} {
1991     catch {destroy .m1}
1992     menu .m1
1993     .m1 add command -label "test"
1994     .m1 add command -label "test2"
1995     .m1 activate 1
1996     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
1997 } {0 {} {}}
1998
1999 test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } {
2000     catch {destroy .m1}
2001     menu .m1 -postcommand "set menu_test menu-19.1"
2002     .m1 add command -label "menu-19.1 - hit Escape"
2003     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
2004 } {0 menu-19.1 {} menu-19.1 {}}
2005 test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } {
2006     catch {destroy .m1}
2007     menu .m1
2008     .m1 add command -label "menu-19.2 - hit Escape"
2009     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
2010 } {0 {} {} {}}
2011
2012 test menu-20.1 {CloneMenu} {
2013     catch {destroy .m1}
2014     catch {destroy .m2}
2015     menu .m1
2016     list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
2017 } {0 {} {}}
2018 test menu-20.2 {CloneMenu} {
2019     catch {destroy .m1}
2020     catch {destroy .m2}
2021     menu .m1
2022     list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
2023 } {0 {} {}}
2024 test menu-20.3 {CloneMenu} {
2025     catch {destroy .m1}
2026     catch {destroy .m2}
2027     menu .m1
2028     list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
2029 } {0 {} {}}
2030 test menu-20.4 {CloneMenu} {
2031     catch {destroy .m1}
2032     catch {destroy .m2}
2033     menu .m1
2034     list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
2035 } {0 {} {}}
2036 test menu-20.5 {CloneMenu} {
2037     catch {destroy .m1}
2038     catch {destroy .m2}
2039     menu .m1
2040     list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
2041 } {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}}
2042 test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
2043     catch {destroy .m1}
2044     catch {destroy .m2}
2045     menu .m1
2046     list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
2047  } {0 {} {}}
2048  test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
2049     catch {destroy .m1}
2050     catch {destroy .m2}
2051     catch {destroy .m3}
2052     menu .m1
2053     .m1 clone .m2
2054     list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
2055  } {0 {} {}}
2056  test menu-20.8 {CloneMenu - cascade entries} {
2057     catch {destroy .m1}
2058     catch {destroy .foo}
2059     menu .m1
2060     .m1 add cascade -menu .m2
2061     list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
2062  } {0 {} {}}
2063  test menu-20.9 {CloneMenu - cascades entries} {
2064     catch {destroy .m1}
2065     catch {destroy .m2}
2066     catch {destroy .foo}
2067     menu .m1
2068     .m1 add cascade -menu .m2
2069     menu .m2
2070     list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
2071  } {0 {} {}}
2072 test menu-20.10 {CloneMenu - tearoff fields} {
2073     catch {destroy .m1}
2074     catch {destroy .m2}
2075     menu .m1
2076     list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
2077 } {0 {} 0 1 {}}
2078 test menu-20.11 {CloneMenu} {
2079     catch {destroy .m1}
2080     catch {destroy .m2}
2081     menu .m1
2082     menu .m2
2083     list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
2084 } {1 {window name "m2" already exists in parent} {}}
2085
2086 test menu-21.1 {MenuDoYPosition} {
2087     catch {destroy .m1}
2088     menu .m1
2089     list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
2090 } {1 {bad menu entry index "glorp"} {}}
2091 test menu-21.2 {MenuDoYPosition} {
2092     catch {destroy .m1}
2093     menu .m1
2094     .m1 add command -label "Test"
2095     list [catch {.m1 yposition 1}] [destroy .m1]
2096 } {0 {}}
2097
2098 test menu-22.1 {GetIndexFromCoords} {
2099     catch {destroy .m1}
2100     menu .m1
2101     .m1 add command -label "test"
2102     .m1 configure -tearoff 0
2103     list [catch {.m1 index @5} msg] $msg [destroy .m1]
2104 } {0 0 {}}
2105 test menu-22.2 {GetIndexFromCoords} {
2106     catch {destroy .m1}
2107     menu .m1
2108     .m1 add command -label "test"
2109     .m1 configure -tearoff 0
2110     list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
2111 } {0 0 {}}
2112
2113 test menu-23.1 {RecursivelyDeleteMenu} {
2114     catch {destroy .m1}
2115     menu .m1
2116     . configure -menu .m1
2117     list [catch {. configure -menu ""} msg] $msg [destroy .m1]
2118 } {0 {} {}}
2119 test menu-23.2 {RecursivelyDeleteMenu} {
2120     catch {destroy .m1}
2121     catch {destroy .m2}
2122     menu .m2
2123     .m2 add command -label "test2"
2124     menu .m1
2125     .m1 add cascade -label "test1" -menu .m2
2126     . configure -menu .m1
2127     list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
2128 } {0 {} {}}
2129
2130 test menu-24.1 {TkNewMenuName} {
2131     catch {destroy .m1}
2132     menu .m1
2133     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2134 } {0 {} {} {}}
2135 test menu-24.2 {TkNewMenuName} {
2136     catch {destroy .m1}
2137     catch {destroy .m1\#0}
2138     menu .m1
2139     menu .m1\#0
2140     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2141 } {0 {} {} {}}
2142 test menu-24.3 {TkNewMenuName} {
2143     catch {destroy .#m}
2144     menu .#m
2145     rename .#m hideme
2146     list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
2147 } {0 {} {} {} {}}
2148
2149 test menu-25.1 {TkSetWindowMenuBar} {
2150     . configure -menu ""
2151     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2152 } {0 {} {}}
2153 test menu-25.2 {TkSetWindowMenuBar} {
2154     . configure -menu ""
2155     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2156 } {0 {} {}}
2157 test menu-25.3 {TkSetWindowMenuBar} {
2158     . configure -menu ""
2159     catch {destroy .m1}
2160     menu .m1
2161     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2162 } {0 {} {} {}}
2163 test menu-25.4 {TkSetWindowMenuBar} {
2164     catch {destroy .m1}
2165     catch {destroy .m2}
2166     . configure -menu ""
2167     menu .m1
2168     . configure -menu .m1
2169     menu .m2
2170     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
2171 } {0 {} {} {}}
2172 test menu-25.5 {TkSetWindowMenuBar} {
2173     catch {destroy .m1}
2174     catch {destroy .m2}
2175     catch {destroy .m3}
2176     . configure -menu ""
2177     menu .m1
2178     . configure -menu .m1
2179     .m1 clone .m2
2180     menu .m3
2181     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
2182 } {0 {} {} {}}
2183 test menu-25.6 {TkSetWindowMenuBar} {
2184     catch {destroy .m1}
2185     catch {destroy .m2}
2186     catch {destroy .m3}
2187     . configure -menu ""
2188     menu .m1
2189     .m1 clone .m2
2190     . configure -menu .m2
2191     menu .m3
2192     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
2193 } {0 {} {} {}}
2194 test menu-25.7 {TkSetWindowMenuBar} {
2195     catch {destroy .m1}
2196     catch {destroy .m2}
2197     . configure -menu ""
2198     menu .m1
2199     menu .m2
2200     . configure -menu .m1
2201     toplevel .t2
2202     .t2 configure -menu .m1
2203     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
2204 } {0 {} {} {}}
2205 test menu-25.8 {TkSetWindowMenuBar} {
2206     catch {destroy .m1}
2207     catch {destroy .m2}
2208     catch {destroy .t2}
2209     . configure -menu ""
2210     menu .m1
2211     menu .m2
2212     . configure -menu .m1
2213     toplevel .t2
2214     wm geometry .t2 +0+0
2215     .t2 configure -menu .m1
2216     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
2217 } {0 {} {} {}}
2218 test menu-25.9 {TkSetWindowMenuBar} {
2219     catch {destroy .m1}
2220     catch {destroy .m2}
2221     catch {destroy .t2}
2222     catch {destroy .t3}
2223     . configure -menu ""
2224     menu .m1
2225     menu .m2
2226     . configure -menu .m1
2227     toplevel .t2 -menu .m1
2228     wm geometry .t2 +0+0
2229     toplevel .t3 -menu .m1
2230     wm geometry .t3 +0+0
2231     list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
2232 } {0 {} {} {}}
2233 test menu-25.10 {TkSetWindowMenuBar} {
2234     catch {destroy .m1}
2235     catch {destroy .m2}
2236     catch {destroy .t2}
2237     catch {destroy .t3}
2238     . configure -menu ""
2239     menu .m1
2240     menu .m2
2241     . configure -menu .m1
2242     toplevel .t2 -menu .m1
2243     wm geometry .t2 +0+0
2244     toplevel .t3 -menu .m1
2245     wm geometry .t3 +0+0
2246     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
2247 } {0 {} {} {}}
2248 test menu-25.11 {TkSetWindowMenuBar} {
2249     catch {destroy .m1}
2250     catch {destroy .m2}
2251     catch {destroy .t2}
2252     catch {destroy .t3}
2253     . configure -menu ""
2254     menu .m1
2255     menu .m2
2256     . configure -menu .m1
2257     toplevel .t2 -menu .m1
2258     wm geometry .t2 +0+0
2259     toplevel .t3 -menu .m1
2260     wm geometry .t3 +0+0
2261     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
2262 } {0 {} {} {}}
2263 test menu-25.12 {TkSetWindowMenuBar} {
2264     catch {destroy .m1}
2265     . configure -menu ""
2266     menu .m1
2267     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2268 } {0 {} {} {}}
2269 test menu-25.13 {TkSetWindowMenuBar} {
2270     . configure -menu ""
2271     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2272 } {0 {} {}}
2273 test menu-25.14 {TkSetWindowMenuBar} {
2274     catch {destroy .m1}
2275     . configure -menu ""
2276     menu .m1
2277     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2278 } {0 {} {} {}}
2279 test menu-25.15 {TkSetWindowMenuBar} {
2280     . configure -menu ""
2281     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2282 } {0 {} {}}
2283 test menu-25.16 {TkSetWindowMenuBar} {
2284     catch {destroy .m1}
2285     . configure -menu ""
2286     menu .m1
2287     . configure -menu .m1
2288     list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
2289 } {0 .t2 {} {}}
2290
2291 test menu-26.1 {DestroyMenuHashTable} {
2292     catch {interp destroy testinterp}
2293     interp create testinterp
2294     load {} Tk testinterp
2295     interp eval testinterp {menu .m1}
2296     list [catch {interp delete testinterp} msg] $msg
2297 } {0 {}}
2298
2299 test menu-27.1 {GetMenuHashTable} {
2300     catch {interp destroy testinterp}
2301     interp create testinterp
2302     load {} Tk testinterp
2303     list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
2304 } {0 .m1 {}}
2305
2306 test menu-28.1 {TkCreateMenuReferences - not there before} {
2307     catch {destroy .m1}
2308     list [catch {menu .m1} msg] $msg [destroy .m1]
2309 } {0 .m1 {}}
2310 test menu-28.2 {TkCreateMenuReferences - there already} {
2311     catch {destroy .m1}
2312     catch {destroy .m2}
2313     menu .m1
2314     .m1 add cascade -menu .m2
2315     list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
2316 } {0 .m2 {}}
2317
2318 test menu-29.1 {TkFindMenuReferences - not there} {
2319     catch {destroy .m1}
2320     . configure -menu ""
2321     menu .m1
2322     .m1 add cascade -menu .m2
2323     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2324 } {0 {} {} {}}
2325 test menu-30.1 {TkFindMenuReferences - there already} {
2326     catch {destroy .m1}
2327     catch {destroy .m2}
2328     . configure -menu ""
2329     menu .m1
2330     menu .m2
2331     .m1 add cascade -menu .m2
2332     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
2333 } {0 {} {} {}}
2334
2335 test menu-31.1 {TkFreeMenuReferences - menuPtr} {
2336     catch {destroy .m1}
2337     menu .m1
2338     list [catch {destroy .m1} msg] $msg
2339 } {0 {}}
2340 test menu-31.2 {TkFreeMenuReferences - cascadePtr} {
2341     catch {destroy .m1}
2342     . configure -menu ""
2343     menu .m1
2344     .m1 add cascade -menu .m2
2345     list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
2346 } {0 {} {}}
2347 test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
2348     . configure -menu .m1
2349     list [catch {. configure -menu ""} msg] $msg
2350 } {0 {}}
2351 test menu-31.4 {TkFreeMenuReferences - not empty} {
2352     catch {destroy .m1}
2353     catch {destroy .m2}
2354     menu .m1
2355     .m1 add cascade -menu .m3
2356     menu .m2
2357     .m2 add cascade -menu .m3
2358     list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
2359 } {0 {} {}}
2360
2361 test menu-32.1 {DeleteMenuCloneEntries} {
2362     catch {destroy .m1}
2363     catch {destroy .m2}
2364     menu .m1
2365     .m1 add command -label foo
2366     .m1 clone .m2
2367     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
2368 } {0 {} {}}
2369 test menu-32.2 {DeleteMenuCloneEntries} {
2370     catch {destroy .m1}
2371     catch {destroy .m2}
2372     menu .m1
2373     .m1 add command -label one
2374     .m1 add command -label two
2375     .m1 add command -label three
2376     .m1 add command -label four
2377     .m1 clone .m2
2378     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
2379 } {0 {} {}}
2380 test menu-32.3 {DeleteMenuCloneEntries} {
2381     catch {destroy .m1}
2382     catch {destroy .m2}
2383     menu .m1 -tearoff 0
2384     .m1 add command -label one
2385     .m1 add command -label two
2386     .m1 add command -label three
2387     .m1 add command -label four
2388     .m1 clone .m2
2389     .m2 configure -tearoff 1
2390     list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
2391 } {0 {} {}}
2392 test menu-32.4 {DeleteMenuCloneEntries} {
2393     catch {destroy .m1}
2394     catch {destroy .m2}
2395     menu .m1
2396     .m1 add command -label one
2397     .m1 add command -label two
2398     .m1 add command -label three
2399     .m1 add command -label four
2400     .m1 clone .m2
2401     .m2 configure -tearoff 0
2402     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
2403 } {0 {} {}}
2404 test menu-32.5 {DeleteMenuCloneEntries} {
2405     catch {destroy .m1}
2406     catch {destroy .m2}
2407     menu .m1
2408     .m1 add command -label one
2409     .m1 add command -label two
2410     .m1 clone .m2
2411     .m1 activate one
2412     list [catch {.m1 delete one} msg] $msg [destroy .m1]
2413 } {0 {} {}}
2414 test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
2415     catch {destroy .m1}
2416     menu .m1
2417     .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
2418     list [catch {.m1 invoke test} msg] $msg [destroy .m1]
2419 } {0 {} {}}
2420 test menu-32.7 {DeleteMenuCloneEntries - one entry} {
2421     catch {destroy .m1}
2422     menu .m1 -tearoff 0
2423     .m1 add command -label Hello
2424     list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
2425 } {0 {} {}}
2426 test menu-32.8 {Ensure all menu clone commands are deleted} {knownBug} {
2427     # SF bug #465324
2428     catch {destroy .menubar}
2429     catch {destroy .menubar.test}
2430     menu .menubar
2431     . configure -menu .menubar
2432     menu .menubar.test
2433     .menubar.test add command -label "hi"
2434     for {set i 0} {$i < 10} {incr i} {
2435         .menubar add cascade -menu .menubar.test -label "Test"
2436         .menubar delete Test
2437     }
2438
2439     info commands .#menubar*test*
2440 } {}
2441 test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} {
2442     catch {destroy .menubar}
2443     catch {destroy .menubar.test}
2444
2445     menu .menubar
2446     . configure -menu .menubar
2447     menu .menubar.test
2448     .menubar add cascade -menu .menubar.test -label "Test"
2449     menu .menubar.cascade
2450
2451     .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
2452     set res {}
2453     lappend res [.menubar.test entrycget 1 -menu]
2454     lappend res [.#menubar.#menubar#test entrycget 1 -menu]
2455     destroy .menubar.test
2456     menu .menubar.test
2457     .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
2458     lappend res [.menubar.test entrycget 1 -menu]
2459     lappend res [.#menubar.#menubar#test entrycget 1 -menu]
2460     set res
2461 } {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade}
2462
2463 set l [interp hidden]
2464 deleteWindows
2465
2466 test menu-33.1 {menu vs command hiding} {
2467     catch {destroy .m}
2468     menu .m
2469     interp hide {} .m
2470     destroy .m
2471     list [winfo children .] [interp hidden]
2472 } [list {} $l]
2473
2474 # menu-34 MenuInit only called at boot time
2475
2476 # creating menus on two different screens then deleting the
2477 # menu from the first screen crashes Tk8.3.1
2478 #
2479 test menu-35.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} \
2480         {altDisplay} {
2481     toplevel .one
2482     menu .one.m
2483     toplevel .two -screen $::env(TK_ALT_DISPLAY)
2484     menu .two.m
2485     destroy .one
2486     destroy .two
2487 } {}
2488
2489 # cleanup
2490 deleteWindows
2491 ::tcltest::cleanupTests
2492 return