util/src/TclTk/tk8.6.12/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 package require tcltest 2.2
   9 namespace import ::tcltest::*
  10 eval tcltest::configure $argv
  11 tcltest::loadTestedCommands
  12 imageInit
  13
  14 # find the earth.gif file for use in these tests (tests 2.*)
  15 set earthPhotoFile [file join [file dirname [info script]] earth.gif]
  16 testConstraint hasEarthPhoto [file exists $earthPhotoFile]
  17
  18 test menu-1.1 {Tk_MenuCmd procedure} -body {
  19     menu
  20 } -returnCodes error -result {wrong # args: should be "menu pathName ?-option value ...?"}
  21 test menu-1.2 {Tk_MenuCmd procedure} -body {
  22     menu bogus
  23 } -returnCodes error -result {bad window path name "bogus"}
  24 test menu-1.3 {Tk_MenuCmd procedure} -body {
  25     destroy .m1
  26     menu .m1 foo
  27 } -returnCodes error -result {unknown option "foo"}
  28 test menu-1.4 {Tk_MenuCmd procedure} -body {
  29     destroy .m1
  30     menu .m1
  31 } -cleanup {
  32     deleteWindows
  33 } -result {.m1}
  34 test menu-1.5 {Tk_MenuCmd - creating menubar} -setup {
  35     destroy .m1
  36 } -body {
  37     menu .m1
  38     .m1 add cascade -label Test -menu ""
  39     list [. configure -menu .m1] [. configure -menu ""]
  40 } -cleanup {
  41     deleteWindows
  42 } -result {{} {}}
  43 test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} -setup {
  44     deleteWindows
  45 } -body {
  46     toplevel .t2 -menu .m1
  47     wm geometry .t2 +0+0
  48     menu .m1
  49 } -cleanup {
  50     deleteWindows
  51 } -result {.m1}
  52 test menu-1.7 {Tk_MenuCmd procedure one clone cascade} -setup {
  53     deleteWindows
  54 } -body {
  55     toplevel .t2 -menu .m1
  56     wm geometry .t2 +0+0
  57     menu .m1
  58     .m1 add cascade -menu .m2
  59     menu .m2
  60 } -cleanup {
  61     deleteWindows
  62 } -result {.m2}
  63 test menu-1.8 {Tk_MenuCmd procedure two clone cascades} -setup {
  64     deleteWindows
  65 } -body {
  66     menu .m1
  67     .m1 add cascade -menu .m2
  68     toplevel .t2 -menu .m1
  69     wm geometry .t2 +0+0
  70     toplevel .t3 -menu .m1
  71     wm geometry .t3 +0+0
  72     menu .m2
  73 } -cleanup {
  74     deleteWindows
  75 } -result {.m2}
  76 test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} -setup {
  77     deleteWindows
  78 } -body {
  79     toplevel .t2 -menu .m1
  80     wm geometry .t2 +0+0
  81     menu .m1
  82     .m1 add cascade -menu .m2
  83     toplevel .t3 -menu .m1
  84     wm geometry .t3 +0+0
  85     list [menu .m2]
  86 } -cleanup {
  87     deleteWindows
  88 } -result {.m2}
  89 test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} -setup {
  90     deleteWindows
  91 } -body {
  92     toplevel .t2 -menu .m1
  93     wm geometry .t2 +0+0
  94     toplevel .t3 -menu .m1
  95     wm geometry .t3 +0+0
  96     menu .m1
  97     .m1 add cascade -menu .m2
  98     list [menu .m2]
  99 } -cleanup {
 100     deleteWindows
 101 } -result {.m2}
 102 test menu-1.11 {Tk_MenuCmd procedure three clones cascades} -setup {
 103     deleteWindows
 104 } -body {
 105     toplevel .t2 -menu .m1
 106     wm geometry .t2 +0+0
 107     toplevel .t3 -menu .m1
 108     wm geometry .t3 +0+0
 109     toplevel .t4 -menu .m1
 110     wm geometry .t4 +0+0
 111     menu .m1
 112     .m1 add cascade -menu .m2
 113     list [menu .m2]
 114 } -cleanup {
 115     deleteWindows
 116 } -result {.m2}
 117 test menu-1.12 {Tk_MenuCmd procedure} -setup {
 118     deleteWindows
 119 } -body {
 120     toplevel .t2 -menu .m1
 121     wm geometry .t2 +0+0
 122     list [menu .m1]
 123 } -cleanup {
 124     deleteWindows
 125 } -result {.m1}
 126 test menu-1.13 {Tk_MenuCmd procedure} -setup {
 127     deleteWindows
 128 } -body {
 129     toplevel .t2 -menu .m1
 130     wm geometry .t2 +0+0
 131     toplevel .t3 -menu .m1
 132     wm geometry .t3 +0+0
 133     list [menu .m1]
 134 } -cleanup {
 135     deleteWindows
 136 } -result {.m1}
 137 test menu-1.14 {Tk_MenuCmd procedure} -setup {
 138     deleteWindows
 139 } -body {
 140     toplevel .t2 -menu .m1
 141     wm geometry .t2 +0+0
 142     toplevel .t3 -menu .m1
 143     wm geometry .t3 +0+0
 144     toplevel .t4 -menu .m1
 145     wm geometry .t4 +0+0
 146     list [menu .m1]
 147 } -cleanup {
 148     deleteWindows
 149 } -result {.m1}
 150
 151 # Used for 2.1 - 2.30 tests
 152 destroy .m1
 153 menu .m1
 154 test menu-2.1 {configuration options -activebackground #012345} -body {
 155     .m1 configure -activebackground #012345
 156     .m1 cget -activebackground
 157 } -result {#012345}
 158 test menu-2.2 {configuration options -activebackground non-existent} -body {
 159     .m1 configure -activebackground non-existent
 160 } -returnCodes error -result {unknown color name "non-existent"}
 161
 162 test menu-2.3 {configuration options -activeborderwidth 1.3} -body {
 163     .m1 configure -activeborderwidth 1.3
 164     .m1 cget -activeborderwidth
 165 } -result {1.3}
 166 test menu-2.4 {configuration options -activeborderwidth badValue} -body {
 167     .m1 configure -activeborderwidth badValue
 168 } -returnCodes error -result {bad screen distance "badValue"}
 169
 170 test menu-2.5 {configuration options -activeforeground #ff0000} -body {
 171     .m1 configure -activeforeground #ff0000
 172     .m1 cget -activeforeground
 173 } -result {#ff0000}
 174 test menu-2.6 {configuration options -activeforeground non-existent} -body {
 175     .m1 configure -activeforeground non-existent
 176 } -returnCodes error -result {unknown color name "non-existent"}
 177
 178 test menu-2.7 {configuration options -background #ff0000} -body {
 179     .m1 configure -background #ff0000
 180     .m1 cget -background
 181 } -result {#ff0000}
 182 test menu-2.8 {configuration options -background non-existent} -body {
 183     .m1 configure -background non-existent
 184 } -returnCodes error -result {unknown color name "non-existent"}
 185
 186 test menu-2.9 {configuration options -bg #110022} -body {
 187     .m1 configure -bg #110022
 188     .m1 cget -bg
 189 } -result {#110022}
 190 test menu-2.10 {configuration options -bg bogus} -body {
 191     .m1 configure -bg bogus
 192 } -returnCodes error -result {unknown color name "bogus"}
 193
 194 test menu-2.11 {configuration options -borderwidth 1.3} -body {
 195     .m1 configure -borderwidth 1.3
 196     .m1 cget -borderwidth
 197 } -result {1.3}
 198 test menu-2.12 {configuration options -borderwidth badValue} -body {
 199     .m1 configure -borderwidth badValue
 200 } -returnCodes error -result {bad screen distance "badValue"}
 201
 202 test menu-2.13 {configuration options -cursor arrow} -body {
 203     .m1 configure -cursor arrow
 204     .m1 cget -cursor
 205 } -result {arrow}
 206 test menu-2.14 {configuration options -cursor badValue} -body {
 207     .m1 configure -cursor badValue
 208 } -returnCodes error -result {bad cursor spec "badValue"}
 209
 210 test menu-2.15 {configuration options -disabledforeground #00ff00} -body {
 211     .m1 configure -disabledforeground #00ff00
 212     .m1 cget -disabledforeground
 213 } -result {#00ff00}
 214 test menu-2.16 {configuration options -disabledforeground xyzzy} -body {
 215     .m1 configure -disabledforeground xyzzy
 216 } -returnCodes error -result {unknown color name "xyzzy"}
 217
 218 test menu-2.17 {configuration options -fg #110022} -body {
 219     .m1 configure -fg #110022
 220     .m1 cget -fg
 221 } -result {#110022}
 222 test menu-2.18 {configuration options -fg bogus} -body {
 223     .m1 configure -fg bogus
 224 } -returnCodes error -result {unknown color name "bogus"}
 225
 226 test menu-2.19 {configuration options -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} -body {
 227     .m1 configure -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 228     .m1 cget -font
 229 } -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
 230 test menu-2.20 {configuration options -foreground #110022} -body {
 231     .m1 configure -foreground #110022
 232     .m1 cget -foreground
 233 } -result {#110022}
 234 test menu-2.21 {configuration options -foreground bogus} -body {
 235     .m1 configure -foreground bogus
 236 } -returnCodes error -result {unknown color name "bogus"}
 237
 238 test menu-2.22 {configuration options -postcommand {any old string}} -body {
 239     .m1 configure -postcommand {any old string}
 240     .m1 cget -postcommand
 241 } -result {any old string}
 242 test menu-2.23 {configuration options -relief groove} -body {
 243     .m1 configure -relief groove
 244     .m1 cget -relief
 245 } -result {groove}
 246 test menu-2.24 {configuration options -relief 1.5} -body {
 247     .m1 configure -relief 1.5
 248 } -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
 249
 250 test menu-2.25 {configuration options -selectcolor #110022} -body {
 251     .m1 configure -selectcolor #110022
 252     .m1 cget -selectcolor
 253 } -result {#110022}
 254 test menu-2.26 {configuration options -selectcolor bogus} -body {
 255     .m1 configure -selectcolor bogus
 256 } -returnCodes error -result {unknown color name "bogus"}
 257
 258 test menu-2.27 {configuration options -takefocus {any string}} -body {
 259     .m1 configure -takefocus {any string}
 260     .m1 cget -takefocus
 261 } -result {any string}
 262 test menu-2.28 {configuration options -tearoff 0} -body {
 263     .m1 configure -tearoff 0
 264     .m1 cget -tearoff
 265 } -result 0
 266 test menu-2.29 {configuration options -tearoff 1} -body {
 267     .m1 configure -tearoff 1
 268     .m1 cget -tearoff
 269 } -result 1
 270 test menu-2.30 {configuration options -tearoffcommand {any old string}} -body {
 271     .m1 configure -tearoffcommand {any old string}
 272     .m1 cget -tearoffcommand
 273 } -result {any old string}
 274 destroy .m1
 275
 276 # We need to test all of the options with all of the different types of
 277 # menu entries. The following code sets up .m1 with 6 items. It then
 278 # runs through the 2.31 - 2.228 tests below
 279 # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton,
 280 # 5 radiobutton
 281 deleteWindows
 282 menu .m1 -tearoff 1
 283 .m1 add command -label "command"
 284 menu .m2 -tearoff 1
 285 .m2 add command -label "test"
 286 .m1 add cascade -label "cascade" -menu .m2
 287 .m1 add separator
 288 .m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
 289 .m1 add radiobutton -label "radiobutton" -variable radio
 290
 291 if {[testConstraint hasEarthPhoto]} {
 292     image create photo image1 -file $earthPhotoFile
 293 }
 294
 295 test menu-2.31 {entry configuration options 0 -activebackground #012345 tearoff} -body {
 296     .m1 entryconfigure 0 -activebackground #012345
 297 } -returnCodes error -result {unknown option "-activebackground"}
 298
 299 test menu-2.32 {entry configuration options 1 -activebackground #012345 command} -body {
 300     .m1 entryconfigure 1 -activebackground #012345
 301     lindex [.m1 entryconfigure 1 -activebackground] 4
 302 } -result {#012345}
 303
 304 test menu-2.33 {entry configuration options 2 -activebackground #012345 cascade} -body {
 305     .m1 entryconfigure 2 -activebackground #012345
 306     lindex [.m1 entryconfigure 2 -activebackground] 4
 307 } -result {#012345}
 308
 309 test menu-2.34 {entry configuration options 3 -activebackground #012345 separator} -body {
 310     .m1 entryconfigure 3 -activebackground #012345
 311 } -returnCodes error -result {unknown option "-activebackground"}
 312
 313 test menu-2.35 {entry configuration options 4 -activebackground #012345 checkbutton} -body {
 314     .m1 entryconfigure 4 -activebackground #012345
 315     lindex [.m1 entryconfigure 4 -activebackground] 4
 316 } -result {#012345}
 317
 318 test menu-2.36 {entry configuration options 5 -activebackground #012345 radiobutton} -body {
 319     .m1 entryconfigure 5 -activebackground #012345
 320     lindex [.m1 entryconfigure 5 -activebackground] 4
 321 } -result {#012345}
 322
 323 test menu-2.37 {entry configuration options 0 -activebackground non-existent tearoff} -body {
 324     .m1 entryconfigure 0 -activebackground non-existent
 325 } -returnCodes error -result {unknown option "-activebackground"}
 326
 327 test menu-2.38 {entry configuration options 1 -activebackground non-existent command} -body {
 328     .m1 entryconfigure 1 -activebackground non-existent
 329 } -returnCodes error -result {unknown color name "non-existent"}
 330
 331 test menu-2.39 {entry configuration options 2 -activebackground non-existent cascade} -body {
 332     .m1 entryconfigure 2 -activebackground non-existent
 333 } -returnCodes error -result {unknown color name "non-existent"}
 334
 335 test menu-2.40 {entry configuration options 3 -activebackground non-existent separator} -body {
 336     .m1 entryconfigure 3 -activebackground non-existent
 337 } -returnCodes error -result {unknown option "-activebackground"}
 338
 339 test menu-2.41 {entry configuration options 4 -activebackground non-existent checkbutton} -body {
 340     .m1 entryconfigure 4 -activebackground non-existent
 341 } -returnCodes error -result {unknown color name "non-existent"}
 342
 343 test menu-2.42 {entry configuration options 5 -activebackground non-existent radiobutton} -body {
 344     .m1 entryconfigure 5 -activebackground non-existent
 345 } -returnCodes error -result {unknown color name "non-existent"}
 346
 347 test menu-2.43 {entry configuration options 0 -activeforeground #ff0000 tearoff} -body {
 348     .m1 entryconfigure 0 -activeforeground #ff0000
 349 } -returnCodes error -result {unknown option "-activeforeground"}
 350
 351 test menu-2.44 {entry configuration options 1 -activeforeground #ff0000 command} -body {
 352     .m1 entryconfigure 1 -activeforeground #ff0000
 353     lindex [.m1 entryconfigure 1 -activeforeground] 4
 354 } -result {#ff0000}
 355
 356 test menu-2.45 {entry configuration options 2 -activeforeground #ff0000 cascade} -body {
 357     .m1 entryconfigure 2 -activeforeground #ff0000
 358     lindex [.m1 entryconfigure 2 -activeforeground] 4
 359 } -result {#ff0000}
 360
 361 test menu-2.46 {entry configuration options 3 -activeforeground #ff0000 separator} -body {
 362     .m1 entryconfigure 3 -activeforeground #ff0000
 363 } -returnCodes error -result {unknown option "-activeforeground"}
 364
 365 test menu-2.47 {entry configuration options 4 -activeforeground #ff0000 checkbutton} -body {
 366     .m1 entryconfigure 4 -activeforeground #ff0000
 367     lindex [.m1 entryconfigure 4 -activeforeground] 4
 368 } -result {#ff0000}
 369
 370 test menu-2.48 {entry configuration options 5 -activeforeground #ff0000 radiobutton} -body {
 371     .m1 entryconfigure 5 -activeforeground #ff0000
 372     lindex [.m1 entryconfigure 5 -activeforeground] 4
 373 } -result {#ff0000}
 374
 375 test menu-2.49 {entry configuration options 0 -activeforeground non-existent tearoff} -body {
 376     .m1 entryconfigure 0 -activeforeground non-existent
 377 } -returnCodes error -result {unknown option "-activeforeground"}
 378
 379 test menu-2.50 {entry configuration options 1 -activeforeground non-existent command} -body {
 380     .m1 entryconfigure 1 -activeforeground non-existent
 381 } -returnCodes error -result {unknown color name "non-existent"}
 382
 383 test menu-2.51 {entry configuration options 2 -activeforeground non-existent cascade} -body {
 384     .m1 entryconfigure 2 -activeforeground non-existent
 385 } -returnCodes error -result {unknown color name "non-existent"}
 386
 387 test menu-2.52 {entry configuration options 3 -activeforeground non-existent separator} -body {
 388     .m1 entryconfigure 3 -activeforeground non-existent
 389 } -returnCodes error -result {unknown option "-activeforeground"}
 390
 391 test menu-2.53 {entry configuration options 4 -activeforeground non-existent checkbutton} -body {
 392     .m1 entryconfigure 4 -activeforeground non-existent
 393 } -returnCodes error -result {unknown color name "non-existent"}
 394
 395 test menu-2.54 {entry configuration options 5 -activeforeground non-existent radiobutton} -body {
 396     .m1 entryconfigure 5 -activeforeground non-existent
 397 } -returnCodes error -result {unknown color name "non-existent"}
 398
 399 test menu-2.55 {entry configuration options 0 -accelerator Ctrl+S tearoff} -body {
 400     .m1 entryconfigure 0 -accelerator Ctrl+S
 401 } -returnCodes error -result {unknown option "-accelerator"}
 402
 403 test menu-2.56 {entry configuration options 1 -accelerator Ctrl+S command} -body {
 404     .m1 entryconfigure 1 -accelerator Ctrl+S
 405     lindex [.m1 entryconfigure 1 -accelerator] 4
 406 } -result {Ctrl+S}
 407
 408 test menu-2.57 {entry configuration options 2 -accelerator Ctrl+S cascade} -body {
 409     .m1 entryconfigure 2 -accelerator Ctrl+S
 410     lindex [.m1 entryconfigure 2 -accelerator] 4
 411 } -result {Ctrl+S}
 412
 413 test menu-2.58 {entry configuration options 3 -accelerator Ctrl+S separator} -body {
 414     .m1 entryconfigure 3 -accelerator Ctrl+S
 415 } -returnCodes error -result {unknown option "-accelerator"}
 416
 417 test menu-2.59 {entry configuration options 4 -accelerator Ctrl+S checkbutton} -body {
 418     .m1 entryconfigure 4 -accelerator Ctrl+S
 419     lindex [.m1 entryconfigure 4 -accelerator] 4
 420 } -result {Ctrl+S}
 421
 422 test menu-2.60 {entry configuration options 5 -accelerator Ctrl+S radiobutton} -body {
 423     .m1 entryconfigure 5 -accelerator Ctrl+S
 424     lindex [.m1 entryconfigure 5 -accelerator] 4
 425 } -result {Ctrl+S}
 426
 427 test menu-2.61 {entry configuration options 0 -background #ff0000 tearoff} -body {
 428     .m1 entryconfigure 0 -background #ff0000
 429     lindex [.m1 entryconfigure 0 -background] 4
 430 } -result {#ff0000}
 431
 432 test menu-2.62 {entry configuration options 1 -background #ff0000 command} -body {
 433     .m1 entryconfigure 1 -background #ff0000
 434     lindex [.m1 entryconfigure 1 -background] 4
 435 } -result {#ff0000}
 436
 437 test menu-2.63 {entry configuration options 2 -background #ff0000 cascade} -body {
 438     .m1 entryconfigure 2 -background #ff0000
 439     lindex [.m1 entryconfigure 2 -background] 4
 440 } -result {#ff0000}
 441
 442 test menu-2.64 {entry configuration options 3 -background #ff0000 separator} -body {
 443     .m1 entryconfigure 3 -background #ff0000
 444     lindex [.m1 entryconfigure 3 -background] 4
 445 } -result {#ff0000}
 446
 447 test menu-2.65 {entry configuration options 4 -background #ff0000 checkbutton} -body {
 448     .m1 entryconfigure 4 -background #ff0000
 449     lindex [.m1 entryconfigure 4 -background] 4
 450 } -result {#ff0000}
 451
 452 test menu-2.66 {entry configuration options 5 -background #ff0000 radiobutton} -body {
 453     .m1 entryconfigure 5 -background #ff0000
 454     lindex [.m1 entryconfigure 5 -background] 4
 455 } -result {#ff0000}
 456
 457 test menu-2.67 {entry configuration options 0 -background non-existent tearoff} -body {
 458     .m1 entryconfigure 0 -background non-existent
 459 } -returnCodes error -result {unknown color name "non-existent"}
 460
 461 test menu-2.68 {entry configuration options 1 -background non-existent command} -body {
 462     .m1 entryconfigure 1 -background non-existent
 463 } -returnCodes error -result {unknown color name "non-existent"}
 464
 465 test menu-2.69 {entry configuration options 2 -background non-existent cascade} -body {
 466     .m1 entryconfigure 2 -background non-existent
 467 } -returnCodes error -result {unknown color name "non-existent"}
 468
 469 test menu-2.70 {entry configuration options 3 -background non-existent separator} -body {
 470     .m1 entryconfigure 3 -background non-existent
 471 } -returnCodes error -result {unknown color name "non-existent"}
 472
 473 test menu-2.71 {entry configuration options 4 -background non-existent checkbutton} -body {
 474     .m1 entryconfigure 4 -background non-existent
 475 } -returnCodes error -result {unknown color name "non-existent"}
 476
 477 test menu-2.72 {entry configuration options 5 -background non-existent radiobutton} -body {
 478     .m1 entryconfigure 5 -background non-existent
 479 } -returnCodes error -result {unknown color name "non-existent"}
 480
 481 test menu-2.73 {entry configuration options 0 -bitmap questhead tearoff} -body {
 482     .m1 entryconfigure 0 -bitmap questhead
 483 } -returnCodes error -result {unknown option "-bitmap"}
 484
 485 test menu-2.74 {entry configuration options 1 -bitmap questhead command} -body {
 486     .m1 entryconfigure 1 -bitmap questhead
 487     lindex [.m1 entryconfigure 1 -bitmap] 4
 488 } -result {questhead}
 489
 490 test menu-2.75 {entry configuration options 2 -bitmap questhead cascade} -body {
 491     .m1 entryconfigure 2 -bitmap questhead
 492     lindex [.m1 entryconfigure 2 -bitmap] 4
 493 } -result {questhead}
 494
 495 test menu-2.76 {entry configuration options 3 -bitmap questhead separator} -body {
 496     .m1 entryconfigure 3 -bitmap questhead
 497 } -returnCodes error -result {unknown option "-bitmap"}
 498
 499 test menu-2.77 {entry configuration options 4 -bitmap questhead checkbutton} -body {
 500     .m1 entryconfigure 4 -bitmap questhead
 501     lindex [.m1 entryconfigure 4 -bitmap] 4
 502 } -result {questhead}
 503
 504 test menu-2.78 {entry configuration options 5 -bitmap questhead radiobutton} -body {
 505     .m1 entryconfigure 5 -bitmap questhead
 506     lindex [.m1 entryconfigure 5 -bitmap] 4
 507 } -result {questhead}
 508
 509 test menu-2.79 {entry configuration options 0 -bitmap badValue tearoff} -body {
 510     .m1 entryconfigure 0 -bitmap badValue
 511 } -returnCodes error -result {unknown option "-bitmap"}
 512
 513 test menu-2.80 {entry configuration options 1 -bitmap badValue command} -body {
 514     .m1 entryconfigure 1 -bitmap badValue
 515 } -returnCodes error -result {bitmap "badValue" not defined}
 516
 517 test menu-2.81 {entry configuration options 2 -bitmap badValue cascade} -body {
 518     .m1 entryconfigure 2 -bitmap badValue
 519 } -returnCodes error -result {bitmap "badValue" not defined}
 520
 521 test menu-2.82 {entry configuration options 3 -bitmap badValue separator} -body {
 522     .m1 entryconfigure 3 -bitmap badValue
 523 } -returnCodes error -result {unknown option "-bitmap"}
 524
 525 test menu-2.83 {entry configuration options 4 -bitmap badValue checkbutton} -body {
 526     .m1 entryconfigure 4 -bitmap badValue
 527 } -returnCodes error -result {bitmap "badValue" not defined}
 528
 529 test menu-2.84 {entry configuration options 5 -bitmap badValue radiobutton} -body {
 530     .m1 entryconfigure 5 -bitmap badValue
 531 } -returnCodes error -result {bitmap "badValue" not defined}
 532
 533 test menu-2.85 {entry configuration options 0 -columnbreak 1 tearoff} -body {
 534     .m1 entryconfigure 0 -columnbreak 1
 535 } -returnCodes error -result {unknown option "-columnbreak"}
 536
 537 test menu-2.86 {entry configuration options 1 -columnbreak 1 command} -body {
 538     .m1 entryconfigure 1 -columnbreak 1
 539     lindex [.m1 entryconfigure 1 -columnbreak] 4
 540 } -result 1
 541
 542 test menu-2.87 {entry configuration options 2 -columnbreak 1 cascade} -body {
 543     .m1 entryconfigure 2 -columnbreak 1
 544     lindex [.m1 entryconfigure 2 -columnbreak] 4
 545 } -result 1
 546
 547 test menu-2.88 {entry configuration options 3 -columnbreak 1 separator} -body {
 548     .m1 entryconfigure 3 -columnbreak 1
 549 } -returnCodes error -result {unknown option "-columnbreak"}
 550
 551 test menu-2.89 {entry configuration options 4 -columnbreak 1 checkbutton} -body {
 552     .m1 entryconfigure 4 -columnbreak 1
 553     lindex [.m1 entryconfigure 4 -columnbreak] 4
 554 } -result 1
 555
 556 test menu-2.90 {entry configuration options 5 -columnbreak 1 radiobutton} -body {
 557     .m1 entryconfigure 5 -columnbreak 1
 558     lindex [.m1 entryconfigure 5 -columnbreak] 4
 559 } -result 1
 560
 561 test menu-2.91 {entry configuration options 0 -command beep tearoff} -body {
 562     .m1 entryconfigure 0 -command beep
 563 } -returnCodes error -result {unknown option "-command"}
 564
 565 test menu-2.92 {entry configuration options 1 -command beep command} -body {
 566     .m1 entryconfigure 1 -command beep
 567     lindex [.m1 entryconfigure 1 -command] 4
 568 } -result {beep}
 569
 570 test menu-2.93 {entry configuration options 2 -command beep cascade} -body {
 571     .m1 entryconfigure 2 -command beep
 572     lindex [.m1 entryconfigure 2 -command] 4
 573 } -result {beep}
 574
 575 test menu-2.94 {entry configuration options 3 -command beep separator} -body {
 576     .m1 entryconfigure 3 -command beep
 577 } -returnCodes error -result {unknown option "-command"}
 578
 579 test menu-2.95 {entry configuration options 4 -command beep checkbutton} -body {
 580     .m1 entryconfigure 4 -command beep
 581     lindex [.m1 entryconfigure 4 -command] 4
 582 } -result {beep}
 583
 584 test menu-2.96 {entry configuration options 5 -command beep radiobutton} -body {
 585     .m1 entryconfigure 5 -command beep
 586     lindex [.m1 entryconfigure 5 -command] 4
 587 } -result {beep}
 588
 589 test menu-2.97 {entry configuration options 0 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* tearoff} -body {
 590     .m1 entryconfigure 0 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 591 } -returnCodes error -result {unknown option "-font"}
 592
 593 test menu-2.98 {entry configuration options 1 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* command} -body {
 594     .m1 entryconfigure 1 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 595     lindex [.m1 entryconfigure 1 -font] 4
 596 } -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
 597
 598 test menu-2.99 {entry configuration options 2 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* cascade} -body {
 599     .m1 entryconfigure 2 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 600     lindex [.m1 entryconfigure 2 -font] 4
 601 } -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
 602
 603 test menu-2.100 {entry configuration options 3 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* separator} -body {
 604     .m1 entryconfigure 3 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 605 } -returnCodes error -result {unknown option "-font"}
 606
 607 test menu-2.101 {entry configuration options 4 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* checkbutton} -body {
 608     .m1 entryconfigure 4 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 609     lindex [.m1 entryconfigure 4 -font] 4
 610 } -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
 611
 612 test menu-2.102 {entry configuration options 5 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* radiobutton} -body {
 613     .m1 entryconfigure 5 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 614     lindex [.m1 entryconfigure 5 -font] 4
 615 } -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
 616
 617 test menu-2.103 {entry configuration options 0 -font {kill rock stars} tearoff} -body {
 618     .m1 entryconfigure 0 -font {kill rock stars}
 619 } -returnCodes error -result {unknown option "-font"}
 620
 621 test menu-2.104 {entry configuration options 1 -font {kill rock stars} command} -body {
 622     .m1 entryconfigure 1 -font {kill rock stars}
 623 } -returnCodes error -result {expected integer but got "rock"}
 624
 625 test menu-2.105 {entry configuration options 2 -font {kill rock stars} cascade} -body {
 626     .m1 entryconfigure 2 -font {kill rock stars}
 627 } -returnCodes error -result {expected integer but got "rock"}
 628
 629 test menu-2.106 {entry configuration options 3 -font {kill rock stars} separator} -body {
 630     .m1 entryconfigure 3 -font {kill rock stars}
 631 } -returnCodes error -result {unknown option "-font"}
 632
 633 test menu-2.107 {entry configuration options 4 -font {kill rock stars} checkbutton} -body {
 634     .m1 entryconfigure 4 -font {kill rock stars}
 635 } -returnCodes error -result {expected integer but got "rock"}
 636
 637 test menu-2.108 {entry configuration options 5 -font {kill rock stars} radiobutton} -body {
 638     .m1 entryconfigure 5 -font {kill rock stars}
 639 } -returnCodes error -result {expected integer but got "rock"}
 640
 641 test menu-2.109 {entry configuration options 0 -foreground #110022 tearoff} -body {
 642     .m1 entryconfigure 0 -foreground #110022
 643 } -returnCodes error -result {unknown option "-foreground"}
 644
 645 test menu-2.110 {entry configuration options 1 -foreground #110022 command} -body {
 646     .m1 entryconfigure 1 -foreground #110022
 647     lindex [.m1 entryconfigure 1 -foreground] 4
 648 } -result {#110022}
 649
 650 test menu-2.111 {entry configuration options 2 -foreground #110022 cascade} -body {
 651     .m1 entryconfigure 2 -foreground #110022
 652     lindex [.m1 entryconfigure 2 -foreground] 4
 653 } -result {#110022}
 654
 655 test menu-2.112 {entry configuration options 3 -foreground #110022 separator} -body {
 656     .m1 entryconfigure 3 -foreground #110022
 657 } -returnCodes error -result {unknown option "-foreground"}
 658
 659 test menu-2.113 {entry configuration options 4 -foreground #110022 checkbutton} -body {
 660     .m1 entryconfigure 4 -foreground #110022
 661     lindex [.m1 entryconfigure 4 -foreground] 4
 662 } -result {#110022}
 663
 664 test menu-2.114 {entry configuration options 5 -foreground #110022 radiobutton} -body {
 665     .m1 entryconfigure 5 -foreground #110022
 666     lindex [.m1 entryconfigure 5 -foreground] 4
 667 } -result {#110022}
 668
 669 test menu-2.115 {entry configuration options 0 -foreground non-existent tearoff} -body {
 670     .m1 entryconfigure 0 -foreground non-existent
 671 } -returnCodes error -result {unknown option "-foreground"}
 672
 673 test menu-2.116 {entry configuration options 1 -foreground non-existent command} -body {
 674     .m1 entryconfigure 1 -foreground non-existent
 675 } -returnCodes error -result {unknown color name "non-existent"}
 676
 677 test menu-2.117 {entry configuration options 2 -foreground non-existent cascade} -body {
 678     .m1 entryconfigure 2 -foreground non-existent
 679 } -returnCodes error -result {unknown color name "non-existent"}
 680
 681 test menu-2.118 {entry configuration options 3 -foreground non-existent separator} -body {
 682     .m1 entryconfigure 3 -foreground non-existent
 683 } -returnCodes error -result {unknown option "-foreground"}
 684
 685 test menu-2.119 {entry configuration options 4 -foreground non-existent checkbutton} -body {
 686     .m1 entryconfigure 4 -foreground non-existent
 687 } -returnCodes error -result {unknown color name "non-existent"}
 688
 689 test menu-2.120 {entry configuration options 5 -foreground non-existent radiobutton} -body {
 690     .m1 entryconfigure 5 -foreground non-existent
 691 } -returnCodes error -result {unknown color name "non-existent"}
 692
 693 test menu-2.121 {entry configuration options 0 -image image1 tearoff} -constraints {
 694     hasEarthPhoto
 695 } -body {
 696     .m1 entryconfigure 0 -image image1
 697 } -returnCodes error -result {unknown option "-image"}
 698
 699 test menu-2.122 {entry configuration options 1 -image image1 command} -constraints {
 700     hasEarthPhoto
 701 } -setup {
 702     .m1 entryconfigure 1 -image {}
 703 } -body {
 704     .m1 entryconfigure 1 -image image1
 705     lindex [.m1 entryconfigure 1 -image] 4
 706 } -cleanup {
 707     .m1 entryconfigure 1 -image {}
 708 } -result {image1}
 709
 710 test menu-2.123 {entry configuration options 2 -image image1 cascade} -constraints {
 711     hasEarthPhoto
 712 } -setup {
 713     .m1 entryconfigure 2 -image {}
 714 } -body {
 715     .m1 entryconfigure 2 -image image1
 716     lindex [.m1 entryconfigure 2 -image] 4
 717 } -cleanup {
 718     .m1 entryconfigure 2 -image {}
 719 } -result {image1}
 720
 721 test menu-2.124 {entry configuration options 3 -image image1 separator} -constraints {
 722     hasEarthPhoto
 723 } -body {
 724     .m1 entryconfigure 3 -image image1
 725 } -returnCodes error -result {unknown option "-image"}
 726
 727 test menu-2.125 {entry configuration options 4 -image image1 checkbutton} -constraints {
 728     hasEarthPhoto
 729 } -setup {
 730     .m1 entryconfigure 4 -image {}
 731 } -body {
 732     .m1 entryconfigure 4 -image image1
 733     lindex [.m1 entryconfigure 4 -image] 4
 734 } -cleanup {
 735     .m1 entryconfigure 4 -image {}
 736 } -result {image1}
 737
 738 test menu-2.126 {entry configuration options 5 -image image1 radiobutton} -constraints {
 739     hasEarthPhoto
 740 } -setup {
 741     .m1 entryconfigure 5 -image {}
 742 } -body {
 743     .m1 entryconfigure 5 -image image1
 744     lindex [.m1 entryconfigure 5 -image] 4
 745 } -cleanup {
 746     .m1 entryconfigure 5 -image {}
 747 } -result {image1}
 748
 749 test menu-2.127 {entry configuration options 0 -image bogus tearoff} -body {
 750     .m1 entryconfigure 0 -image bogus
 751 } -returnCodes error -result {unknown option "-image"}
 752
 753 test menu-2.128 {entry configuration options 1 -image bogus command} -body {
 754     .m1 entryconfigure 1 -image bogus
 755 } -returnCodes error -result {image "bogus" doesn't exist}
 756
 757 test menu-2.129 {entry configuration options 2 -image bogus cascade} -body {
 758     .m1 entryconfigure 2 -image bogus
 759 } -returnCodes error -result {image "bogus" doesn't exist}
 760
 761 test menu-2.130 {entry configuration options 3 -image bogus separator} -body {
 762     .m1 entryconfigure 3 -image bogus
 763 } -returnCodes error -result {unknown option "-image"}
 764
 765 test menu-2.131 {entry configuration options 4 -image bogus checkbutton} -body {
 766     .m1 entryconfigure 4 -image bogus
 767 } -returnCodes error -result {image "bogus" doesn't exist}
 768
 769 test menu-2.132 {entry configuration options 5 -image bogus radiobutton} -body {
 770     .m1 entryconfigure 5 -image bogus
 771 } -returnCodes error -result {image "bogus" doesn't exist}
 772
 773 test menu-2.133 {entry configuration options 0 -image {} tearoff} -body {
 774     .m1 entryconfigure 0 -image
 775 } -returnCodes error -result {unknown option "-image"}
 776
 777 test menu-2.134 {entry configuration options 1 -image {} command} -setup {
 778     .m1 entryconfigure 1 -image {}
 779 } -body {
 780     .m1 entryconfigure 1 -image
 781     lindex [.m1 entryconfigure 1 -image] 4
 782 } -result {}
 783
 784 test menu-2.135 {entry configuration options 2 -image {} cascade} -setup {
 785     .m1 entryconfigure 2 -image {}
 786 } -body {
 787     .m1 entryconfigure 2 -image
 788     lindex [.m1 entryconfigure 2 -image] 4
 789 } -result {}
 790
 791 test menu-2.136 {entry configuration options 3 -image {} separator} -body {
 792     .m1 entryconfigure 3 -image
 793 } -returnCodes error -result {unknown option "-image"}
 794
 795 test menu-2.137 {entry configuration options 4 -image {} checkbutton} -body {
 796     .m1 entryconfigure 4 -image
 797     lindex [.m1 entryconfigure 4 -image] 4
 798 } -result {}
 799
 800 test menu-2.138 {entry configuration options 5 -image {} radiobutton} -body {
 801     .m1 entryconfigure 5 -image
 802     lindex [.m1 entryconfigure 5 -image] 4
 803 } -result {}
 804
 805 test menu-2.139 {entry configuration options 0 -indicatoron 1 tearoff} -body {
 806     .m1 entryconfigure 0 -indicatoron 1
 807 } -returnCodes error -result {unknown option "-indicatoron"}
 808
 809 test menu-2.140 {entry configuration options 1 -indicatoron 1 command} -body {
 810     .m1 entryconfigure 1 -indicatoron 1
 811 } -returnCodes error -result {unknown option "-indicatoron"}
 812
 813 test menu-2.141 {entry configuration options 2 -indicatoron 1 cascade} -body {
 814     .m1 entryconfigure 2 -indicatoron 1
 815 } -returnCodes error -result {unknown option "-indicatoron"}
 816
 817 test menu-2.142 {entry configuration options 3 -indicatoron 1 separator} -body {
 818     .m1 entryconfigure 3 -indicatoron 1
 819 } -returnCodes error -result {unknown option "-indicatoron"}
 820
 821 test menu-2.143 {entry configuration options 4 -indicatoron 1 checkbutton} -body {
 822     .m1 entryconfigure 4 -indicatoron 1
 823     lindex [.m1 entryconfigure 4 -indicatoron] 4
 824 } -result 1
 825
 826 test menu-2.144 {entry configuration options 5 -indicatoron 1 radiobutton} -body {
 827     .m1 entryconfigure 5 -indicatoron 1
 828     lindex [.m1 entryconfigure 5 -indicatoron] 4
 829 } -result 1
 830
 831 test menu-2.145 {entry configuration options 0 -label test tearoff} -body {
 832     .m1 entryconfigure 0 -label test
 833 } -returnCodes error -result {unknown option "-label"}
 834
 835 test menu-2.146 {entry configuration options 1 -label test command} -body {
 836     .m1 entryconfigure 1 -label test
 837     lindex [.m1 entryconfigure 1 -label] 4
 838 } -result {test}
 839
 840 test menu-2.147 {entry configuration options 2 -label test cascade} -body {
 841     .m1 entryconfigure 2 -label test
 842     lindex [.m1 entryconfigure 2 -label] 4
 843 } -result {test}
 844
 845 test menu-2.148 {entry configuration options 3 -label test separator} -body {
 846     .m1 entryconfigure 3 -label test
 847 } -returnCodes error -result {unknown option "-label"}
 848
 849 test menu-2.149 {entry configuration options 4 -label test checkbutton} -body {
 850     .m1 entryconfigure 4 -label test
 851     lindex [.m1 entryconfigure 4 -label] 4
 852 } -result {test}
 853
 854 test menu-2.150 {entry configuration options 5 -label test radiobutton} -body {
 855     .m1 entryconfigure 5 -label test
 856     lindex [.m1 entryconfigure 5 -label] 4
 857 } -result {test}
 858
 859 test menu-2.151 {entry configuration options 0 -menu .m2 tearoff} -body {
 860     .m1 entryconfigure 0 -menu .m2
 861 } -returnCodes error -result {unknown option "-menu"}
 862
 863 test menu-2.152 {entry configuration options 1 -menu .m2 command} -body {
 864     .m1 entryconfigure 1 -menu .m2
 865 } -returnCodes error -result {unknown option "-menu"}
 866
 867 test menu-2.153 {entry configuration options 2 -menu .m2 cascade} -body {
 868     .m1 entryconfigure 2 -menu .m2
 869     lindex [.m1 entryconfigure 2 -menu] 4
 870 } -result {.m2}
 871
 872 test menu-2.154 {entry configuration options 3 -menu .m2 separator} -body {
 873     .m1 entryconfigure 3 -menu .m2
 874 } -returnCodes error -result {unknown option "-menu"}
 875
 876 test menu-2.155 {entry configuration options 4 -menu .m2 checkbutton} -body {
 877     .m1 entryconfigure 4 -menu .m2
 878 } -returnCodes error -result {unknown option "-menu"}
 879
 880 test menu-2.156 {entry configuration options 5 -menu .m2 radiobutton} -body {
 881     .m1 entryconfigure 5 -menu .m2
 882 } -returnCodes error -result {unknown option "-menu"}
 883
 884 test menu-2.157 {entry configuration options 0 -offvalue off tearoff} -body {
 885     .m1 entryconfigure 0 -offvalue off
 886 } -returnCodes error -result {unknown option "-offvalue"}
 887
 888 test menu-2.158 {entry configuration options 1 -offvalue off command} -body {
 889     .m1 entryconfigure 1 -offvalue off
 890 } -returnCodes error -result {unknown option "-offvalue"}
 891
 892 test menu-2.159 {entry configuration options 2 -offvalue off cascade} -body {
 893     .m1 entryconfigure 2 -offvalue off
 894 } -returnCodes error -result {unknown option "-offvalue"}
 895
 896 test menu-2.160 {entry configuration options 3 -offvalue off separator} -body {
 897     .m1 entryconfigure 3 -offvalue off
 898 } -returnCodes error -result {unknown option "-offvalue"}
 899
 900 test menu-2.161 {entry configuration options 4 -offvalue off checkbutton} -body {
 901     .m1 entryconfigure 4 -offvalue off
 902     lindex [.m1 entryconfigure 4 -offvalue] 4
 903 } -result {off}
 904
 905 test menu-2.162 {entry configuration options 5 -offvalue off radiobutton} -body {
 906     .m1 entryconfigure 5 -offvalue off
 907 } -returnCodes error -result {unknown option "-offvalue"}
 908
 909 test menu-2.163 {entry configuration options 0 -onvalue on tearoff} -body {
 910     .m1 entryconfigure 0 -onvalue on
 911 } -returnCodes error -result {unknown option "-onvalue"}
 912
 913 test menu-2.164 {entry configuration options 1 -onvalue on command} -body {
 914     .m1 entryconfigure 1 -onvalue on
 915 } -returnCodes error -result {unknown option "-onvalue"}
 916
 917 test menu-2.165 {entry configuration options 2 -onvalue on cascade} -body {
 918     .m1 entryconfigure 2 -onvalue on
 919 } -returnCodes error -result {unknown option "-onvalue"}
 920
 921 test menu-2.166 {entry configuration options 3 -onvalue on separator} -body {
 922     .m1 entryconfigure 3 -onvalue on
 923 } -returnCodes error -result {unknown option "-onvalue"}
 924
 925 test menu-2.167 {entry configuration options 4 -onvalue on checkbutton} -body {
 926     .m1 entryconfigure 4 -onvalue on
 927     lindex [.m1 entryconfigure 4 -onvalue] 4
 928 } -result {on}
 929
 930 test menu-2.168 {entry configuration options 5 -onvalue on radiobutton} -body {
 931     .m1 entryconfigure 5 -onvalue on
 932 } -returnCodes error -result {unknown option "-onvalue"}
 933
 934 test menu-2.169 {entry configuration options 0 -selectcolor #110022 tearoff} -body {
 935     .m1 entryconfigure 0 -selectcolor #110022
 936 } -returnCodes error -result {unknown option "-selectcolor"}
 937
 938 test menu-2.170 {entry configuration options 1 -selectcolor #110022 command} -body {
 939     .m1 entryconfigure 1 -selectcolor #110022
 940 } -returnCodes error -result {unknown option "-selectcolor"}
 941
 942 test menu-2.171 {entry configuration options 2 -selectcolor #110022 cascade} -body {
 943     .m1 entryconfigure 2 -selectcolor #110022
 944 } -returnCodes error -result {unknown option "-selectcolor"}
 945
 946 test menu-2.172 {entry configuration options 3 -selectcolor #110022 separator} -body {
 947     .m1 entryconfigure 3 -selectcolor #110022
 948 } -returnCodes error -result {unknown option "-selectcolor"}
 949
 950 test menu-2.173 {entry configuration options 4 -selectcolor #110022 checkbutton} -body {
 951     .m1 entryconfigure 4 -selectcolor #110022
 952     lindex [.m1 entryconfigure 4 -selectcolor] 4
 953 } -result {#110022}
 954
 955 test menu-2.174 {entry configuration options 5 -selectcolor #110022 radiobutton} -body {
 956     .m1 entryconfigure 5 -selectcolor #110022
 957     lindex [.m1 entryconfigure 5 -selectcolor] 4
 958 } -result {#110022}
 959
 960 test menu-2.175 {entry configuration options 0 -selectcolor non-existent tearoff} -body {
 961     .m1 entryconfigure 0 -selectcolor non-existent
 962 } -returnCodes error -result {unknown option "-selectcolor"}
 963
 964 test menu-2.176 {entry configuration options 1 -selectcolor non-existent command} -body {
 965     .m1 entryconfigure 1 -selectcolor non-existent
 966 } -returnCodes error -result {unknown option "-selectcolor"}
 967
 968 test menu-2.177 {entry configuration options 2 -selectcolor non-existent cascade} -body {
 969     .m1 entryconfigure 2 -selectcolor non-existent
 970 } -returnCodes error -result {unknown option "-selectcolor"}
 971
 972 test menu-2.178 {entry configuration options 3 -selectcolor non-existent separator} -body {
 973     .m1 entryconfigure 3 -selectcolor non-existent
 974 } -returnCodes error -result {unknown option "-selectcolor"}
 975
 976 test menu-2.179 {entry configuration options 4 -selectcolor non-existent checkbutton} -body {
 977     .m1 entryconfigure 4 -selectcolor non-existent
 978 } -returnCodes error -result {unknown color name "non-existent"}
 979
 980 test menu-2.180 {entry configuration options 5 -selectcolor non-existent radiobutton} -body {
 981     .m1 entryconfigure 5 -selectcolor non-existent
 982 } -returnCodes error -result {unknown color name "non-existent"}
 983
 984 test menu-2.181 {entry configuration options 0 -selectimage image1 tearoff} -constraints {
 985     hasEarthPhoto
 986 } -body {
 987     .m1 entryconfigure 0 -selectimage image1
 988 } -returnCodes error -result {unknown option "-selectimage"}
 989
 990 test menu-2.182 {entry configuration options 1 -selectimage image1 command} -constraints {
 991     hasEarthPhoto
 992 } -body {
 993     .m1 entryconfigure 1 -selectimage image1
 994 } -returnCodes error -result {unknown option "-selectimage"}
 995
 996 test menu-2.183 {entry configuration options 2 -selectimage image1 cascade} -constraints {
 997     hasEarthPhoto
 998 } -body {
 999     .m1 entryconfigure 2 -selectimage image1
1000 } -returnCodes error -result {unknown option "-selectimage"}
1001
1002 test menu-2.184 {entry configuration options 3 -selectimage image1 separator} -constraints {
1003     hasEarthPhoto
1004 } -body {
1005     .m1 entryconfigure 3 -selectimage image1
1006 } -returnCodes error -result {unknown option "-selectimage"}
1007
1008 test menu-2.185 {entry configuration options 4 -selectimage image1 checkbutton} -constraints {
1009     hasEarthPhoto
1010 } -setup {
1011     .m1 entryconfigure 4 -selectimage {}
1012 } -body {
1013     .m1 entryconfigure 4 -selectimage image1
1014     lindex [.m1 entryconfigure 4 -selectimage] 4
1015 } -cleanup {
1016     .m1 entryconfigure 4 -selectimage {}
1017 } -result {image1}
1018
1019 test menu-2.186 {entry configuration options 5 -selectimage image1 radiobutton} -constraints {
1020     hasEarthPhoto
1021 } -setup {
1022     .m1 entryconfigure 5 -selectimage {}
1023 } -body {
1024     .m1 entryconfigure 5 -selectimage image1
1025     lindex [.m1 entryconfigure 5 -selectimage] 4
1026 } -cleanup {
1027     .m1 entryconfigure 5 -selectimage {}
1028 } -result {image1}
1029
1030 test menu-2.187 {entry configuration options 0 -selectimage bogus tearoff} -body {
1031     .m1 entryconfigure 0 -selectimage bogus
1032 } -returnCodes error -result {unknown option "-selectimage"}
1033
1034 test menu-2.188 {entry configuration options 1 -selectimage bogus command} -body {
1035     .m1 entryconfigure 1 -selectimage bogus
1036 } -returnCodes error -result {unknown option "-selectimage"}
1037
1038 test menu-2.189 {entry configuration options 2 -selectimage bogus cascade} -body {
1039     .m1 entryconfigure 2 -selectimage bogus
1040 } -returnCodes error -result {unknown option "-selectimage"}
1041
1042 test menu-2.190 {entry configuration options 3 -selectimage bogus separator} -body {
1043     .m1 entryconfigure 3 -selectimage bogus
1044 } -returnCodes error -result {unknown option "-selectimage"}
1045
1046 test menu-2.191 {entry configuration options 4 -selectimage bogus checkbutton} -body {
1047     .m1 entryconfigure 4 -selectimage bogus
1048 } -returnCodes error -result {image "bogus" doesn't exist}
1049
1050 test menu-2.192 {entry configuration options 5 -selectimage bogus radiobutton} -body {
1051     .m1 entryconfigure 5 -selectimage bogus
1052 } -returnCodes error -result {image "bogus" doesn't exist}
1053
1054 test menu-2.193 {entry configuration options 0 -selectimage {} tearoff} -body {
1055     .m1 entryconfigure 0 -selectimage
1056 } -returnCodes error -result {unknown option "-selectimage"}
1057
1058 test menu-2.194 {entry configuration options 1 -selectimage {} command} -body {
1059     .m1 entryconfigure 1 -selectimage
1060 } -returnCodes error -result {unknown option "-selectimage"}
1061
1062 test menu-2.195 {entry configuration options 2 -selectimage {} cascade} -body {
1063     .m1 entryconfigure 2 -selectimage
1064 } -returnCodes error -result {unknown option "-selectimage"}
1065
1066 test menu-2.196 {entry configuration options 3 -selectimage {} separator} -body {
1067     .m1 entryconfigure 3 -selectimage
1068 } -returnCodes error -result {unknown option "-selectimage"}
1069
1070 test menu-2.197 {entry configuration options 4 -selectimage {} checkbutton} -body {
1071     .m1 entryconfigure 4 -selectimage
1072     lindex [.m1 entryconfigure 4 -selectimage] 4
1073 } -result {}
1074
1075 test menu-2.198 {entry configuration options 5 -selectimage {} radiobutton} -body {
1076     .m1 entryconfigure 5 -selectimage
1077     lindex [.m1 entryconfigure 5 -selectimage] 4
1078 } -result {}
1079
1080 test menu-2.199 {entry configuration options 0 -state normal tearoff} -body {
1081     .m1 entryconfigure 0 -state normal
1082     lindex [.m1 entryconfigure 0 -state] 4
1083 } -result {normal}
1084
1085 test menu-2.200 {entry configuration options 1 -state normal command} -body {
1086     .m1 entryconfigure 1 -state normal
1087     lindex [.m1 entryconfigure 1 -state] 4
1088 } -result {normal}
1089
1090 test menu-2.201 {entry configuration options 2 -state normal cascade} -body {
1091     .m1 entryconfigure 2 -state normal
1092     lindex [.m1 entryconfigure 2 -state] 4
1093 } -result {normal}
1094
1095 test menu-2.202 {entry configuration options 3 -state normal separator} -body {
1096     .m1 entryconfigure 3 -state normal
1097 } -returnCodes error -result {unknown option "-state"}
1098
1099 test menu-2.203 {entry configuration options 4 -state normal checkbutton} -body {
1100     .m1 entryconfigure 4 -state normal
1101     lindex [.m1 entryconfigure 4 -state] 4
1102 } -result {normal}
1103
1104 test menu-2.204 {entry configuration options 5 -state normal radiobutton} -body {
1105     .m1 entryconfigure 5 -state normal
1106     lindex [.m1 entryconfigure 5 -state] 4
1107 } -result {normal}
1108
1109 test menu-2.205 {entry configuration options 0 -value {any string} tearoff} -body {
1110     .m1 entryconfigure 0 -value {any string}
1111 } -returnCodes error -result {unknown option "-value"}
1112
1113 test menu-2.206 {entry configuration options 1 -value {any string} command} -body {
1114     .m1 entryconfigure 1 -value {any string}
1115 } -returnCodes error -result {unknown option "-value"}
1116
1117 test menu-2.207 {entry configuration options 2 -value {any string} cascade} -body {
1118     .m1 entryconfigure 2 -value {any string}
1119 } -returnCodes error -result {unknown option "-value"}
1120
1121 test menu-2.208 {entry configuration options 3 -value {any string} separator} -body {
1122     .m1 entryconfigure 3 -value {any string}
1123 } -returnCodes error -result {unknown option "-value"}
1124
1125 test menu-2.209 {entry configuration options 4 -value {any string} checkbutton} -body {
1126     .m1 entryconfigure 4 -value {any string}
1127 } -returnCodes error -result {unknown option "-value"}
1128
1129 test menu-2.210 {entry configuration options 5 -value {any string} radiobutton} -body {
1130     .m1 entryconfigure 5 -value {any string}
1131     lindex [.m1 entryconfigure 5 -value] 4
1132 } -result {any string}
1133
1134 test menu-2.211 {entry configuration options 0 -variable {any string} tearoff} -body {
1135     .m1 entryconfigure 0 -variable {any string}
1136 } -returnCodes error -result {unknown option "-variable"}
1137
1138 test menu-2.212 {entry configuration options 1 -variable {any string} command} -body {
1139     .m1 entryconfigure 1 -variable {any string}
1140 } -returnCodes error -result {unknown option "-variable"}
1141
1142 test menu-2.213 {entry configuration options 2 -variable {any string} cascade} -body {
1143     .m1 entryconfigure 2 -variable {any string}
1144 } -returnCodes error -result {unknown option "-variable"}
1145
1146 test menu-2.214 {entry configuration options 3 -variable {any string} separator} -body {
1147     .m1 entryconfigure 3 -variable {any string}
1148 } -returnCodes error -result {unknown option "-variable"}
1149
1150 test menu-2.215 {entry configuration options 4 -variable {any string} checkbutton} -body {
1151     .m1 entryconfigure 4 -variable {any string}
1152     lindex [.m1 entryconfigure 4 -variable] 4
1153 } -result {any string}
1154
1155 test menu-2.216 {entry configuration options 5 -variable {any string} radiobutton} -body {
1156     .m1 entryconfigure 5 -variable {any string}
1157     lindex [.m1 entryconfigure 5 -variable] 4
1158 } -result {any string}
1159
1160 test menu-2.217 {entry configuration options 0 -underline 0 tearoff} -body {
1161     .m1 entryconfigure 0 -underline 0
1162 } -returnCodes error -result {unknown option "-underline"}
1163
1164 test menu-2.218 {entry configuration options 1 -underline 0 command} -body {
1165     .m1 entryconfigure 1 -underline 0
1166     lindex [.m1 entryconfigure 1 -underline] 4
1167 } -result 0
1168
1169 test menu-2.219 {entry configuration options 2 -underline 0 cascade} -body {
1170     .m1 entryconfigure 2 -underline 0
1171     lindex [.m1 entryconfigure 2 -underline] 4
1172 } -result 0
1173
1174 test menu-2.220 {entry configuration options 3 -underline 0 separator} -body {
1175     .m1 entryconfigure 3 -underline 0
1176 } -returnCodes error -result {unknown option "-underline"}
1177
1178 test menu-2.221 {entry configuration options 4 -underline 0 checkbutton} -body {
1179     .m1 entryconfigure 4 -underline 0
1180     lindex [.m1 entryconfigure 4 -underline] 4
1181 } -result 0
1182
1183 test menu-2.222 {entry configuration options 5 -underline 0 radiobutton} -body {
1184     .m1 entryconfigure 5 -underline 0
1185     lindex [.m1 entryconfigure 5 -underline] 4
1186 } -result 0
1187
1188 test menu-2.223 {entry configuration options 0 -underline 3p tearoff} -body {
1189     .m1 entryconfigure 0 -underline 3p
1190 } -returnCodes error -result {unknown option "-underline"}
1191
1192 test menu-2.224 {entry configuration options 1 -underline 3p command} -body {
1193     .m1 entryconfigure 1 -underline 3p
1194 } -returnCodes error -result {expected integer but got "3p"}
1195
1196 test menu-2.225 {entry configuration options 2 -underline 3p cascade} -body {
1197     .m1 entryconfigure 2 -underline 3p
1198 } -returnCodes error -result {expected integer but got "3p"}
1199
1200 test menu-2.226 {entry configuration options 3 -underline 3p separator} -body {
1201     .m1 entryconfigure 3 -underline 3p
1202 } -returnCodes error -result {unknown option "-underline"}
1203
1204 test menu-2.227 {entry configuration options 4 -underline 3p checkbutton} -body {
1205     .m1 entryconfigure 4 -underline 3p
1206 } -returnCodes error -result {expected integer but got "3p"}
1207
1208 test menu-2.228 {entry configuration options 5 -underline 3p radiobutton} -body {
1209     .m1 entryconfigure 5 -underline 3p
1210 } -returnCodes error -result {expected integer but got "3p"}
1211
1212 deleteWindows
1213 if {[testConstraint hasEarthPhoto]} {
1214     image delete image1
1215 }
1216
1217
1218
1219 test menu-3.1 {MenuWidgetCmd procedure} -setup {
1220     destroy .m1
1221 } -body {
1222     menu .m1
1223     .m1
1224 } -cleanup {
1225         destroy .m1
1226 } -returnCodes error -result {wrong # args: should be ".m1 option ?arg ...?"}
1227 test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} -constraints {
1228         nonUnixUserInteraction
1229 } -setup {
1230     destroy .m1
1231 } -body  {
1232     menu .m1 -postcommand "destroy .m1"
1233     .m1 add command -label "menu-3.2: Hit Escape"
1234     .m1 post 40 40
1235 } -cleanup {
1236     destroy .m1
1237 } -returnCodes ok -result {}
1238 test menu-3.3 {MenuWidgetCmd procedure, "activate" option} -setup {
1239         destroy .m1
1240 } -body {
1241     menu .m1
1242     .m1 add command -label "test"
1243     .m1 activate
1244 } -cleanup {
1245         destroy .m1
1246 } -returnCodes error -result {wrong # args: should be ".m1 activate index"}
1247 test menu-3.4 {MenuWidgetCmd procedure, "activate" option} -setup {
1248         destroy .m1
1249 } -body {
1250     menu .m1
1251     .m1 activate "foo"
1252 } -returnCodes error -result {bad menu entry index "foo"}
1253 test menu-3.5 {MenuWidgetCmd procedure, "activate" option} -setup {
1254         destroy .m1
1255 } -body {
1256     menu .m1
1257     .m1 add command -label "test"
1258     .m1 add separator
1259     .m1 activate 2
1260 } -cleanup {
1261         destroy .m1
1262 } -result {}
1263 test menu-3.6 {MenuWidgetCmd procedure, "activate" option} -setup {
1264         destroy .m1
1265 } -body {
1266     menu .m1
1267     .m1 add command -label "test"
1268     .m1 entryconfigure 1 -state disabled
1269     .m1 activate 1
1270 } -cleanup {
1271         destroy .m1
1272 } -result {}
1273 test menu-3.7 {MenuWidgetCmd procedure, "activate" option} -setup {
1274         destroy .m1
1275 } -body {
1276     menu .m1
1277     .m1 add command -label "test"
1278     .m1 activate 1
1279 } -cleanup {
1280         destroy .m1
1281 } -result {}
1282 test menu-3.8 {MenuWidgetCmd procedure, "add" option} -setup {
1283         destroy .m1
1284 } -body {
1285     menu .m1
1286     .m1 add
1287 } -cleanup {
1288         destroy .m1
1289 } -returnCodes error -result {wrong # args: should be ".m1 add type ?-option value ...?"}
1290 test menu-3.9 {MenuWidgetCmd procedure, "add" option} -setup {
1291         destroy .m1
1292 } -body {
1293     menu .m1
1294     .m1 add foo
1295 } -cleanup {
1296         destroy .m1
1297 } -returnCodes error -result {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator}
1298 test menu-3.10 {MenuWidgetCmd procedure, "add" option} -setup {
1299         destroy .m1
1300 } -body {
1301     menu .m1
1302     .m1 add separator
1303 } -cleanup {
1304         destroy .m1
1305 } -result {}
1306 test menu-3.11 {MenuWidgetCmd procedure, "cget" option} -setup {
1307         destroy .m1
1308 } -body {
1309     menu .m1
1310     .m1 cget
1311 } -returnCodes error -result {wrong # args: should be ".m1 cget option"}
1312 test menu-3.12 {MenuWidgetCmd procedure, "cget" option} -setup {
1313         destroy .m1
1314 } -body {
1315     menu .m1
1316     .m1 cget -gorp
1317 } -returnCodes error -result {unknown option "-gorp"}
1318 test menu-3.13 {MenuWidgetCmd procedure, "cget" option} -setup {
1319         destroy .m1
1320 } -body {
1321     menu .m1
1322     .m1 configure -postcommand "Some string"
1323     .m1 cget -postcommand
1324 } -cleanup {
1325         destroy .m1
1326 } -result {Some string}
1327 test menu-3.14 {MenuWidgetCmd procedure, "clone" option} -setup {
1328         destroy .m1
1329 } -body {
1330     menu .m1
1331     .m1 clone
1332 } -returnCodes error -result {wrong # args: should be ".m1 clone newMenuName ?menuType?"}
1333 test menu-3.15 {MenuWidgetCmd procedure, "clone" option} -setup {
1334         destroy .m1
1335 } -body {
1336     menu .m1
1337     .m1 clone a b c d
1338 } -returnCodes error -result {wrong # args: should be ".m1 clone newMenuName ?menuType?"}
1339 test menu-3.16 {MenuWidgetCmd procedure, "clone" option} -setup {
1340         destroy .m1
1341 } -body {
1342     menu .m1
1343     .m1 clone .m1.clone1
1344 } -cleanup {
1345         destroy .m1
1346 } -result {}
1347 test menu-3.17 {MenuWidgetCmd procedure, "clone" option} -setup {
1348         destroy .m1
1349 } -body {
1350     menu .m1
1351     .m1 clone .m1.clone1 tearoff
1352 } -cleanup {
1353         destroy .m1
1354 } -result {}
1355 test menu-3.18 {MenuWidgetCmd procedure, "configure" option} -setup {
1356         destroy .m1
1357 } -body {
1358     menu .m1
1359     llength [.m1 configure]
1360 } -cleanup {
1361         destroy .m1
1362 } -result 20
1363 test menu-3.19 {MenuWidgetCmd procedure, "configure" option} -setup {
1364         destroy .m1
1365 } -body {
1366     menu .m1
1367     .m1 configure -gorp
1368 } -returnCodes error -result {unknown option "-gorp"}
1369 test menu-3.20 {MenuWidgetCmd procedure, "configure" option} -setup {
1370         destroy .m1
1371 } -body {
1372     menu .m1
1373     .m1 configure -postcommand "A random String"
1374 } -cleanup {
1375         destroy .m1
1376 } -result {}
1377 test menu-3.21 {MenuWidgetCmd procedure, "configure" option} -setup {
1378         destroy .m1
1379 } -body {
1380     menu .m1
1381     .m1 configure -postcommand "Another string"
1382     lindex [.m1 configure -postcommand] 4
1383 } -cleanup {
1384         destroy .m1
1385 } -result {Another string}
1386 test menu-3.22 {MenuWidgetCmd procedure, "delete" option} -setup {
1387         destroy .m1
1388 } -body {
1389     menu .m1
1390     .m1 delete
1391 } -returnCodes error -result {wrong # args: should be ".m1 delete first ?last?"}
1392 test menu-3.23 {MenuWidgetCmd procedure, "delete" option} -setup {
1393         destroy .m1
1394 } -body {
1395     menu .m1
1396     .m1 delete foo
1397 } -returnCodes error -result {bad menu entry index "foo"}
1398 test menu-3.24 {MenuWidgetCmd procedure, "delete" option} -setup {
1399         destroy .m1
1400 } -body {
1401     menu .m1 -tearoff 1
1402     .m1 delete 0 "foo"
1403 } -returnCodes error -result {bad menu entry index "foo"}
1404 test menu-3.25 {MenuWidgetCmd procedure, "delete" option} -setup {
1405         destroy .m1
1406 } -body {
1407     menu .m1
1408     .m1 delete 0
1409 } -cleanup {
1410         destroy .m1
1411 } -result {}
1412 test menu-3.26 {MenuWidgetCmd procedure, "delete" option} -setup {
1413         destroy .m1
1414 } -body {
1415     menu .m1
1416     .m1 add command -label "foo"
1417     .m1 delete 1 0
1418 } -cleanup {
1419         destroy .m1
1420 } -result {}
1421 test menu-3.27 {MenuWidgetCmd procedure, "delete" option} -setup {
1422         destroy .m1
1423 } -body {
1424     menu .m1
1425     .m1 add command -label "1"
1426     .m1 add command -label "2"
1427     .m1 add command -label "3"
1428     .m1 delete 1 3
1429 } -cleanup {
1430         destroy .m1
1431 } -result {}
1432 test menu-3.28 {MenuWidgetCmd procedure, "delete" option} -setup {
1433         destroy .m1
1434 } -body {
1435     menu .m1
1436     .m1 add command -label "1"
1437     .m1 add command -label "2"
1438     .m1 add command -label "3"
1439     .m1 activate 2
1440     .m1 delete 1 3
1441 } -cleanup {
1442         destroy .m1
1443 } -result {}
1444 test menu-3.29 {MenuWidgetCmd procedure, "delete" option} -setup {
1445         destroy .m1
1446 } -body {
1447     menu .m1
1448     .m1 add command -label "1"
1449     .m1 add command -label "2"
1450     .m1 add command -label "3"
1451     .m1 activate 3
1452     .m1 delete 1
1453 } -cleanup {
1454         destroy .m1
1455 } -result {}
1456 test menu-3.29+1 {MenuWidgetCmd, "delete", Bug 220950} -setup {
1457     destroy .m1
1458 } -body {
1459     menu .m1
1460     .m1 add command -label "bogus"
1461     .m1 add command -label "ok"
1462     .m1 delete 10 20
1463     .m1 entrycget last -label
1464 } -cleanup {
1465     destroy .m1
1466 } -result ok
1467 test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} -setup {
1468         destroy .m1
1469 } -body {
1470     menu .m1
1471     .m1 entrycget
1472 } -returnCodes error -result {wrong # args: should be ".m1 entrycget index option"}
1473 test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} -setup {
1474         destroy .m1
1475 } -body {
1476     menu .m1
1477     .m1 entrycget index option foo
1478 } -returnCodes error -result {wrong # args: should be ".m1 entrycget index option"}
1479 test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} -setup {
1480         destroy .m1
1481 } -body {
1482     menu .m1
1483     .m1 entrycget foo -label
1484 } -returnCodes error -result {bad menu entry index "foo"}
1485 test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} -setup {
1486         destroy .m1
1487 } -body {
1488     menu .m1
1489     .m1 add command -label "test"
1490     .m1 entrycget 1 -label
1491 } -cleanup {
1492         destroy .m1
1493 } -result {test}
1494 test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} -setup {
1495         destroy .m1
1496 } -body {
1497     menu .m1
1498     .m1 entryconfigure
1499 } -returnCodes error -result {wrong # args: should be ".m1 entryconfigure index ?-option value ...?"}
1500 test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} -setup {
1501         destroy .m1
1502 } -body {
1503     menu .m1
1504     .m1 entryconfigure foo
1505 } -returnCodes error -result {bad menu entry index "foo"}
1506 test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} -setup {
1507         destroy .m1
1508 } -body {
1509     menu .m1
1510     .m1 add command -label "test"
1511     llength [.m1 entryconfigure 1]
1512 } -cleanup {
1513         destroy .m1
1514 } -result 15
1515 test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} -setup {
1516         destroy .m1
1517 } -body {
1518     menu .m1
1519     .m1 add command -label "test"
1520     lindex [.m1 entryconfigure 1 -label] 4
1521 } -cleanup {
1522         destroy .m1
1523 } -result {test}
1524 test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} -setup {
1525         destroy .m1
1526 } -body {
1527     menu .m1
1528     .m1 add command -label "test"
1529     .m1 entryconfigure 1 -label "changed"
1530     lindex [.m1 entryconfigure 1 -label] 4
1531 } -cleanup {
1532         destroy .m1
1533 } -result {changed}
1534 test menu-3.39 {MenuWidgetCmd procedure, "index" option} -setup {
1535         destroy .m1
1536 } -body {
1537     menu .m1
1538     .m1 index
1539 } -returnCodes error -result {wrong # args: should be ".m1 index string"}
1540 test menu-3.40 {MenuWidgetCmd procedure, "index" option} -setup {
1541         destroy .m1
1542 } -body {
1543     menu .m1
1544     .m1 index foo
1545 } -returnCodes error -result {bad menu entry index "foo"}
1546 test menu-3.41 {MenuWidgetCmd procedure, "index" option} -setup {
1547         destroy .m1
1548 } -body {
1549     menu .m1 -tearoff 1
1550     .m1 add command -label "test"
1551     .m1 add command -label "3"
1552     .m1 add command -label "another label"
1553     .m1 add command -label "end"
1554     .m1 add command -label "3a"
1555     .m1 add command -label "final entry"
1556     list [.m1 index "test"] [.m1 index "3"] [.m1 index "3a"] [.m1 index "end"]
1557 } -cleanup {
1558         destroy .m1
1559 } -result {1 3 5 6}
1560 test menu-3.42 {MenuWidgetCmd procedure, "insert" option} -setup {
1561         destroy .m1
1562 } -body {
1563     menu .m1
1564     .m1 insert
1565 } -returnCodes error -result {wrong # args: should be ".m1 insert index type ?-option value ...?"}
1566 test menu-3.43 {MenuWidgetCmd procedure, "insert" option} -setup {
1567         destroy .m1
1568 } -body {
1569     menu .m1
1570     .m1 insert 1 command -label "test"
1571     .m1 entrycget 1 -label
1572 } -cleanup {
1573         destroy .m1
1574 } -result {test}
1575 test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} -setup {
1576         destroy .m1
1577 } -body {
1578     menu .m1
1579     .m1 invoke
1580 } -cleanup {
1581         destroy .m1
1582 } -returnCodes error -result {wrong # args: should be ".m1 invoke index"}
1583 test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} -setup {
1584         destroy .m1
1585 } -body {
1586     menu .m1
1587     .m1 invoke foo
1588 } -cleanup {
1589         destroy .m1
1590 } -returnCodes error -result {bad menu entry index "foo"}
1591 test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} -setup {
1592         destroy .m1
1593 } -body {
1594     catch {unset foo}
1595     menu .m1
1596     .m1 add command -label "set foo" -command "set foo hello"
1597     list [.m1 invoke 1] [set foo] [unset foo]
1598 } -cleanup {
1599         destroy .m1
1600 } -returnCodes ok -result {hello hello {}}
1601 test menu-3.47 {MenuWidgetCmd procedure, "post" option} -setup {
1602         destroy .m1
1603 } -body {
1604     menu .m1
1605     .m1 add command -label "On Windows, hit Escape to get this menu to go away"
1606     .m1 post
1607 } -cleanup {
1608         destroy .m1
1609 } -returnCodes error -result {wrong # args: should be ".m1 post x y ?index?"}
1610 test menu-3.48 {MenuWidgetCmd procedure, "post" option} -setup {
1611         destroy .m1
1612 } -body {
1613     menu .m1
1614     .m1 post foo 40
1615 } -cleanup {
1616         destroy .m1
1617 } -returnCodes error -result {expected integer but got "foo"}
1618 test menu-3.49 {MenuWidgetCmd procedure, "post" option} -setup {
1619         destroy .m1
1620 } -body {
1621     menu .m1
1622     .m1 post 40 bar
1623 } -cleanup {
1624         destroy .m1
1625 } -returnCodes error -result {expected integer but got "bar"}
1626 test menu-3.50 {MenuWidgetCmd procedure, "post" option} -constraints {
1627         nonUnixUserInteraction
1628 } -setup {
1629         destroy .m1
1630 } -body {
1631     menu .m1
1632     .m1 add command -label "menu-3.50: hit Escape" -command "puts hello"
1633     .m1 post 40 40
1634 } -cleanup {
1635         destroy .m1
1636 } -result {}
1637 test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} -setup {
1638         destroy .m1
1639 } -body {
1640     menu .m1
1641     .m1 postcascade
1642 } -cleanup {
1643         destroy .m1
1644 } -returnCodes error -result {wrong # args: should be ".m1 postcascade index"}
1645 test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} -setup {
1646         destroy .m1
1647 } -body {
1648     menu .m1
1649     .m1 postcascade foo
1650 } -cleanup {
1651         destroy .m1
1652 } -returnCodes error -result {bad menu entry index "foo"}
1653 test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} -constraints {
1654         nonUnixUserInteraction
1655 } -setup {
1656         destroy .m1 .m2
1657 } -body {
1658     menu .m1
1659     .m1 add command -label "menu-3.53 - hit Escape"
1660     menu .m2
1661     .m1 post 40 40
1662     .m1 add cascade -menu .m2
1663     .m1 postcascade 1
1664 } -cleanup {
1665         destroy .m1 .m2
1666 } -result {}
1667 test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} -setup {
1668         destroy .m1 .m2
1669 } -body {
1670     menu .m1
1671     menu .m2
1672     .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape"
1673     .m1 postcascade 1
1674     .m1 postcascade none
1675 } -cleanup {
1676         destroy .m1 .m2
1677 } -result {}
1678 test menu-3.55 {MenuWidgetCmd procedure, "type" option} -setup {
1679         destroy .m1
1680 } -body {
1681     menu .m1
1682     .m1 type
1683 } -cleanup {
1684         destroy .m1
1685 } -returnCodes error -result {wrong # args: should be ".m1 type index"}
1686 test menu-3.56 {MenuWidgetCmd procedure, "type" option} -setup {
1687         destroy .m1
1688 } -body {
1689     menu .m1
1690     .m1 type foo
1691 } -cleanup {
1692         destroy .m1
1693 } -returnCodes error -result {bad menu entry index "foo"}
1694 test menu-3.57 {MenuWidgetCmd procedure, "type" option} -setup {
1695         destroy .m1
1696 } -body {
1697     menu .m1
1698     .m1 add command -label "test"
1699     .m1 type 1
1700 } -cleanup {
1701         destroy .m1
1702 } -result {command}
1703 test menu-3.58 {MenuWidgetCmd procedure, "type" option} -setup {
1704         destroy .m1
1705 } -body {
1706     menu .m1
1707     .m1 add separator
1708     .m1 type 1
1709 } -cleanup {
1710         destroy .m1
1711 } -result {separator}
1712 test menu-3.59 {MenuWidgetCmd procedure, "type" option} -setup {
1713         destroy .m1
1714 } -body {
1715     menu .m1
1716     .m1 add checkbutton -label "test"
1717     .m1 type 1
1718 } -cleanup {
1719         destroy .m1
1720 } -result {checkbutton}
1721 test menu-3.60 {MenuWidgetCmd procedure, "type" option} -setup {
1722         destroy .m1
1723 } -body {
1724     menu .m1
1725     .m1 add radiobutton -label "test"
1726     .m1 type 1
1727 } -cleanup {
1728         destroy .m1
1729 } -result {radiobutton}
1730 test menu-3.61 {MenuWidgetCmd procedure, "type" option} -setup {
1731         destroy .m1
1732 } -body {
1733     menu .m1
1734     .m1 add cascade -label "test"
1735     .m1 type 1
1736 } -cleanup {
1737         destroy .m1
1738 } -result {cascade}
1739 test menu-3.62 {MenuWidgetCmd procedure, "type" option} -setup {
1740         destroy .m1
1741 } -body {
1742     menu .m1 -tearoff 1
1743     .m1 type 0
1744 } -cleanup {
1745         destroy .m1
1746 } -result {tearoff}
1747 test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} -setup {
1748         destroy .m1
1749 } -body {
1750     menu .m1
1751     .m1 unpost foo
1752 } -cleanup {
1753         destroy .m1
1754 } -returnCodes error -result {wrong # args: should be ".m1 unpost"}
1755 test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} -constraints {
1756         nonUnixUserInteraction
1757 } -setup {
1758         destroy .m1
1759 } -body {
1760     menu .m1
1761     .m1 add command -label "menu-3.64 - hit Escape"
1762     .m1 post 40 40
1763     .m1 unpost
1764 } -cleanup {
1765         destroy .m1
1766 } -result {}
1767 test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} -setup {
1768         destroy .m1
1769 } -body {
1770     menu .m1
1771     .m1 yposition
1772 } -cleanup {
1773         destroy .m1
1774 } -returnCodes error -result {wrong # args: should be ".m1 yposition index"}
1775 test menu-3.66a {MenuWidgetCmd procedure, "yposition" option, no tearoff} -setup {
1776         destroy .m1
1777 } -body {
1778     menu .m1 -tearoff 0
1779     .m1 yposition 1
1780 } -cleanup {
1781         destroy .m1
1782 } -result 0
1783 test menu-3.66b {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints {
1784     notAqua
1785 } -setup {
1786         destroy .m1
1787 } -body {
1788     # on Win or Linux, tearoff menus are supported
1789     # see menu-3.66c for aqua
1790     menu .m1 -tearoff 1
1791     .m1 yposition 1
1792 } -cleanup {
1793         destroy .m1
1794 } -result 1
1795 test menu-3.66c {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints {
1796     aqua
1797 } -setup {
1798         destroy .m1
1799 } -body {
1800     # on OS X, tearoff menus are not supported
1801     # see menu-3.66b for win or linux
1802     menu .m1 -tearoff 1
1803     .m1 yposition 1
1804 } -cleanup {
1805         destroy .m1
1806 } -result 0
1807 test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup {
1808         destroy .m1
1809 } -body {
1810     menu .m1
1811     .m1 foo
1812 } -cleanup {
1813         destroy .m1
1814 } -returnCodes error -result {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition}
1815 test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} -setup {
1816     deleteWindows
1817 } -body {
1818     set t .t
1819     set m1 .t.m1
1820     set c1 .t.c1
1821     set c2 .t.c2
1822     toplevel .t
1823     menu $m1 -tearoff 1
1824     menu $c1 -tearoff 1
1825     $c1 add command -label c1
1826     menu $c2 -tearoff 1
1827     $c2 add command -label c2
1828     $m1 add cascade -label c1 -menu $c1
1829     $t configure -menu $m1
1830     $m1 entryconfigure 1 -menu $c2 -label c2
1831     $t configure -menu ""
1832     list [winfo exists $c1] [winfo exists $c2]
1833 } -cleanup {
1834     deleteWindows
1835 } -result {1 1}
1836 test menu-3.69 {MenuWidgetCmd procedure, "xposition" option} -setup {
1837     destroy .m1
1838     menu .m1
1839 } -body {
1840     .m1 xposition
1841 } -cleanup {
1842     destroy .m1
1843 } -returnCodes error -result {wrong # args: should be ".m1 xposition index"}
1844 test menu-3.70 {MenuWidgetCmd procedure, "xposition" option} -setup {
1845     destroy .m1
1846     menu .m1
1847 } -body {
1848     .m1 xposition 1
1849     subst {} ;# just checking that the xposition does not produce an error...
1850 } -cleanup {
1851     destroy .m1
1852 } -result {}
1853
1854
1855 test menu-4.1 {TkInvokeMenu: disabled} -setup {
1856     destroy .m1
1857 } -body {
1858     catch {unset foo}
1859     menu .m1
1860     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \
1861         -state disabled
1862     list [catch {.m1 invoke 1} msg] $foo
1863 } -cleanup {
1864     destroy .m1
1865 } -result {0 off}
1866 test menu-4.2 {TkInvokeMenu: tearoff} -setup {
1867     destroy .m1
1868 } -body {
1869     menu .m1
1870         catch {.m1 invoke 0}
1871 } -cleanup {
1872     deleteWindows
1873 } -result 0
1874 test menu-4.3 {TkInvokeMenu: checkbutton -on} -setup {
1875     destroy .m1
1876 } -body {
1877     catch {unset foo}
1878     menu .m1
1879     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
1880     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 \
1881                 [catch {unset foo} msg3] $msg3
1882 } -cleanup {
1883     destroy .m1
1884 } -result {0 {} 0 on 0 {}}
1885 test menu-4.4 {TkInvokeMenu: checkbutton -off} -setup {
1886     destroy .m1
1887 } -body {
1888     catch {unset foo}
1889     menu .m1
1890     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
1891     .m1 invoke 1
1892     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3
1893 } -cleanup {
1894     destroy .m1
1895 } -result {0 {} 0 off 0 {}}
1896 test menu-4.5 {TkInvokeMenu: checkbutton array element} -setup {
1897     destroy .m1
1898 } -body {
1899     catch {unset foo}
1900     menu .m1
1901     .m1 add checkbutton -label "test" -variable foo(1) -onvalue on
1902     list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3
1903 } -cleanup {
1904         destroy .m1
1905 } -result {0 {} 0 on 0 {}}
1906 test menu-4.6 {TkInvokeMenu: radiobutton} -setup {
1907     destroy .m1
1908 } -body {
1909     catch {unset foo}
1910     menu .m1 -tearoff 1
1911     .m1 add radiobutton -label "1" -variable foo -value one
1912     .m1 add radiobutton -label "2" -variable foo -value two
1913     .m1 add radiobutton -label "3" -variable foo -value three
1914     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3
1915 } -cleanup {
1916         destroy .m1
1917 } -result {0 {} 0 one 0 {}}
1918 test menu-4.7 {TkInvokeMenu: radiobutton} -setup {
1919     destroy .m1
1920 } -body {
1921     catch {unset foo}
1922     menu .m1 -tearoff 1
1923     .m1 add radiobutton -label "1" -variable foo -value one
1924     .m1 add radiobutton -label "2" -variable foo -value two
1925     .m1 add radiobutton -label "3" -variable foo -value three
1926     list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3
1927 } -cleanup {
1928         destroy .m1
1929 } -result {0 {} 0 two 0 {}}
1930 test menu-4.8 {TkInvokeMenu: radiobutton} -setup {
1931     destroy .m1
1932 } -body {
1933     catch {unset foo}
1934     menu .m1
1935     .m1 add radiobutton -label "1" -variable foo -value one
1936     .m1 add radiobutton -label "2" -variable foo -value two
1937     .m1 add radiobutton -label "3" -variable foo -value three
1938     list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3
1939 } -cleanup {
1940         destroy .m1
1941 } -result {0 {} 0 three 0 {}}
1942 test menu-4.9 {TkInvokeMenu: radiobutton array element} -setup {
1943     destroy .m1
1944 } -body {
1945     catch {unset foo}
1946     menu .m1
1947     .m1 add radiobutton -label "1" -variable foo(2) -value one
1948     .m1 add radiobutton -label "2" -variable foo(2) -value two
1949     .m1 add radiobutton -label "3" -variable foo(2) -value three
1950     list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3
1951 } -cleanup {
1952         destroy .m1
1953 } -result {0 {} 0 three 0 {}}
1954 test menu-4.10 {TkInvokeMenu} -setup {
1955     destroy .m1
1956 } -body {
1957     catch {unset foo}
1958     menu .m1
1959     .m1 add command -label "test" -command "set menu_test menu-4.8"
1960     list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3
1961 } -cleanup {
1962         destroy .m1
1963 } -result {0 menu-4.8 0 menu-4.8 0 {}}
1964 test menu-4.11 {TkInvokeMenu} -setup {
1965     destroy .m1
1966 } -body {
1967     menu .m1
1968     .m1 add cascade -label "test" -menu .m1.m2
1969     list [catch {.m1 invoke 1} msg] $msg
1970 } -cleanup {
1971         destroy .m1
1972 } -result {0 {}}
1973 test menu-4.12 {TkInvokeMenu} -setup {
1974     destroy .m1
1975 } -body {
1976     menu .m1 -tearoff 1
1977     .m1 add command -label "test" -command ".m1 delete 1"
1978     list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2
1979 } -cleanup {
1980         destroy .m1
1981 } -result {0 {} 1 {bad menu entry index "test"}}
1982
1983 test menu-5.1 {DestroyMenuInstance} -setup {
1984     destroy .m1
1985 } -body {
1986     menu .m1
1987     destroy .m1
1988 } -returnCodes ok
1989 test menu-5.2 {DestroyMenuInstance - cascade menu} -setup {
1990     destroy .m1 .m2
1991 } -body {
1992     menu .m1
1993     .m1 add cascade -menu .m2
1994     menu .m2
1995     destroy .m1 .m2
1996 } -returnCodes ok
1997 test menu-5.3 {DestroyMenuInstance - multiple cascade parents} -setup {
1998     destroy .m1 .m2 .m3
1999 } -body {
2000     menu .m1
2001     .m1 add cascade -menu .m3
2002     menu .m2
2003     .m2 add cascade -menu .m3
2004     menu .m3
2005     list [destroy .m3] [destroy .m1 .m2]
2006 } -returnCodes ok -result {{} {}}
2007 test menu-5.4 {DestroyMenuInstance - multiple cascade parents} -setup {
2008     destroy .m1 .m2 .m3 .m4
2009 } -body {
2010     menu .m1
2011     .m1 add cascade -menu .m4
2012     menu .m2
2013     .m2 add cascade -menu .m4
2014     menu .m3
2015     .m3 add cascade -menu .m4
2016     menu .m4
2017     list [destroy .m4] [destroy .m1 .m2 .m3]
2018 } -returnCodes ok -result {{} {}}
2019 test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} -setup {
2020     destroy .m1 .m2
2021 } -body {
2022     menu .m1
2023     menu .m2
2024     .m1 add cascade -menu .m2
2025     . configure -menu .m1
2026     list [destroy .m2] [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1]
2027 } -returnCodes ok -result {{} .m2 {} {}}
2028 test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} -setup {
2029     deleteWindows
2030 } -body {
2031     menu .m1
2032     .m1 add cascade -menu .m2
2033     menu .m2
2034     . configure -menu .m1
2035     toplevel .t2
2036     wm geometry .t2 +0+0
2037     .t2 configure -menu .m1
2038     list [destroy .m2] [. configure -menu ""] [destroy .t2 .m1]
2039 } -returnCodes ok -result {{} {} {}}
2040 test menu-5.7 {DestroyMenuInstance - basic clones} -setup {
2041     destroy .m1
2042 } -body {
2043     menu .m1
2044     set tearoff [tk::TearOffMenu .m1]
2045     list [destroy $tearoff] [destroy .m1]
2046 } -result {{} {}}
2047 test menu-5.8 {DestroyMenuInstance - multiple clones} -setup {
2048     destroy .m1
2049 } -body {
2050     menu .m1
2051     set tearoff1 [tk::TearOffMenu .m1]
2052     set tearoff2 [tk::TearOffMenu .m1]
2053     list [destroy $tearoff1] [destroy .m1]
2054 } -returnCodes ok -result {{} {}}
2055 test menu-5.9 {DestroyMenuInstace - main menu} -setup {
2056     destroy .m1
2057 } -body {
2058     menu .m1
2059     tk::TearOffMenu .m1
2060     destroy .m1
2061 } -returnCodes ok
2062 test menu-5.10 {DestroyMenuInstance - freeing entries} -setup {
2063     destroy .m1
2064 } -body {
2065     menu .m1
2066     .m1 add command -label "foo"
2067     destroy .m1
2068 } -returnCodes ok
2069 test menu-5.11 {DestroyMenuInstace - no entries} -setup {
2070     destroy .m1
2071 } -body {
2072     menu .m1
2073     .m1 configure -tearoff 0
2074     destroy .m1
2075 } -returnCodes ok
2076 test menu-5.12 {DestroyMenuInstance - platform data} -setup {
2077     destroy .m1
2078 } -body {
2079     menu .m1
2080     destroy .m1
2081 } -returnCodes ok
2082 test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} -setup {
2083     destroy .m1 .m2
2084 } -body {
2085     menu .m1
2086     menu .m2
2087     .m1 add cascade -menu .m2
2088     set tearoff [tk::TearOffMenu .m1 40 40]
2089     list [destroy .m2] [destroy .m1]
2090 } -result {{} {}}
2091
2092
2093 test menu-6.1 {TkDestroyMenu} -setup {
2094     destroy .m1
2095 } -body {
2096     menu .m1
2097     destroy .m1
2098 } -returnCodes ok
2099 test menu-6.2 {TkDestroyMenu - reentrancy} -setup {
2100     destroy .m1 .m2
2101 } -body {
2102     menu .m1
2103     bind .m1 <Destroy> {destroy .m1}
2104     menu .m2
2105     bind .m2 <Destroy> {destroy .m2}
2106     list [destroy .m1] [destroy .m2]
2107 } -returnCodes ok -result {{} {}}
2108 test menu-6.3 {TkDestroyMenu - reentrancy} -setup {
2109     destroy .m1 .m2 .m3
2110 } -body {
2111     menu .m1
2112     bind .m1 <Destroy> {destroy .m2}
2113     .m1 clone .m2
2114     .m1 clone .m3
2115     list [destroy .m1] [winfo exists .m2]
2116 } -returnCodes ok -result {{} 0}
2117 test menu-6.4 {TkDestroyMenu - reentrancy - clones} -setup {
2118     destroy .m1 .m2
2119 } -body {
2120     menu .m1
2121     .m1 clone .m2
2122     .m1 clone .m1.m3
2123     destroy .m1
2124 } -cleanup {
2125     deleteWindows
2126 } -returnCodes ok
2127 test menu-6.5 {TkDestroyMenu} -setup {
2128     destroy .m1 .m2
2129 } -body {
2130     menu .m1
2131     .m1 clone .m2
2132     destroy .m1
2133     winfo exists .m2
2134 } -result 0
2135 test menu-6.6 {TkDestroyMenu} -setup {
2136     destroy .m1 .m2
2137 } -body {
2138     menu .m1
2139     .m1 clone .m2 tearoff
2140     destroy .m1
2141 } -result {}
2142 test menu-6.7 {TkDestroyMenu} -setup {
2143     destroy .m1 .m2
2144 } -body {
2145     menu .m1
2146     .m1 clone .m2
2147     destroy .m2
2148     destroy .m1
2149 } -returnCodes ok -result {}
2150 test menu-6.8 {TkDestroyMenu} -setup {
2151     destroy .m1 .m2 .m3
2152 } -body {
2153     menu .m1
2154     .m1 clone .m2
2155     .m1 clone .m3
2156     destroy .m1
2157     list [winfo exists .m2] [winfo exists .m3]
2158 } -result {0 0}
2159 test menu-6.9 {TkDestroyMenu} -setup {
2160     deleteWindows
2161 } -body {
2162     menu .m1
2163     .m1 clone .m2
2164     .m1 clone .m3
2165         list [destroy .m2] [destroy .m3] [destroy .m1]
2166 } -returnCodes ok -result {{} {} {}}
2167 test menu-6.10 {TkDestroyMenu} -setup {
2168     deleteWindows
2169 } -body {
2170     menu .m1
2171     .m1 clone .m2
2172     .m1 clone .m3
2173         list [destroy .m3] [destroy .m1]
2174 } -returnCodes ok -result {{} {}}
2175 test menu-6.11 {TkDestroyMenu} -setup {
2176     deleteWindows
2177 } -body {
2178     menu .m1
2179     .m1 clone .m2
2180     .m1 clone .m3
2181     .m1 clone .m4
2182         list [destroy .m2] [destroy .m1]
2183 } -returnCodes ok -result {{} {}}
2184 test menu-6.12 {TkDestroyMenu} -setup {
2185     deleteWindows
2186 } -body {
2187     menu .m1
2188     .m1 clone .m2
2189     .m1 clone .m3
2190     .m1 clone .m4
2191         list [destroy .m3] [destroy .m1]
2192 } -returnCodes ok -result {{} {}}
2193 test menu-6.13 {TkDestroyMenu} -setup {
2194     deleteWindows
2195 } -body {
2196     menu .m1
2197     .m1 clone .m2
2198     .m1 clone .m3
2199     .m1 clone .m4
2200         list [destroy .m4] [destroy .m1]
2201 } -returnCodes ok -result {{} {}}
2202 test menu-6.14 {TkDestroyMenu} -setup {
2203         destroy .m1
2204 } -body {
2205     menu .m1
2206     . configure -menu .m1
2207     list [destroy .m1] [. configure -menu ""]
2208 } -returnCodes ok -result {{} {}}
2209 test menu-6.15 {TkDestroyMenu} -setup {
2210     deleteWindows
2211 } -body {
2212     menu .m1
2213     toplevel .t2
2214     wm geometry .t2 +0+0
2215     . configure -menu .m1
2216     .t2 configure -menu .m1
2217     list [destroy .m1] [destroy .t2] [. configure -menu ""]
2218 } -result {{} {} {}}
2219 test menu-6.16 {TkDestroyMenu} -setup {
2220     deleteWindows
2221 } -body {
2222     menu .m1
2223     toplevel .t2
2224     wm geometry .t2 +0+0
2225     toplevel .t3
2226     wm geometry .t3 +0+0
2227     . configure -menu .m1
2228     .t2 configure -menu .m1
2229     .t3 configure -menu .m1
2230     list [destroy .m1] [destroy .t2] [destroy .t3] [. configure -menu ""]
2231 } -result {{} {} {} {}}
2232
2233 test menu-7.1 {UnhookCascadeEntry} -setup {
2234     deleteWindows
2235 } -body {
2236     menu .m1
2237     .m1 add command -label "test"
2238     destroy .m1
2239 } -returnCodes ok
2240 test menu-7.2 {UnhookCascadeEntry} -setup {
2241     destroy .m1
2242 } -body {
2243     menu .m1
2244     .m1 add cascade -menu .m2
2245     destroy .m1
2246 } -returnCodes ok
2247 test menu-7.3 {UnhookCascadeEntry} -setup {
2248     deleteWindows
2249 } -body {
2250     menu .m1
2251     menu .m2
2252     .m2 add cascade -menu .cascade
2253     .m1 add cascade -menu .cascade
2254     list [destroy .m1] [destroy .m2]
2255 } -returnCodes ok -result {{} {}}
2256 test menu-7.4 {UnhookCascadeEntry} -setup {
2257     deleteWindows
2258 } -body {
2259     menu .m1
2260     menu .m2
2261     .m1 add cascade -menu .cascade
2262     .m2 add cascade -menu .cascade
2263     list [destroy .m1] [destroy .m2]
2264 } -returnCodes ok -result {{} {}}
2265 test menu-7.5 {UnhookCascadeEntry} -setup {
2266     deleteWindows
2267 } -body {
2268     menu .m1
2269     menu .m2
2270     menu .m3
2271     .m1 add cascade -menu .cascade
2272     .m2 add cascade -menu .cascade
2273     .m3 add cascade -menu .cascade
2274     list [destroy .m1] [destroy .m2 .m3]
2275 } -returnCodes ok -result {{} {}}
2276 test menu-7.6 {UnhookCascadeEntry} -setup {
2277     deleteWindows
2278 } -body {
2279     menu .m1
2280     menu .m2
2281     menu .m3
2282     .m1 add cascade -menu .cascade
2283     .m2 add cascade -menu .cascade
2284     .m3 add cascade -menu .cascade
2285     list [destroy .m2] [destroy .m1 .m3]
2286 } -returnCodes ok -result {{} {}}
2287 test menu-7.7 {UnhookCascadeEntry} -setup {
2288     deleteWindows
2289 } -body {
2290     menu .m1
2291     menu .m2
2292     menu .m3
2293     .m1 add cascade -menu .cascade
2294     .m2 add cascade -menu .cascade
2295     .m3 add cascade -menu .cascade
2296     list [destroy .m3] [destroy .m1 .m2]
2297 } -returnCodes ok -result {{} {}}
2298 test menu-7.8 {UnhookCascadeEntry} -setup {
2299     deleteWindows
2300 } -body {
2301     menu .m1
2302     menu .m2
2303     .m1 add cascade -menu .m2
2304     list [destroy .m1] [destroy .m2]
2305 } -returnCodes ok -result {{} {}}
2306 test menu-7.9 {UnhookCascadeEntry} -setup {
2307     deleteWindows
2308 } -body {
2309     menu .m1
2310     menu .m2
2311     .m1 add cascade -menu .m2
2312     destroy .m1
2313     destroy .m2
2314 } -returnCodes ok
2315
2316 test menu-8.1 {DestroyMenuEntry} -setup {
2317     deleteWindows
2318 } -body {
2319     menu .m1
2320     menu .m2
2321     .m1 add cascade -menu .m2
2322     list [.m1 delete 1] [destroy .m1 .m2]
2323 } -result {{} {}}
2324 test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup {
2325     deleteWindows
2326     catch {image delete image1a}
2327 } -body {
2328     image create photo image1a -file $earthPhotoFile
2329     menu .m1
2330     .m1 add command -image image1a
2331     list [.m1 delete 1] [destroy .m1] [image delete image1a]
2332 } -result {{} {} {}}
2333 test menu-8.3 {DestroyMenuEntry} -constraints testImageType -setup {
2334     deleteWindows
2335     imageCleanup
2336 } -body {
2337     image create test image1
2338     image create test image2
2339     menu .m1
2340     .m1 add checkbutton -image image1 -selectimage image2
2341     .m1 invoke 1
2342     list [.m1 delete 1] [destroy .m1]
2343 } -cleanup {
2344     imageCleanup
2345     deleteWindows
2346 } -result {{} {}}
2347 test menu-8.4 {DestroyMenuEntry} -setup {
2348     destroy .m1
2349 } -body {
2350     menu .m1
2351     .m1 add checkbutton -variable foo
2352     list [.m1 delete 1] [destroy .m1]
2353 } -result {{} {}}
2354 test menu-8.5 {DestroyMenuEntry} -setup {
2355     destroy .m1
2356 } -body {
2357     menu .m1
2358     .m1 add command -label "test"
2359     list [.m1 delete 1] [destroy .m1]
2360 } -result {{} {}}
2361 test menu-8.6 {DestroyMenuEntry} -setup {
2362     destroy .m1
2363 } -body {
2364     menu .m1 -tearoff 1
2365     .m1 add command -label "one"
2366     .m1 add command -label "two"
2367     list [.m1 delete 1] [.m1 entrycget 1 -label] [destroy .m1]
2368 } -result {{} two {}}
2369 test menu-8.7 {DestroyMenuEntry} -setup {
2370     deleteWindows
2371 } -body {
2372     menu .m1
2373     .m1 add command -label "one"
2374     .m1 clone .m2 tearoff
2375     list [.m2 delete 1] [destroy .m1]
2376 } -result {{} {}}
2377
2378
2379 # test menu-9 - Can only change when fonts change on system, which cannot
2380 # be done from tcl.
2381 test menu-9.1 {ConfigureMenu} -setup {
2382     destroy .m1
2383 } -body {
2384     menu .m1
2385     list [.m1 configure -postcommand "beep"] [.m1 cget -postcommand]
2386 } -cleanup {
2387     deleteWindows
2388 } -result {{} beep}
2389 test menu-9.2 {ConfigureMenu}  -setup {
2390     destroy .m1
2391 } -body {
2392     menu .m1
2393     .m1 add command -label "test"
2394     list [.m1 configure -tearoff 0] [.m1 entrycget 1 -label]
2395 } -cleanup {
2396     deleteWindows
2397 } -result {{} test}
2398 test menu-9.3 {ConfigureMenu}  -setup {
2399     destroy .m1
2400 } -body {
2401     menu .m1
2402     list [.m1 configure -postcommand "beep"] [.m1 cget -postcommand]
2403 } -cleanup {
2404     deleteWindows
2405 } -result {{} beep}
2406 test menu-9.4 {ConfigureMenu}  -setup {
2407     destroy .m1
2408 } -body {
2409     menu .m1
2410     .m1 add command -label "test"
2411     .m1 configure -fg red
2412 } -cleanup {
2413     deleteWindows
2414 } -result {}
2415 test menu-9.5 {ConfigureMenu}  -setup {
2416     destroy .m1
2417 } -body {
2418     menu .m1
2419     .m1 add command -label "test"
2420     .m1 add command -label "two"
2421     .m1 configure -fg red
2422 } -cleanup {
2423     deleteWindows
2424 } -result {}
2425 test menu-9.6 {ConfigureMenu}  -setup {
2426     destroy .m1
2427 } -body {
2428     menu .m1
2429     .m1 add command -label "test"
2430     .m1 add command -label "two"
2431     .m1 add command -label "three"
2432     .m1 configure -fg red
2433 } -cleanup {
2434     deleteWindows
2435 } -result {}
2436 test menu-9.7 {ConfigureMenu} -setup {
2437     deleteWindows
2438 } -body {
2439     menu .m1
2440     .m1 clone .m2 tearoff
2441     list [.m1 configure -fg red] [.m2 cget -fg]
2442 } -cleanup {
2443     deleteWindows
2444 } -result {{} red}
2445 test menu-9.8 {ConfigureMenu} -setup {
2446     deleteWindows
2447 } -body {
2448     menu .m1
2449     .m1 clone .m2 tearoff
2450     list [.m2 configure -fg red] [.m1 cget -fg]
2451 } -cleanup {
2452     deleteWindows
2453 } -result {{} red}
2454 test menu-9.9 {ConfigureMenu}  -setup {
2455     destroy .m1
2456 } -body {
2457     menu .m1
2458     list [. configure -menu .m1] [. configure -menu ""]
2459 } -cleanup {
2460     deleteWindows
2461 } -result {{} {}}
2462
2463
2464 test menu-10.1 {PostProcessEntry: array variable} -setup {
2465     destroy .m1
2466 } -body {
2467     catch {unset foo}
2468     menu .m1
2469     set foo(1) on
2470     .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
2471     set foo(1)
2472 } -cleanup {
2473     deleteWindows
2474 } -result {on}
2475 test menu-10.2 {PostProcessEntry: array variable} -setup {
2476     destroy .m1
2477 } -body {
2478     catch {unset foo}
2479     menu .m1
2480     .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
2481     set foo(1)
2482 } -cleanup {
2483     deleteWindows
2484 } -result {off}
2485
2486
2487 test menu-11.1 {ConfigureMenuEntry} -setup {
2488     destroy .m1
2489 } -body {
2490     catch {unset foo}
2491     menu .m1
2492     .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
2493     list [.m1 entryconfigure 1 -variable bar] [.m1 entrycget 1 -variable]
2494 } -cleanup {
2495     deleteWindows
2496 } -result {{} bar}
2497 test menu-11.2 {ConfigureMenuEntry} -setup {
2498     destroy .m1
2499 } -body {
2500     menu .m1
2501     .m1 add command -label "test"
2502     list [.m1 entryconfigure 1 -label ""] [.m1 entrycget 1 -label]
2503 } -cleanup {
2504     deleteWindows
2505 } -result {{} {}}
2506 test menu-11.3 {ConfigureMenuEntry} -setup {
2507     destroy .m1
2508 } -body {
2509     menu .m1
2510     .m1 add command
2511     list [.m1 entryconfigure 1 -label "test"] [.m1 entrycget 1 -label]
2512 } -cleanup {
2513     deleteWindows
2514 } -result {{} test}
2515 test menu-11.4 {ConfigureMenuEntry} -setup {
2516     deleteWindows
2517 } -body {
2518     menu .m1
2519     .m1 add command
2520     list [.m1 entryconfigure 1 -accel "S"] [.m1 entrycget 1 -accel]
2521 } -cleanup {
2522     deleteWindows
2523 } -result {{} S}
2524 test menu-11.5 {ConfigureMenuEntry} -setup {
2525     deleteWindows
2526 } -body {
2527     menu .m1
2528     .m1 add command
2529     list [.m1 entryconfigure 1 -label "test"] [.m1 entrycget 1 -label]
2530 } -cleanup {
2531     deleteWindows
2532 } -result {{} test}
2533 test menu-11.6 {ConfigureMenuEntry} -setup {
2534     deleteWindows
2535 } -body {
2536     menu .m1
2537     .m1 add command
2538     .m1 entryconfigure 1 -label "test"
2539 } -cleanup {
2540     deleteWindows
2541 } -result {}
2542 test menu-11.7 {ConfigureMenuEntry} -setup {
2543     deleteWindows
2544 } -body {
2545     menu .m2
2546     menu .m1
2547     .m1 add cascade
2548     .m1 entryconfigure 1 -label "test" -menu .m2
2549 } -cleanup {
2550     deleteWindows
2551 } -result {}
2552 test menu-11.8 {ConfigureMenuEntry} -setup {
2553     deleteWindows
2554 } -body {
2555     menu .m1
2556     .m1 add cascade
2557     .m1 entryconfigure 1 -label "test" -menu .m2
2558 } -cleanup {
2559     deleteWindows
2560 } -result {}
2561 test menu-11.9 {ConfigureMenuEntry} -setup {
2562     deleteWindows
2563 } -body {
2564     menu .m1
2565     .m1 add cascade -menu .m3
2566     .m1 entryconfigure 1 -label "test" -menu .m2
2567 } -cleanup {
2568     deleteWindows
2569 } -result {}
2570 test menu-11.10 {ConfigureMenuEntry} -setup {
2571     deleteWindows
2572 } -body {
2573     menu .m1
2574     .m1 add cascade
2575     .m1 entryconfigure 1 -label "test" -menu .m2
2576 } -cleanup {
2577     deleteWindows
2578 } -result {}
2579 test menu-11.11 {ConfigureMenuEntry} -setup {
2580     deleteWindows
2581 } -body {
2582     menu .m1
2583     .m1 add cascade -menu .m2
2584     .m1 entryconfigure 1 -label "test" -menu .m2
2585 } -cleanup {
2586     deleteWindows
2587 } -result {}
2588 test menu-11.12 {ConfigureMenuEntry} -setup {
2589     deleteWindows
2590 } -body {
2591     menu .m1
2592     menu .m2
2593     .m2 add cascade -menu .m1
2594     menu .m3
2595     .m3 add cascade -menu .m1
2596     menu .m4
2597     .m4 add cascade -menu .m1
2598     menu .m5
2599     .m5 add cascade
2600     .m5 entryconfigure 1 -label "test" -menu .m1
2601 } -cleanup {
2602     deleteWindows
2603 } -result {}
2604 test menu-11.13 {ConfigureMenuEntry} -setup {
2605     deleteWindows
2606 } -body {
2607     menu .m1
2608     menu .m2
2609     .m2 add cascade -menu .m1
2610     menu .m3
2611     .m3 add cascade -menu .m1
2612     menu .m4
2613     .m4 add cascade -menu .m1
2614     .m3 entryconfigure 1 -label "test" -menu .m1
2615 } -cleanup {
2616     deleteWindows
2617 } -result {}
2618 test menu-11.14 {ConfigureMenuEntry} -setup {
2619     deleteWindows
2620 } -body {
2621     menu .m1
2622     .m1 add checkbutton
2623     list [.m1 entryconfigure 1 -variable "test"] [.m1 entrycget 1 -variable]
2624 } -cleanup {
2625     deleteWindows
2626 } -result {{} test}
2627 test menu-11.15 {ConfigureMenuEntry} -setup {
2628     deleteWindows
2629 } -body {
2630     menu .m1
2631     list [.m1 add checkbutton -label "test"] [.m1 entrycget 1 -variable]
2632 } -cleanup {
2633     deleteWindows
2634 } -result {{} test}
2635 test menu-11.16 {ConfigureMenuEntry} -setup {
2636     deleteWindows
2637 } -body {
2638     menu .m1
2639     .m1 add radiobutton -label "test"
2640 } -cleanup {
2641     deleteWindows
2642 } -result {}
2643 test menu-11.17 {ConfigureMenuEntry} -setup {
2644     deleteWindows
2645 } -body {
2646     menu .m1
2647     .m1 add checkbutton
2648     list [.m1 entryconfigure 1 -onvalue "test"] [.m1 entrycget 1 -onvalue]
2649 } -cleanup {
2650     deleteWindows
2651 } -result {{} test}
2652 test menu-11.18 {ConfigureMenuEntry} -constraints testImageType -setup {
2653     deleteWindows
2654     imageCleanup
2655 } -body {
2656     menu .m1
2657     .m1 add command
2658     image create test image1
2659     .m1 entryconfigure 1 -image image1
2660 } -cleanup {
2661     deleteWindows
2662     imageCleanup
2663 } -result {}
2664 test menu-11.19 {ConfigureMenuEntry} -constraints {
2665     testImageType hasEarthPhoto
2666 } -setup {
2667     deleteWindows
2668     imageCleanup
2669 } -body {
2670     image create test image1
2671     image create photo image2 -file $earthPhotoFile
2672     menu .m1
2673     .m1 add command -image image1
2674     .m1 entryconfigure 1 -image image2
2675 } -cleanup {
2676     deleteWindows
2677     imageCleanup
2678 } -result {}
2679 test menu-11.20 {ConfigureMenuEntry} -constraints {
2680     testImageType hasEarthPhoto
2681 } -setup {
2682     deleteWindows
2683     imageCleanup
2684 } -body {
2685     image create photo image1 -file $earthPhotoFile
2686     image create test image2
2687     menu .m1
2688     .m1 add checkbutton -image image1
2689     .m1 entryconfigure 1 -selectimage image2
2690 } -cleanup {
2691     deleteWindows
2692     imageCleanup
2693 } -result {}
2694 test menu-11.21 {ConfigureMenuEntry} -constraints {
2695     testImageType hasEarthPhoto
2696 } -setup {
2697     deleteWindows
2698     imageCleanup
2699 } -body {
2700     image create photo image1 -file $earthPhotoFile
2701     image create test image2
2702     image create test image3
2703     menu .m1
2704     .m1 add checkbutton -image image1 -selectimage image2
2705     .m1 entryconfigure 1 -selectimage image3
2706 } -cleanup {
2707     deleteWindows
2708     imageCleanup
2709 } -result {}
2710
2711
2712 test menu-12.1 {ConfigureMenuCloneEntries} -setup {
2713     deleteWindows
2714 } -body {
2715     menu .m1
2716     .m1 clone .m2
2717     .m2 configure -tearoff 0
2718     .m1 clone .m3
2719     .m1 add command -label "test"
2720     .m1 add command -label "test2"
2721     .m1 entryconfigure 1 -gork "foo"
2722 } -cleanup {
2723     deleteWindows
2724 } -returnCodes error -result {unknown option "-gork"}
2725 test menu-12.2 {ConfigureMenuCloneEntries} -setup {
2726     deleteWindows
2727 } -body {
2728     menu .m1
2729     .m1 clone .m2
2730     menu .m3
2731     .m1 add cascade -menu .m3
2732     menu .m4
2733     .m1 entryconfigure 1 -menu .m4
2734 } -cleanup {
2735     deleteWindows
2736 } -result {}
2737 test menu-12.3 {ConfigureMenuCloneEntries} -setup {
2738     deleteWindows
2739 } -body {
2740     menu .m1
2741     .m1 clone .m2
2742     .m1 add cascade -label dummy
2743     .m1 entryconfigure dummy -menu .m3
2744 } -cleanup {
2745     deleteWindows
2746 } -result {}
2747 test menu-12.4 {ConfigureMenuCloneEntries} -setup {
2748     deleteWindows
2749 } -body {
2750      menu .m1
2751      .m1 add cascade -label File -menu .m1.foo
2752      menu .m1.foo
2753      .m1.foo add command -label bar
2754      .m1 clone .m2
2755      .m1 entryconfigure File -state disabled
2756 } -cleanup {
2757     deleteWindows
2758 } -result {}
2759
2760
2761 test menu-13.1 {TkGetMenuIndex} -setup {
2762     deleteWindows
2763 } -body {
2764     menu .m1 -tearoff 1
2765     .m1 add command -label "active"
2766     .m1 add command -label "test2"
2767     .m1 add command -label "test3"
2768     .m1 activate 2
2769     .m1 entrycget active -label
2770 } -cleanup {
2771     deleteWindows
2772 } -result {test2}
2773 test menu-13.2 {TkGetMenuIndex} -setup {
2774     deleteWindows
2775 } -body {
2776     menu .m1
2777     .m1 add command -label "last"
2778     .m1 add command -label "test2"
2779     .m1 add command -label "test3"
2780     .m1 activate 2
2781     .m1 entrycget last -label
2782 } -cleanup {
2783     deleteWindows
2784 } -result {test3}
2785 test menu-13.3 {TkGetMenuIndex} -setup {
2786     deleteWindows
2787 } -body {
2788     menu .m1
2789     .m1 add command -label "last"
2790     .m1 add command -label "test2"
2791     .m1 add command -label "test3"
2792     .m1 activate 2
2793     .m1 entrycget end -label
2794 } -cleanup {
2795     deleteWindows
2796 } -result {test3}
2797 test menu-13.4 {TkGetMenuIndex} -setup {
2798     deleteWindows
2799 } -body {
2800     menu .m1
2801     .m1 add command -label "test"
2802     list [.m1 insert last command -label "test2"] [.m1 entrycget last -label]
2803 } -cleanup {
2804     deleteWindows
2805 } -result {{} test2}
2806 test menu-13.5 {TkGetMenuIndex} -setup {
2807     deleteWindows
2808 } -body {
2809     menu .m1
2810     .m1 add command -label "test"
2811     list [.m1 insert end command -label "test2"] [.m1 entrycget end -label]
2812 } -cleanup {
2813     deleteWindows
2814 } -result {{} test2}
2815 test menu-13.6 {TkGetMenuIndex} -setup {
2816     deleteWindows
2817 } -body {
2818     menu .m1
2819     .m1 add command -label "active"
2820     .m1 add command -label "test2"
2821     .m1 add command -label "test3"
2822     .m1 activate 2
2823     .m1 entrycget none -label
2824 } -cleanup {
2825     deleteWindows
2826 } -result {}
2827 #test menu-13.7 - Need to add @test here.
2828 test menu-13.7 {TkGetMenuIndex} -setup {
2829     deleteWindows
2830 } -body {
2831     menu .m1 -tearoff 1
2832     .m1 add command -label "active"
2833     .m1 add command -label "test2"
2834     .m1 add command -label "test3"
2835     .m1 entrycget 1 -label
2836 } -cleanup {
2837     deleteWindows
2838 } -result {active}
2839 test menu-13.8 {TkGetMenuIndex} -setup {
2840     deleteWindows
2841 } -body {
2842     menu .m1
2843     .m1 add command -label "active"
2844     .m1 entrycget -1 -label
2845 } -returnCodes error -result {bad menu entry index "-1"}
2846 test menu-13.9 {TkGetMenuIndex} -setup {
2847     deleteWindows
2848 } -body {
2849     menu .m1
2850     .m1 add command -label "test"
2851     .m1 add command -label "test2"
2852     .m1 entrycget 999 -label
2853 } -cleanup {
2854     deleteWindows
2855 } -result {test2}
2856 test menu-13.10 {TkGetMenuIndex} -setup {
2857     deleteWindows
2858 } -body {
2859     menu .m1
2860     .m1 insert 999 command -label "test"
2861     .m1 entrycget 1 -label
2862 } -cleanup {
2863     deleteWindows
2864 } -result {test}
2865 test menu-13.11 {TkGetMenuIndex} -setup {
2866     deleteWindows
2867 } -body {
2868     menu .m1
2869     .m1 add command -label "1test"
2870     .m1 entrycget 1test -label
2871 } -cleanup {
2872     deleteWindows
2873 } -result {1test}
2874 test menu-13.12 {TkGetMenuIndex} -setup {
2875     deleteWindows
2876 } -body {
2877     menu .m1
2878     .m1 add command -label "test"
2879     .m1 add command -label "test2" -command "beep"
2880     .m1 add command -label "test3"
2881     .m1 entrycget test2 -command
2882 } -cleanup {
2883     deleteWindows
2884 } -result {beep}
2885
2886 test menu-14.1 {MenuCmdDeletedProc} -setup {
2887     deleteWindows
2888 } -body {
2889     menu .m1
2890     destroy .m1
2891 } -cleanup {
2892     deleteWindows
2893 } -returnCodes ok
2894 test menu-14.2 {MenuCmdDeletedProc} -setup {
2895     deleteWindows
2896 } -body {
2897     menu .m1
2898     .m1 clone .m2
2899     destroy .m1
2900 } -cleanup {
2901     deleteWindows
2902 } -returnCodes ok
2903
2904 test menu-15.1 {MenuNewEntry} -setup {
2905     deleteWindows
2906 } -body {
2907     menu .m1
2908     .m1 add command -label "test"
2909 } -cleanup {
2910     deleteWindows
2911 } -result {}
2912 test menu-15.2 {MenuNewEntry} -setup {
2913     deleteWindows
2914 } -body {
2915     menu .m1
2916     .m1 add command -label "test"
2917     .m1 add command -label "test3"
2918     .m1 insert 2 command -label "test2"
2919 } -cleanup {
2920     deleteWindows
2921 } -result {}
2922 test menu-15.3 {MenuNewEntry} -setup {
2923     deleteWindows
2924 } -body {
2925     menu .m1
2926     .m1 add command -label "test"
2927     .m1 add command -label "test2"
2928 } -cleanup {
2929     deleteWindows
2930 } -result {}
2931 test menu-15.4 {MenuNewEntry} -setup {
2932     deleteWindows
2933 } -body {
2934     menu .m1
2935     .m1 add command -label "test"
2936 } -cleanup {
2937     deleteWindows
2938 } -result {}
2939
2940 test menu-16.1 {MenuAddOrInsert} -setup {
2941     deleteWindows
2942 } -body {
2943     menu .m1
2944     .m1 insert foo command -label "test"
2945 } -returnCodes error -result {bad menu entry index "foo"}
2946 test menu-16.2 {MenuAddOrInsert} -setup {
2947     deleteWindows
2948 } -body {
2949     menu .m1
2950     .m1 add command -label "test"
2951     .m1 insert test command -label "foo"
2952 } -cleanup {
2953     deleteWindows
2954 } -result {}
2955 test menu-16.3 {MenuAddOrInsert} -setup {
2956     deleteWindows
2957 } -body {
2958     menu .m1
2959     .m1 insert -1 command -label "test"
2960 } -returnCodes error -result {bad menu entry index "-1"}
2961 test menu-16.4 {MenuAddOrInsert} -setup {
2962     deleteWindows
2963 } -body {
2964     menu .m1 -tearoff 1
2965     .m1 add command -label "test"
2966     .m1 insert 0 command -label "test2"
2967     .m1 entrycget 1 -label
2968 } -cleanup {
2969     deleteWindows
2970 } -result {test2}
2971 test menu-16.5 {MenuAddOrInsert} -setup {
2972     deleteWindows
2973 } -body {
2974     menu .m1
2975     .m1 add cascade
2976 } -cleanup {
2977     deleteWindows
2978 } -result {}
2979 test menu-16.6 {MenuAddOrInsert} -setup {
2980     deleteWindows
2981 } -body {
2982     menu .m1
2983     .m1 add checkbutton
2984 } -cleanup {
2985     deleteWindows
2986 } -result {}
2987 test menu-16.7 {MenuAddOrInsert} -setup {
2988     deleteWindows
2989 } -body {
2990     menu .m1
2991     .m1 add command
2992 } -cleanup {
2993     deleteWindows
2994 } -result {}
2995 test menu-16.8 {MenuAddOrInsert} -setup {
2996     deleteWindows
2997 } -body {
2998     menu .m1
2999     .m1 add radiobutton
3000 } -cleanup {
3001     deleteWindows
3002 } -result {}
3003 test menu-16.9 {MenuAddOrInsert} -setup {
3004     deleteWindows
3005 } -body {
3006     menu .m1
3007     .m1 add separator
3008 } -cleanup {
3009     deleteWindows
3010 } -result {}
3011 test menu-16.10 {MenuAddOrInsert} -setup {
3012     deleteWindows
3013 } -body {
3014     menu .m1
3015     .m1 add blork
3016 } -returnCodes error -result {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator}
3017 test menu-16.11 {MenuAddOrInsert} -setup {
3018     deleteWindows
3019 } -body {
3020     menu .m1
3021     .m1 add command
3022 } -cleanup {
3023     deleteWindows
3024 } -result {}
3025 test menu-16.12 {MenuAddOrInsert} -setup {
3026     deleteWindows
3027 } -body {
3028     menu .m1
3029     .m1 clone .m2
3030     .m2 clone .m3
3031     list [.m2 add command -label "test"] [.m1 entrycget 1 -label] [.m3 entrycget 1 -label]
3032 } -cleanup {
3033     deleteWindows
3034 } -result {{} test test}
3035 test menu-16.13 {MenuAddOrInsert} -setup {
3036     deleteWindows
3037 } -body {
3038     menu .m1
3039     .m1 clone .m2
3040     .m2 clone .m3
3041     list [.m3 add command -label "test"] [.m1 entrycget 1 -label] [.m2 entrycget 1 -label]
3042 } -cleanup {
3043     deleteWindows
3044 } -result {{} test test}
3045 test menu-16.14 {MenuAddOrInsert} -setup {
3046     deleteWindows
3047 } -body {
3048     menu .m1
3049     .m1 add command -blork
3050 } -returnCodes error -result {unknown option "-blork"}
3051 test menu-16.15 {MenuAddOrInsert} -setup {
3052     deleteWindows
3053 } -body {
3054     menu .m1
3055     .m1 add command -label "File"
3056     menu .container
3057     . configure -menu .container
3058     list [.container add cascade -label "File" -menu .m1] [. configure -menu ""]
3059 } -cleanup {
3060     deleteWindows
3061 } -result {{} {}}
3062 test menu-16.16 {MenuAddOrInsert} -setup {
3063     deleteWindows
3064 } -body {
3065     menu .m1
3066     menu .m2
3067     set tearoff [tk::TearOffMenu .m2]
3068     list [.m2 add cascade -menu .m1] [$tearoff unpost]
3069 } -cleanup {
3070     deleteWindows
3071 } -result {{} {}}
3072 test menu-16.17 {MenuAddOrInsert} -setup {
3073     deleteWindows
3074 } -body {
3075     menu .m1
3076     menu .container
3077     . configure -menu .container
3078     set tearoff [tk::TearOffMenu .container]
3079     list [.container add cascade -label "File" -menu .m1] [. configure -menu ""]
3080 } -cleanup {
3081     deleteWindows
3082 } -result {{} {}}
3083 test menu-16.18 {MenuAddOrInsert} -setup {
3084     deleteWindows
3085 } -body {
3086     menu .m1
3087     menu .container
3088     .container add cascade -menu .m1
3089     . configure -menu .container
3090     list [.container add cascade -label "File" -menu .m1] [. configure -menu ""]
3091 } -cleanup {
3092     deleteWindows
3093 } -result {{} {}}
3094 test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} -setup {
3095     deleteWindows
3096 } -body {
3097     menu .menubar
3098     menu .menubar.test -tearoff 0
3099     .menubar add cascade -label Test -underline 0 -menu .menubar.test
3100     menu .menubar.test.cascade -tearoff 0
3101     .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
3102     . configure -menu .menubar
3103     list [catch {.menubar.test add cascade -label SubMenu \
3104                 -menu .menubar.test.cascade}] \
3105                 [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
3106                 [. configure -menu ""]
3107 } -cleanup {
3108     deleteWindows
3109 } -result {0 .#menubar.#menubar#test.#menubar#test#cascade {}}
3110
3111
3112 test menu-17.1 {MenuVarProc} -setup {
3113     deleteWindows
3114 } -body {
3115     catch {unset foo}
3116     menu .m1
3117     set foo "hello"
3118     list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
3119                 [unset foo]
3120 } -cleanup {
3121     deleteWindows
3122 } -result {{} {}}
3123 # menu-17.2 - Don't know how to generate the flags in the if
3124 test menu-17.2 {MenuVarProc} -setup {
3125     deleteWindows
3126 } -body {
3127     catch {unset foo}
3128     menu .m1
3129     list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
3130                 [set foo ""]
3131 } -cleanup {
3132     deleteWindows
3133 } -result {{} {}}
3134 test menu-17.3 {MenuVarProc} -setup {
3135     deleteWindows
3136 } -body {
3137     catch {unset foo}
3138     menu .m1
3139     set foo "hello"
3140     list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
3141                 [set foo "hello"] [unset foo]
3142 } -cleanup {
3143     deleteWindows
3144 } -result {{} hello {}}
3145 test menu-17.4 {MenuVarProc} -setup {
3146     deleteWindows
3147 } -body {
3148     menu .m1
3149     set foo "goodbye"
3150     list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
3151                 [set foo "hello"] [unset foo]
3152 } -cleanup {
3153     deleteWindows
3154 } -result {{} hello {}}
3155 test menu-17.5 {MenuVarProc} -setup {
3156     deleteWindows
3157 } -body {
3158     menu .m1
3159     set foo "hello"
3160     list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
3161                 [set foo "goodbye"] [unset foo]
3162 } -cleanup {
3163     deleteWindows
3164 } -result {{} goodbye {}}
3165 test menu-17.6 {MenuVarProc [5d991b822e]} -setup {
3166     deleteWindows
3167 } -body {
3168     # Want this not to crash
3169     menu .b
3170     set var INIT
3171     .b add checkbutton -variable var
3172     trace add variable var unset {apply {args {
3173         .b entryconfigure 1 -variable {}
3174     }}}
3175     unset var
3176 } -cleanup {
3177     deleteWindows
3178 } -result {}
3179 test menu-17.7 {MenuVarProc [5d991b822e]} -setup {
3180     deleteWindows
3181 } -body {
3182     # Want this not to duplicate traces
3183     menu .b
3184     set var INIT
3185     .b add checkbutton -variable var
3186     trace add variable var unset {apply {args {
3187         .b entryconfigure 1 -variable new
3188     }}}
3189     unset var
3190 } -cleanup {
3191     deleteWindows
3192 } -result {}
3193
3194
3195 test menu-18.1 {TkActivateMenuEntry} -setup {
3196     deleteWindows
3197 } -body {
3198     menu .m1
3199     .m1 add command -label "test"
3200     .m1 activate 1
3201 } -cleanup {
3202     deleteWindows
3203 } -result {}
3204 test menu-18.2 {TkActivateMenuEntry} -setup {
3205     deleteWindows
3206 } -body {
3207     menu .m1
3208     .m1 add command -label "test"
3209     .m1 activate 0
3210 } -cleanup {
3211     deleteWindows
3212 } -result {}
3213 test menu-18.3 {TkActivateMenuEntry} -setup {
3214     deleteWindows
3215 } -body {
3216     menu .m1
3217     .m1 add command -label "test"
3218     .m1 add command -label "test2"
3219     .m1 activate 1
3220     .m1 activate 2
3221 } -cleanup {
3222     deleteWindows
3223 } -result {}
3224 test menu-18.4 {TkActivateMenuEntry} -setup {
3225     deleteWindows
3226 } -body {
3227     menu .m1
3228     .m1 add command -label "test"
3229     .m1 add command -label "test2"
3230     .m1 activate 1
3231     .m1 activate 1
3232 } -cleanup {
3233     deleteWindows
3234 } -result {}
3235
3236
3237 test menu-19.1 {TkPostCommand} -constraints nonUnixUserInteraction -setup {
3238     deleteWindows
3239 } -body {
3240     menu .m1 -postcommand "set menu_test menu-19.1"
3241     .m1 add command -label "menu-19.1 - hit Escape"
3242     list [.m1 post 40 40] [.m1 unpost] [set menu_test]
3243 } -cleanup {
3244     deleteWindows
3245 } -result {menu-19.1 {} menu-19.1}
3246 test menu-19.2 {TkPostCommand} -constraints nonUnixUserInteraction -setup {
3247     deleteWindows
3248 } -body {
3249     menu .m1
3250     .m1 add command -label "menu-19.2 - hit Escape"
3251     list [.m1 post 40 40] [.m1 unpost]
3252 } -cleanup {
3253     deleteWindows
3254 } -result {{} {}}
3255
3256 test menu-20.1 {CloneMenu} -setup {
3257     deleteWindows
3258 } -body {
3259     menu .m1
3260     .m1 clone .m2]
3261 } -cleanup {
3262     deleteWindows
3263 } -result {}
3264 test menu-20.2 {CloneMenu} -setup {
3265     deleteWindows
3266 } -body {
3267     menu .m1
3268     .m1 clone .m2 normal
3269     deleteWindows
3270 } -result {}
3271 test menu-20.3 {CloneMenu} -setup {
3272     deleteWindows
3273 } -body {
3274     menu .m1
3275     .m1 clone .m2 tearoff
3276 } -cleanup {
3277     deleteWindows
3278 } -result {}
3279 test menu-20.4 {CloneMenu} -setup {
3280     deleteWindows
3281 } -body {
3282     menu .m1
3283     .m1 clone .m2 menubar
3284 } -cleanup {
3285     deleteWindows
3286 } -result {}
3287 test menu-20.5 {CloneMenu} -setup {
3288     deleteWindows
3289 } -body {
3290     menu .m1
3291     .m1 clone .m2 foo
3292 } -returnCodes error -result {bad menu type "foo": must be normal, tearoff, or menubar}
3293 test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} -setup {
3294     deleteWindows
3295 } -body {
3296     menu .m1
3297     .m1 clone .m2
3298 } -cleanup {
3299     deleteWindows
3300 } -result {}
3301 test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} -setup {
3302     deleteWindows
3303 } -body {
3304     menu .m1
3305     .m1 clone .m2
3306     .m1 clone .m3
3307 } -cleanup {
3308     deleteWindows
3309 } -result {}
3310 test menu-20.8 {CloneMenu - cascade entries} -setup {
3311     deleteWindows
3312 } -body {
3313     menu .m1
3314     .m1 add cascade -menu .m2
3315     .m1 clone .foo
3316 } -cleanup {
3317     deleteWindows
3318 } -result {}
3319 test menu-20.9 {CloneMenu - cascades entries} -setup {
3320     deleteWindows
3321 } -body {
3322     menu .m1
3323     .m1 add cascade -menu .m2
3324     menu .m2
3325     .m1 clone .foo
3326 } -cleanup {
3327     deleteWindows
3328 } -result {}
3329 test menu-20.10 {CloneMenu - tearoff fields} -setup {
3330     deleteWindows
3331 } -body {
3332     menu .m1 -tearoff 1
3333     list [.m1 clone .m2 normal] [.m2 cget -tearoff]
3334 } -cleanup {
3335     deleteWindows
3336 } -result {{} 1}
3337 test menu-20.11 {CloneMenu} -setup {
3338     deleteWindows
3339 } -body {
3340     menu .m1
3341     menu .m2
3342     .m1 clone .m2
3343 } -returnCodes error -result {window name "m2" already exists in parent}
3344
3345 test menu-21.1 {MenuDoYPosition} -setup {
3346     deleteWindows
3347 } -body {
3348     menu .m1
3349     .m1 yposition glorp
3350 } -returnCodes error -result {bad menu entry index "glorp"}
3351 test menu-21.2 {MenuDoYPosition} -setup {
3352     deleteWindows
3353 } -body {
3354     menu .m1
3355     .m1 add command -label "Test"
3356     .m1 yposition 1
3357 } -cleanup {
3358     deleteWindows
3359 } -returnCodes ok -match glob -result {*}
3360
3361 test menu-22.1 {GetIndexFromCoords} -setup {
3362     deleteWindows
3363 } -body {
3364     menu .m1
3365     .m1 add command -label "test"
3366     .m1 configure -tearoff 0
3367     .m1 index @5
3368 } -cleanup {
3369     deleteWindows
3370 } -result 0
3371 test menu-22.2 {GetIndexFromCoords} -setup {
3372     deleteWindows
3373 } -body {
3374     menu .m1
3375     .m1 add command -label "test"
3376     .m1 configure -tearoff 0
3377     .m1 index @5,5
3378 } -cleanup {
3379     deleteWindows
3380 } -result 0
3381 test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup {
3382     deleteWindows
3383 } -constraints {x11} -body {
3384     menu .m1
3385     .m1 add command -label "test"
3386     .m1 configure -tearoff 0
3387     tk_popup .m1 0 0
3388     tkwait visibility .m1
3389     .m1 index @5
3390 } -cleanup {
3391     deleteWindows
3392 } -result 0
3393 test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup {
3394     deleteWindows
3395 } -constraints {x11} -body {
3396     menu .m1
3397     .m1 add command -label "test"
3398     .m1 configure -tearoff 0
3399     tk_popup .m1 0 0
3400     tkwait visibility .m1
3401     update
3402     set x [expr {[winfo width .m1] - [.m1 cget -borderwidth] - 1}]
3403     .m1 index @$x,5
3404 } -cleanup {
3405     deleteWindows
3406 } -result 0
3407 test menu-22.5 {GetIndexFromCoords: mapped wide window} -setup {
3408     deleteWindows
3409 } -constraints {x11} -body {
3410     menu .m1
3411     .m1 add command -label "test"
3412     .m1 configure -tearoff 0
3413     tk_popup .m1 0 0
3414     tkwait visibility .m1
3415     wm geometry .m1 200x100
3416     update
3417     set x [expr {[winfo width .m1] - [.m1 cget -borderwidth] - 1}]
3418     .m1 index @$x,5
3419 } -cleanup {
3420     deleteWindows
3421 } -result 0
3422
3423 test menu-23.1 {RecursivelyDeleteMenu} -setup {
3424     deleteWindows
3425 } -body {
3426     menu .m1
3427     . configure -menu .m1
3428     . configure -menu ""
3429 } -cleanup {
3430     deleteWindows
3431 } -result {}
3432 test menu-23.2 {RecursivelyDeleteMenu} -setup {
3433     deleteWindows
3434 } -body {
3435     menu .m2
3436     .m2 add command -label "test2"
3437     menu .m1
3438     .m1 add cascade -label "test1" -menu .m2
3439     . configure -menu .m1
3440     . configure -menu ""
3441 } -cleanup {
3442     deleteWindows
3443 } -result {}
3444
3445 test menu-24.1 {TkNewMenuName} -setup {
3446     deleteWindows
3447 } -body {
3448     menu .m1
3449     list [. configure -menu .m1] [. configure -menu ""]
3450 } -cleanup {
3451     deleteWindows
3452 } -result {{} {}}
3453 test menu-24.2 {TkNewMenuName} -setup {
3454     deleteWindows
3455 } -body {
3456     menu .m1
3457     menu .m1\#0
3458     list [. configure -menu .m1] [. configure -menu ""]
3459 } -cleanup {
3460     deleteWindows
3461 } -result {{} {}}
3462 test menu-24.3 {TkNewMenuName} -setup {
3463     deleteWindows
3464 } -body {
3465     menu .#m
3466     rename .#m hideme
3467     list [catch {. configure -menu [menu .m]}] [. configure -menu ""] [destroy .#m] \
3468                 [destroy .m] [destroy hideme]
3469 } -result {0 {} {} {} {}}
3470
3471
3472 test menu-25.1 {TkSetWindowMenuBar} -setup {
3473     deleteWindows
3474 } -body {
3475     . configure -menu ""
3476     list [. configure -menu .m1] [. configure -menu ""]
3477 } -cleanup {
3478     deleteWindows
3479 } -result {{} {}}
3480 test menu-25.2 {TkSetWindowMenuBar} -setup {
3481     deleteWindows
3482 } -body {
3483     . configure -menu ""
3484     list [. configure -menu .m1] [. configure -menu ""]
3485 } -cleanup {
3486     deleteWindows
3487 } -result {{} {}}
3488 test menu-25.3 {TkSetWindowMenuBar} -setup {
3489     deleteWindows
3490 } -body {
3491     . configure -menu ""
3492     destroy .m1
3493     menu .m1
3494     list [. configure -menu .m1] [. configure -menu ""]
3495 } -cleanup {
3496     deleteWindows
3497 } -result {{} {}}
3498 test menu-25.4 {TkSetWindowMenuBar} -setup {
3499     deleteWindows
3500 } -body {
3501     . configure -menu ""
3502     menu .m1
3503     . configure -menu .m1
3504     menu .m2
3505     list [. configure -menu .m2] [. configure -menu ""]
3506 } -cleanup {
3507     deleteWindows
3508 } -result {{} {}}
3509 test menu-25.5 {TkSetWindowMenuBar} -setup {
3510     deleteWindows
3511 } -body {
3512     . configure -menu ""
3513     menu .m1
3514     . configure -menu .m1
3515     .m1 clone .m2
3516     menu .m3
3517     list [. configure -menu .m3] [. configure -menu ""]
3518 } -cleanup {
3519     deleteWindows
3520 } -result {{} {}}
3521 test menu-25.6 {TkSetWindowMenuBar} -setup {
3522     deleteWindows
3523 } -body {
3524     . configure -menu ""
3525     menu .m1
3526     .m1 clone .m2
3527     . configure -menu .m2
3528     menu .m3
3529     list [. configure -menu .m3] [. configure -menu ""]
3530 } -cleanup {
3531     deleteWindows
3532 } -result {{} {}}
3533 test menu-25.7 {TkSetWindowMenuBar} -setup {
3534     deleteWindows
3535 } -body {
3536     . configure -menu ""
3537     menu .m1
3538     menu .m2
3539     . configure -menu .m1
3540     toplevel .t2
3541     .t2 configure -menu .m1
3542     list [.t2 configure -menu .m2] [. configure -menu ""]
3543 } -cleanup {
3544     deleteWindows
3545 } -result {{} {}}
3546 test menu-25.8 {TkSetWindowMenuBar} -setup {
3547     deleteWindows
3548 } -body {
3549     . configure -menu ""
3550     menu .m1
3551     menu .m2
3552     . configure -menu .m1
3553     toplevel .t2
3554     wm geometry .t2 +0+0
3555     .t2 configure -menu .m1
3556     list [. configure -menu .m2] [. configure -menu ""]
3557 } -cleanup {
3558     deleteWindows
3559 } -result {{} {}}
3560 test menu-25.9 {TkSetWindowMenuBar} -setup {
3561     deleteWindows
3562 } -body {
3563     . configure -menu ""
3564     menu .m1
3565     menu .m2
3566     . configure -menu .m1
3567     toplevel .t2 -menu .m1
3568     wm geometry .t2 +0+0
3569     toplevel .t3 -menu .m1
3570     wm geometry .t3 +0+0
3571     list [.t3 configure -menu .m2] [. configure -menu ""]
3572 } -cleanup {
3573     deleteWindows
3574 } -result {{} {}}
3575 test menu-25.10 {TkSetWindowMenuBar} -setup {
3576     deleteWindows
3577 } -body {
3578     . configure -menu ""
3579     menu .m1
3580     menu .m2
3581     . configure -menu .m1
3582     toplevel .t2 -menu .m1
3583     wm geometry .t2 +0+0
3584     toplevel .t3 -menu .m1
3585     wm geometry .t3 +0+0
3586     list [.t2 configure -menu .m2] [. configure -menu ""]
3587 } -cleanup {
3588     deleteWindows
3589 } -result {{} {}}
3590 test menu-25.11 {TkSetWindowMenuBar} -setup {
3591     deleteWindows
3592 } -body {
3593     . configure -menu ""
3594     menu .m1
3595     menu .m2
3596     . configure -menu .m1
3597     toplevel .t2 -menu .m1
3598     wm geometry .t2 +0+0
3599     toplevel .t3 -menu .m1
3600     wm geometry .t3 +0+0
3601     list [. configure -menu .m2] [. configure -menu ""]
3602 } -cleanup {
3603     deleteWindows
3604 } -result {{} {}}
3605 test menu-25.12 {TkSetWindowMenuBar} -setup {
3606     deleteWindows
3607 } -body {
3608     . configure -menu ""
3609     menu .m1
3610     list [. configure -menu .m1] [. configure -menu ""]
3611 } -cleanup {
3612     deleteWindows
3613 } -result {{} {}}
3614 test menu-25.13 {TkSetWindowMenuBar} -setup {
3615     deleteWindows
3616 } -body {
3617     . configure -menu ""
3618     list [. configure -menu .m1] [. configure -menu ""]
3619 } -cleanup {
3620     deleteWindows
3621 } -result {{} {}}
3622 test menu-25.14 {TkSetWindowMenuBar} -setup {
3623     deleteWindows
3624 } -body {
3625     . configure -menu ""
3626     menu .m1
3627     list [. configure -menu .m1] [. configure -menu ""]
3628 } -cleanup {
3629     deleteWindows
3630 } -result {{} {}}
3631 test menu-25.15 {TkSetWindowMenuBar} -setup {
3632     deleteWindows
3633 } -body {
3634     . configure -menu ""
3635     list [. configure -menu .m1] [. configure -menu ""]
3636 } -cleanup {
3637     deleteWindows
3638 } -result {{} {}}
3639 test menu-25.16 {TkSetWindowMenuBar} -setup {
3640     deleteWindows
3641 } -body {
3642     . configure -menu ""
3643     menu .m1
3644     . configure -menu .m1
3645     list [toplevel .t2 -menu m1] [. configure -menu ""]
3646 } -cleanup {
3647     deleteWindows
3648 } -result {.t2 {}}
3649
3650
3651 test menu-26.1 {DestroyMenuHashTable} -setup {
3652     catch {interp delete testinterp}
3653     deleteWindows
3654 } -body {
3655     interp create testinterp
3656     load {} Tk testinterp
3657     interp eval testinterp {menu .m1}
3658     interp delete testinterp
3659 } -returnCodes ok -result {}
3660
3661
3662 test menu-27.1 {GetMenuHashTable} -setup {
3663     catch {interp delete testinterp}
3664     deleteWindows
3665 } -body {
3666     interp create testinterp
3667     load {} Tk testinterp
3668     list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
3669 } -cleanup {
3670     deleteWindows
3671 } -result {0 .m1 {}}
3672
3673
3674 test menu-28.1 {TkCreateMenuReferences - not there before} -setup {
3675     deleteWindows
3676 } -body {
3677     menu .m1
3678 } -cleanup {
3679     deleteWindows
3680 } -result {.m1}
3681 test menu-28.2 {TkCreateMenuReferences - there already} -setup {
3682     deleteWindows
3683 } -body {
3684     menu .m1
3685     .m1 add cascade -menu .m2
3686     menu .m2
3687 } -cleanup {
3688     deleteWindows
3689 } -result {.m2}
3690
3691
3692 test menu-29.1 {TkFindMenuReferences - not there} -setup {
3693     deleteWindows
3694 } -body {
3695     . configure -menu ""
3696     menu .m1
3697     .m1 add cascade -menu .m2
3698     list [. configure -menu .m1] [. configure -menu ""]
3699 } -cleanup {
3700     deleteWindows
3701 } -result {{} {}}
3702
3703
3704 test menu-30.1 {TkFindMenuReferences - there already} -setup {
3705     deleteWindows
3706 } -body {
3707     . configure -menu ""
3708     menu .m1
3709     menu .m2
3710     .m1 add cascade -menu .m2
3711     list [. configure -menu .m1] [. configure -menu ""]
3712 } -cleanup {
3713     deleteWindows
3714 } -result {{} {}}
3715
3716
3717 test menu-31.1 {TkFreeMenuReferences - menuPtr} -setup {
3718     deleteWindows
3719 } -body {
3720     menu .m1
3721     destroy .m1
3722 } -cleanup {
3723     deleteWindows
3724 } -result {}
3725 test menu-31.2 {TkFreeMenuReferences - cascadePtr} -setup {
3726     deleteWindows
3727 } -body {
3728     . configure -menu ""
3729     menu .m1
3730     .m1 add cascade -menu .m2
3731     .m1 entryconfigure 1 -menu .m3
3732 } -cleanup {
3733     deleteWindows
3734 } -result {}
3735 test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} -setup {
3736     deleteWindows
3737 } -body {
3738     . configure -menu .m1
3739     . configure -menu ""
3740 } -cleanup {
3741     deleteWindows
3742 } -returnCodes ok -result {}
3743 test menu-31.4 {TkFreeMenuReferences - not empty} -setup {
3744     deleteWindows
3745 } -body {
3746     menu .m1
3747     .m1 add cascade -menu .m3
3748     menu .m2
3749     .m2 add cascade -menu .m3
3750     .m2 entryconfigure 1 -menu ".foo"
3751 } -cleanup {
3752     deleteWindows
3753 } -result {}
3754
3755
3756 test menu-32.1 {DeleteMenuCloneEntries} -setup {
3757     deleteWindows
3758 } -body {
3759     menu .m1
3760     .m1 add command -label foo
3761     .m1 clone .m2
3762     .m1 delete 1
3763 } -cleanup {
3764     deleteWindows
3765 } -result {}
3766 test menu-32.2 {DeleteMenuCloneEntries} -setup {
3767     deleteWindows
3768 } -body {
3769
3770     menu .m1
3771     .m1 add command -label one
3772     .m1 add command -label two
3773     .m1 add command -label three
3774     .m1 add command -label four
3775     .m1 clone .m2
3776     .m1 delete 2 3
3777 } -cleanup {
3778     deleteWindows
3779 } -result {}
3780 test menu-32.3 {DeleteMenuCloneEntries} -setup {
3781     deleteWindows
3782 } -body {
3783     menu .m1 -tearoff 0
3784     .m1 add command -label one
3785     .m1 add command -label two
3786     .m1 add command -label three
3787     .m1 add command -label four
3788     .m1 clone .m2
3789     .m2 configure -tearoff 1
3790     .m1 delete 1 2
3791 } -cleanup {
3792     deleteWindows
3793 } -result {}
3794 test menu-32.4 {DeleteMenuCloneEntries} -setup {
3795     deleteWindows
3796 } -body {
3797     menu .m1
3798     .m1 add command -label one
3799     .m1 add command -label two
3800     .m1 add command -label three
3801     .m1 add command -label four
3802     .m1 clone .m2
3803     .m2 configure -tearoff 0
3804     .m1 delete 2 3
3805 } -cleanup {
3806     deleteWindows
3807 } -result {}
3808 test menu-32.5 {DeleteMenuCloneEntries} -setup {
3809     deleteWindows
3810 } -body {
3811     menu .m1
3812     .m1 add command -label one
3813     .m1 add command -label two
3814     .m1 clone .m2
3815     .m1 activate one
3816     .m1 delete one
3817 } -cleanup {
3818     deleteWindows
3819 } -result {}
3820 test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} -setup {
3821     deleteWindows
3822 } -body {
3823     menu .m1
3824     .m1 add command -label test \
3825                 -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
3826     .m1 invoke test
3827 } -cleanup {
3828     deleteWindows
3829 } -result {}
3830 test menu-32.7 {DeleteMenuCloneEntries - one entry} -setup {
3831     deleteWindows
3832 } -body {
3833     menu .m1 -tearoff 0
3834     .m1 add command -label Hello
3835     .m1 delete Hello
3836 } -cleanup {
3837     deleteWindows
3838 } -result {}
3839 test menu-32.8 {Ensure all menu clone commands are deleted} -setup {
3840     deleteWindows
3841 } -body {
3842     # SF bug #465324
3843     menu .menubar
3844     . configure -menu .menubar
3845     menu .menubar.test
3846     .menubar.test add command -label "hi"
3847     for {set i 0} {$i < 10} {incr i} {
3848                 .menubar add cascade -menu .menubar.test -label "Test"
3849                 .menubar delete Test
3850     }
3851
3852     info commands .#menubar*test*
3853 } -cleanup {
3854     deleteWindows
3855 } -result {}
3856 test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} -setup {
3857     set res {}
3858     deleteWindows
3859 } -body {
3860     menu .menubar
3861     . configure -menu .menubar
3862     menu .menubar.test
3863     .menubar add cascade -menu .menubar.test -label "Test"
3864     menu .menubar.cascade
3865
3866     .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
3867     lappend res [.menubar.test entrycget 1 -menu]
3868     lappend res [.#menubar.#menubar#test entrycget 1 -menu]
3869     destroy .menubar.test
3870     menu .menubar.test
3871     .menubar.test add cascade -menu .menubar.cascade -label "Cascade"
3872     lappend res [.menubar.test entrycget 1 -menu]
3873     lappend res [.#menubar.#menubar#test entrycget 1 -menu]
3874     return $res
3875 } -cleanup {
3876     deleteWindows
3877 } -result {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade}
3878
3879
3880 test menu-33.1 {menu vs command hiding} -setup {
3881     deleteWindows
3882 } -body {
3883         set l [interp hidden]
3884     menu .m
3885     interp hide {} .m
3886     destroy .m
3887     set result [list [winfo children .] [interp hidden]]
3888         expr {$result eq [list {} $l]}
3889 } -result 1
3890
3891 # menu-34 MenuInit only called at boot time
3892
3893 # creating menus on two different screens then deleting the
3894 # menu from the first screen crashes Tk8.3.1
3895 #
3896 test menu-34.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} -constraints {
3897         altDisplay
3898 } -setup {
3899     deleteWindows
3900 } -body {
3901     toplevel .one
3902     menu .one.m
3903     toplevel .two -screen $::env(TK_ALT_DISPLAY)
3904     menu .two.m
3905     destroy .one
3906     destroy .two
3907 } -result {}
3908
3909 test menu-35.1 {menu -underline string overruns Bug 1599877} -setup {
3910    destroy .m
3911 } -body {
3912     # ensure that -underline does not do string overruns [Bug 1599877]
3913     menu .m
3914     .m add command -label "File" -underline [expr {1<<30}]
3915     . configure -menu .m
3916     update
3917     tk::TraverseToMenu . "e"
3918 } -cleanup {
3919     deleteWindows
3920 } -result {}
3921
3922 test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup {
3923     catch {destroy .m}
3924 } -body {
3925     # On Linux the following used to panic
3926     # It now returns an error (on all platforms)
3927     menu .m -type menubar
3928     list [catch ".m post 1 1" msg] $msg
3929 } -cleanup {
3930     destroy .m
3931 } -result {1 {a menubar menu cannot be posted}}
3932
3933 test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over it - bug fa32290898} -setup {
3934 } -constraints {x11} -body {
3935     toplevel .top
3936     ttk::menubutton .top.mb -text "Some menu";
3937     menu .top.mb.m;
3938     .top.mb.m add command -label "Item 1";
3939     .top.mb.m add command -label "Item 2";
3940     .top.mb configure -menu .top.mb.m;
3941     pack .top.mb
3942     update
3943     # simulate mouse click on the menubutton, which posts its menu
3944     event generate .top.mb <Button-1> -warp 1
3945     controlPointerWarpTiming
3946     event generate .top.mb <ButtonRelease-1>
3947     update
3948     # simulate mouse click on the menu again, i.e. without
3949     # entering/leaving the posted menu
3950     event generate .top.mb <Button-1>
3951     update
3952     after 50
3953     event generate .top.mb <ButtonRelease-1>
3954     update
3955     # the menu shall have been unposted by the second click
3956     winfo ismapped .top.mb.m
3957 } -cleanup {
3958     destroy .top.mb.m .top.m .top
3959 } -result 0
3960
3961
3962 # cleanup
3963 imageFinish
3964 deleteWindows
3965 cleanupTests
3966 return
3967
3968 # Local variables:
3969 # mode: tcl
3970 # End: