tk/tests/unixMenu.test

   1 # This file is a Tcl script to test menus in Tk.  It is
   2 # organized in the standard fashion for Tcl tests. This
   3 # file tests the Macintosh-specific features of the menu
   4 # system.
   5 #
   6 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
   7 # Copyright (c) 1998-1999 by Scriptics Corporation.
   8 # All rights reserved.
   9 #
  10 # RCS: @(#) $Id$
  11
  12 if {[lsearch [namespace children] ::tcltest] == -1} {
  13     source [file join [pwd] [file dirname [info script]] defs.tcl]
  14 }
  15
  16 if {$tcl_platform(platform) != "unix"} {
  17     puts "skipping: Unix only tests..."
  18     ::tcltest::cleanupTests
  19     return
  20 }
  21
  22 if {[lsearch [image types] test] < 0} {
  23     puts "This application hasn't been compiled with the \"test\" image"
  24     puts "type, so I can't run this test.  Are you sure you're using"
  25     puts "tktest instead of wish?"
  26     ::tcltest::cleanupTests
  27     return
  28 }
  29
  30 proc deleteWindows {} {
  31     foreach i [winfo children .] {
  32         catch [destroy $i]
  33     }
  34 }
  35
  36 deleteWindows
  37 wm geometry . {}
  38 raise .
  39
  40 test unixMenu-1.1 {TkpNewMenu - normal menu} {
  41     catch {destroy .m1}
  42     list [catch {menu .m1} msg] $msg [destroy .m1]
  43 } {0 .m1 {}}
  44 test unixMenu-1.2 {TkpNewMenu - help menu} {
  45     catch {destroy .m1}
  46     menu .m1 -tearoff 0
  47     . configure -menu .m1
  48     .m1 add cascade -label Help -menu .m1.help
  49     list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
  50 } {0 .m1.help {} {}}
  51
  52 test unixMenu-2.1 {TkpDestroyMenu - nothing to do} {} {}
  53 test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} {} {}
  54
  55 test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} {
  56     catch {destroy .m1}
  57     menu .m1 -tearoff 0
  58     .m1 add command -label test
  59     list [catch {.m1 entryconfigure test -label foo} msg] $msg [destroy .m1]
  60 } {0 {} {}}
  61 test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} {
  62     catch {destroy .m1}
  63     menu .m1 -tearoff 0
  64     .m1 add cascade -menu .m2 -label test
  65     menu .m1.foo -tearoff 0
  66     list [catch {.m1 entryconfigure test -menu .m1.foo} msg] $msg [destroy .m1]
  67 } {0 {} {}}
  68
  69 test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} {} {}
  70
  71 test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} {
  72     catch {destroy .m1}
  73     menu .m1
  74     .m1 add cascade -label foo
  75     . configure -menu .m1
  76     list [catch {. configure -menu ""} msg] $msg [destroy .m1]
  77 } {0 {} {}}
  78 test unixMenu-6.2 {TkpSetWindowMenuBar - menu} {
  79     catch {destroy .m1}
  80     menu .m1
  81     .m1 add cascade -label foo
  82     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  83 } {0 {} {} {}}
  84
  85 test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} {} {}
  86
  87 test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} {
  88     catch {destroy .m1}
  89     menu .m1
  90     .m1 add checkbutton -label foo -indicatoron 0
  91     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
  92 } {0 {}}
  93 test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} {
  94     catch {destroy .m1}
  95     menu .m1
  96     .m1 add command -label foo
  97     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
  98 } {0 {}}
  99 test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} {
 100     catch {destroy .m1}
 101     catch {image delete image1}
 102     menu .m1
 103     image create test image1
 104     .m1 add checkbutton -image image1 -label foo
 105     .m1 invoke foo
 106     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
 107 } {0 {} {}}
 108 test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} {
 109     catch {destroy .m1}
 110     menu .m1
 111     .m1 add checkbutton -bitmap questhead -label foo
 112     .m1 invoke foo
 113     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 114 } {0 {}}
 115 test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} {
 116     catch {destroy .m1}
 117     menu .m1
 118     .m1 add checkbutton -label foo
 119     .m1 invoke foo
 120     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 121 } {0 {}}
 122 test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} {
 123     catch {destroy .m1}
 124     catch {image delete image1}
 125     menu .m1
 126     image create test image1
 127     .m1 add radiobutton -image image1 -label foo
 128     .m1 invoke foo
 129     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
 130 } {0 {} {}}
 131 test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} {
 132     catch {destroy .m1}
 133     menu .m1
 134     .m1 add radiobutton -bitmap questhead -label foo
 135     .m1 invoke foo
 136     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 137 } {0 {}}
 138 test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} {
 139     catch {destroy .m1}
 140     menu .m1
 141     .m1 add radiobutton -label foo
 142     .m1 invoke foo
 143     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 144 } {0 {}}
 145 test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} {
 146     catch {destroy .m1}
 147     menu .m1
 148     .m1 add radiobutton -label foo -hidemargin 1
 149     .m1 invoke foo
 150     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 151 } {0 {}}
 152
 153 test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} {
 154     catch {destroy .m1}
 155     menu .m1
 156     .m1 add cascade -label foo
 157     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 158 } {0 {}}
 159 test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} {
 160     catch {destroy .m1}
 161     menu .m1
 162     .m1 add command -label foo -accel "Ctrl+S"
 163     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 164 } {0 {}}
 165 test unixMenu-9.3 {GetMenuAccelGeometry - null label} {
 166     catch {destroy .m1}
 167     menu .m1
 168     .m1 add command -label foo
 169     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 170 } {0 {}}
 171
 172 test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} {
 173     catch {destroy .m1}
 174     menu .m1
 175     .m1 add cascade -label foo
 176     . configure -menu .m1
 177     .m1 activate 1
 178     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 179 } {0 {} {} {}}
 180 test unixMenu-10.2 {DrawMenuEntryBackground - active} {
 181     catch {destroy .m1}
 182     menu .m1
 183     .m1 add command -label foo
 184     set tearoff [tkTearOffMenu .m1 40 40]
 185     $tearoff activate 0
 186     list [catch {update} msg] $msg [destroy .m1]
 187 } {0 {} {}}
 188 test unixMenu-10.3 {DrawMenuEntryBackground - non-active} {
 189     catch {destroy .m1}
 190     menu .m1
 191     .m1 add command -label foo
 192     set tearoff [tkTearOffMenu .m1 40 40]
 193     list [catch {update} msg] $msg [destroy .m1]
 194 } {0 {} {}}
 195
 196 test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} {
 197     catch {destroy .m1}
 198     menu .m1
 199     .m1 add command -label foo -accel "Ctrl+U"
 200     . configure -menu .m1
 201     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 202 } {0 {} {} {}}
 203 # drawArrow parameter is never false under Unix
 204 test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} {
 205     catch {destroy .m1}
 206     menu .m1
 207     .m1 add cascade -label foo
 208     set tearoff [tkTearOffMenu .m1 40 40]
 209     list [catch {update} msg] $msg [destroy .m1]
 210 } {0 {} {}}
 211 test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} {
 212     catch {destroy .m1}
 213     menu .m1
 214     .m1 add command -label foo -accel "Ctrl+U"
 215     set tearoff [tkTearOffMenu .m1 40 40]
 216     list [catch {update} msg] $msg [destroy .m1]
 217 } {0 {} {}}
 218 test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} {
 219     catch {destroy .m1}
 220     menu .m1
 221     .m1 add command -label foo
 222     set tearoff [tkTearOffMenu .m1 40 40]
 223     list [catch {update} msg] $msg [destroy .m1]
 224 } {0 {} {}}
 225
 226 test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} {
 227     catch {destroy .m1}
 228     menu .m1
 229     .m1 add command -label foo
 230     set tearoff [tkTearOffMenu .m1 40 40]
 231     list [catch {update} msg] $msg [destroy .m1]
 232 } {0 {} {}}
 233 test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} {
 234     catch {destroy .m1}
 235     menu .m1
 236     .m1 add checkbutton -label foo -indicatoron 0
 237     set tearoff [tkTearOffMenu .m1 40 40]
 238     list [catch {update} msg] $msg [destroy .m1]
 239 } {0 {} {}}
 240 test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} {
 241     catch {destroy .m1}
 242     menu .m1
 243     .m1 add checkbutton -label foo
 244     set tearoff [tkTearOffMenu .m1 40 40]
 245     list [catch {update} msg] $msg [destroy .m1]
 246 } {0 {} {}}
 247 test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} {
 248     catch {destroy .m1}
 249     menu .m1
 250     .m1 add checkbutton -label foo
 251     .m1 invoke 1
 252     set tearoff [tkTearOffMenu .m1 40 40]
 253     list [catch {update} msg] $msg [destroy .m1]
 254 } {0 {} {}}
 255 test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} {
 256     catch {destroy .m1}
 257     menu .m1
 258     .m1 add radiobutton -label foo -indicatoron 0
 259     set tearoff [tkTearOffMenu .m1 40 40]
 260     list [catch {update} msg] $msg [destroy .m1]
 261 } {0 {} {}}
 262 test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} {
 263     catch {destroy .m1}
 264     menu .m1
 265     .m1 add radiobutton -label foo
 266     set tearoff [tkTearOffMenu .m1 40 40]
 267     list [catch {update} msg] $msg [destroy .m1]
 268 } {0 {} {}}
 269 test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} {
 270     catch {destroy .m1}
 271     menu .m1
 272     .m1 add radiobutton -label foo
 273     .m1 invoke 1
 274     set tearoff [tkTearOffMenu .m1 40 40]
 275     list [catch {update} msg] $msg [destroy .m1]
 276 } {0 {} {}}
 277
 278 test unixMenu-13.1 {DrawMenuSeparator - menubar case} {
 279     catch {destroy .m1}
 280     menu .m1
 281     .m1 add separator
 282     . configure -menu .m1
 283     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 284 } {0 {} {} {}}
 285 test unixMenu-13.2 {DrawMenuSepartor - normal menu} {
 286     catch {destroy .m1}
 287     menu .m1
 288     .m1 add separator
 289     set tearoff [tkTearOffMenu .m1 40 40]
 290     list [catch {update} msg] $msg [destroy .m1]
 291 } {0 {} {}}
 292
 293 test unixMenu-14.1 {DrawMenuEntryLabel} {
 294     catch {destroy .m1}
 295     menu .m1
 296     .m1 add command -label foo
 297     set tearoff [tkTearOffMenu .m1 40 40]
 298     list [catch {update} msg] $msg [destroy .m1]
 299 } {0 {} {}}
 300
 301 test unixMenu-15.1 {DrawMenuUnderline - menubar} {
 302     catch {destroy .m1}
 303     menu .m1
 304     .m1 add command -label foo -underline 0
 305     . configure -menu .m1
 306     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 307 } {0 {} {} {}}
 308 test unixMenu-15.2 {DrawMenuUnderline - no menubar} {
 309     catch {destroy .m1}
 310     menu .m1
 311     .m1 add command -label foo -underline 0
 312     set tearoff [tkTearOffMenu .m1 40 40]
 313     list [catch {update} msg] $msg [destroy .m1]
 314 } {0 {} {}}
 315
 316 test unixMenu-16.1 {TkpPostMenu} {
 317     catch {destroy .m1}
 318     menu .m1
 319     .m1 add command -label foo
 320     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 321 } {0 {}}
 322
 323 test unixMenu-17.1 {GetMenuSeparatorGeometry} {
 324     catch {destroy .m1}
 325     menu .m1
 326     .m1 add separator
 327     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 328 } {0 {}}
 329
 330 test unixMenu-18.1 {GetTearoffEntryGeometry} {
 331     catch {destroy .m1}
 332     menubutton .mb -text "test" -menu .mb.m
 333     menu .mb.m
 334     .mb.m add command -label test
 335     pack .mb
 336     raise .
 337     list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb]
 338 } {0 {} {} {}}
 339
 340 # Don't know how to reproduce the case where the tkwin has been deleted.
 341 test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} {
 342     catch {destroy .m1}
 343     menu .m1
 344     . configure -menu .m1
 345     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 346 } {0 {} {} {}}
 347 # Don't know how to generate one width windows
 348 test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} {
 349     catch {destroy .m1}
 350     menu .m1
 351     .m1 add cascade -label File
 352     . configure -menu .m1
 353     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 354 } {0 {} {} {}}
 355 test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} {
 356     catch {destroy .m1}
 357     menu .m1 -font "Courier 24"
 358     .m1 add cascade -label File -font "Helvetica 18"
 359     . configure -menu .m1
 360     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 361 } {0 {} {} {}}
 362 test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} {
 363     catch {destroy .m1}
 364     menu .m1
 365     .m1 add separator
 366     . configure -menu .m1
 367     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 368 } {0 {} {} {}}
 369 test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} {
 370     catch {destroy .m1}
 371     menu .m1 -tearoff 0
 372     .m1 add cascade -label File
 373     . configure -menu .m1
 374     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 375 } {0 {} {} {}}
 376 test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} {
 377     catch {destroy .m1}
 378     menu .m1 -tearoff 0
 379     .m1 add cascade -label File -font "Times 72"
 380     . configure -menu .m1
 381     wm geometry . 10x10
 382     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 383 } {0 {} {} {}}
 384 test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} {
 385     catch {destroy .m1}
 386     menu .m1 -tearoff 0
 387     .m1 add cascade -label File
 388     .m1 add cascade -label Edit
 389     . configure -menu .m1
 390     wm geometry . 200x200
 391     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 392 } {0 {} {} {}}
 393 test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} {
 394     catch {destroy .m1}
 395     menu .m1 -tearoff 0
 396     .m1 add cascade -label File
 397     .m1 add cascade -label Edit -font "Times 72"
 398     . configure -menu .m1
 399     wm geometry . 100x100
 400     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 401 } {0 {} {} {}}
 402 test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} {
 403     catch {destroy .m1}
 404     menu .m1 -tearoff 0
 405     .m1 add cascade -label File -font "Times 72"
 406     .m1 add cascade -label Edit
 407     . configure -menu .m1
 408     wm geometry . 100x100
 409     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 410 } {0 {} {} {}}
 411 test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} {
 412     catch {destroy .m1}
 413     menu .m1 -tearoff 0 -font "Times 72"
 414     .m1 add cascade -label File
 415     .m1 add cascade -label Edit
 416     . configure -menu .m1
 417     wm geometry . 10x10
 418     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 419 } {0 {} {} {}}
 420 # ABC notation; capital A means first window fits, small a means it
 421 # does not. capital B menu means second window fist, etc.
 422 test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} {
 423     catch {destroy .m1}
 424     menu .m1 -tearoff 0 -font "Times 72"
 425     .m1 add cascade -label "aaaaa"
 426     .m1 add cascade -label "bbbbb"
 427     .m1 add cascade -label "ccccc"
 428     . configure -menu .m1
 429     wm geometry . 10x10
 430     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 431 } {0 {} {} {}}
 432 test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} {
 433     catch {destroy .m1}
 434     menu .m1 -tearoff 0
 435     .m1 add cascade -label "aaaaa" -font "Times 72"
 436     .m1 add cascade -label "bbbbb" -font "Times 72"
 437     .m1 add cascade -label "C"
 438     . configure -menu .m1
 439     wm geometry . 10x10
 440     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 441 } {0 {} {} {}}
 442 test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} {
 443     catch {destroy .m1}
 444     menu .m1 -tearoff 0
 445     .m1 add cascade -label "aaaaa" -font "Times 72"
 446     .m1 add cascade -label "B"
 447     .m1 add cascade -label "ccccc" -font "Times 72"
 448     . configure -menu .m1
 449     wm geometry . 10x10
 450     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 451 } {0 {} {} {}}
 452 test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} {
 453     catch {destroy .m1}
 454     menu .m1 -tearoff 0
 455     .m1 add cascade -label "aaaaa" -font "Times 72"
 456     .m1 add cascade -label "B"
 457     .m1 add cascade -label "C"
 458     . configure -menu .m1
 459     wm geometry . 60x10
 460     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 461 } {0 {} {} {}}
 462 test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} {
 463     catch {destroy .m1}
 464     menu .m1 -tearoff 0
 465     .m1 add cascade -label "A"
 466     .m1 add cascade -label "bbbbb" -font "Times 72"
 467     .m1 add cascade -label "ccccc" -font "Times 72"
 468     . configure -menu .m1
 469     wm geometry . 60x10
 470     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 471 } {0 {} {} {}}
 472 test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} {
 473     catch {destroy .m1}
 474     menu .m1 -tearoff 0
 475     .m1 add cascade -label "A"
 476     .m1 add cascade -label "bbbbb" -font "Times 72"
 477     .m1 add cascade -label "C"
 478     . configure -menu .m1
 479     wm geometry . 60x10
 480     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 481 } {0 {} {} {}}
 482 test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} {
 483     catch {destroy .m1}
 484     menu .m1 -tearoff 0
 485     .m1 add cascade -label "A"
 486     .m1 add cascade -label "B"
 487     .m1 add cascade -label "ccccc" -font "Times 72"
 488     . configure -menu .m1
 489     wm geometry . 60x10
 490     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 491 } {0 {} {} {}}
 492 test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} {
 493     catch {destroy .m1}
 494     menu .m1 -tearoff 0
 495     .m1 add cascade -label "A"
 496     .m1 add cascade -label "B"
 497     .m1 add cascade -label "C"
 498     . configure -menu .m1
 499     wm geometry . 100x10
 500     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 501 } {0 {} {} {}}
 502 test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} {
 503     catch {destroy .m1}
 504     menu .m1 -tearoff 0
 505     .m1 add cascade -label Help -menu .m1.help
 506     menu .m1.help -tearoff 0
 507     .m1 add cascade -label File -menu .m1.file
 508     menu .m1.file -tearoff 0
 509     .m1 add cascade -label Edit -menu .m1.edit
 510     menu .m1.edit -tearoff 0
 511     . configure -menu .m1
 512     wm geometry . 100x10
 513     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 514 } {0 {} {} {}}
 515 test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} {
 516     catch {destroy .m1}
 517     menu .m1 -tearoff 0
 518     .m1 add cascade -label Edit -menu .m1.edit
 519     menu .m1.edit -tearoff 0
 520     .m1 add cascade -label Help -menu .m1.help
 521     menu .m1.help -tearoff 0
 522     .m1 add cascade -label File -menu .m1.file
 523     menu .m1.file -tearoff 0
 524     . configure -menu .m1
 525     wm geometry . 100x10
 526     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 527 } {0 {} {} {}}
 528 test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} {
 529     catch {destroy .m1}
 530     menu .m1 -tearoff 0
 531     .m1 add cascade -label File -menu .m1.file
 532     menu .m1.file -tearoff 0
 533     .m1 add cascade -label Edit -menu .m1.edit
 534     menu .m1.edit -tearoff 0
 535     .m1 add cascade -label Help -menu .m1.help
 536     menu .m1.help -tearoff 0
 537     . configure -menu .m1
 538     wm geometry . 100x10
 539     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 540 } {0 {} {} {}}
 541 test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} {
 542     catch {destroy .m1}
 543     menu .m1 -tearoff 0
 544     .m1 add cascade -label File -menu .m1.file
 545     menu .m1.file -tearoff 0
 546     .m1 add cascade -label Help -menu .m1.help
 547     menu .m1.help -tearoff 0
 548     . configure -menu .m1
 549     wm geometry . 100x10
 550     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 551 } {0 {} {} {}}
 552 test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} {
 553     catch {destroy .m1}
 554     menu .m1 -tearoff 0
 555     .m1 add cascade -label File -menu .m1.file
 556     menu .m1.file -tearoff 0
 557     .m1 add cascade -label Help -menu .m1.help -font "Helvetica 72"
 558     menu .m1.help -tearoff 0
 559     . configure -menu .m1
 560     wm geometry . 100x10
 561     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 562 } {0 {} {} {}}
 563 test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} {
 564     catch {destroy .m1}
 565     menu .m1 -tearoff 0
 566     .m1 add cascade -label Help -menu .m1.help
 567     menu .m1.help -tearoff 0
 568     . configure -menu .m1
 569     wm geometry . 100x10
 570     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 571 } {0 {} {} {}}
 572
 573 test unixMenu-20.1 {DrawTearoffEntry - menubar} {
 574     catch {destroy .m1}
 575     menu .m1
 576     .m1 add cascade -label File
 577     . configure -menu .m1
 578     list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
 579 } {0 {} {} {}}
 580 test unixMenu-20.2 {DrawTearoffEntry - non-menubar} {
 581     catch {destroy .m1}
 582     menu .m1
 583     .m1 add command -label foo
 584     .m1 post 40 40
 585      list [catch {update} msg] $msg [destroy .m1]
 586 } {0 {} {}}
 587
 588 test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} {} {}
 589
 590 test unixMenu-22.1 {SetHelpMenu - no menubars} {
 591     catch {destroy .m1}
 592     menu .m1 -tearoff 0
 593     .m1 add cascade -label test -menu .m1.test
 594     list [catch {menu .m1.test} msg] $msg [destroy .m1]
 595 } {0 .m1.test {}}
 596 # Don't know how to automate missing tkwins
 597 test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} {
 598     catch {destroy .m1}
 599     menu .m1 -tearoff 0
 600     . configure -menu .m1
 601     .m1 add cascade -label .m1.file
 602     list [catch {menu .m1.file} msg] $msg [. configure -menu ""] [destroy .m1]
 603 } {0 .m1.file {} {}}
 604 test unixMenu-22.3 {SetHelpMenu - menubar with help menu} {
 605     catch {destroy .m1}
 606     menu .m1 -tearoff 0
 607     . configure -menu .m1
 608     .m1 add cascade -label .m1.help
 609     list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
 610 } {0 .m1.help {} {}}
 611 test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} {
 612     catch {destroy .m1}
 613     catch {destroy .t2}
 614     toplevel .t2
 615     wm geometry .t2 +40+40
 616     menu .m1 -tearoff 0
 617     . configure -menu .m1
 618     .t2 configure -menu .m1
 619     .m1 add cascade -label .m1.help
 620     list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2]
 621 } {0 .m1.help {} {} {}}
 622
 623 test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} {
 624     catch {destroy .m1}
 625     menu .m1
 626     .m1 add command -label foo
 627     set tearoff [tkTearOffMenu .m1 40 40]
 628     .m1 entryconfigure 1 -state active
 629     list [update] [destroy .m1]
 630 } {{} {}}
 631 test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {
 632     catch {destroy .m1}
 633     menu .m1
 634     .m1 add command -label foo -activeforeground red
 635     set tearoff [tkTearOffMenu .m1 40 40]
 636     .m1 entryconfigure 1 -state active
 637     list [update] [destroy .m1]
 638 } {{} {}}
 639 test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} {
 640     catch {destroy .m1}
 641     menu .m1
 642     set tk_strictMotif 1
 643     .m1 add command -label foo
 644     set tearoff [tkTearOffMenu .m1 40 40]
 645     .m1 entryconfigure 1 -state active
 646     list [update] [destroy .m1] [set tk_strictMotif 0]
 647 } {{} {} 0}
 648 test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} {
 649     catch {destroy .m1}
 650     menu .m1 -disabledforeground blue
 651     .m1 add command -label foo -state disabled -background red
 652     set tearoff [tkTearOffMenu .m1 40 40]
 653     list [update] [destroy .m1]
 654 } {{} {}}
 655 test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {
 656     catch {destroy .m1}
 657     menu .m1 -disabledforeground blue
 658     .m1 add command -label foo -state disabled
 659     set tearoff [tkTearOffMenu .m1 40 40]
 660     list [update] [destroy .m1]
 661 } {{} {}}
 662 test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {
 663     catch {destroy .m1}
 664     menu .m1 -disabledforeground ""
 665     .m1 add command -label foo -state disabled
 666     set tearoff [tkTearOffMenu .m1 40 40]
 667     list [update] [destroy .m1]
 668 } {{} {}}
 669 test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} {
 670     catch {destroy .m1}
 671     menu .m1
 672     .m1 add command -label foo -foreground red
 673     set tearoff [tkTearOffMenu .m1 40 40]
 674     list [update] [destroy .m1]
 675 } {{} {}}
 676 test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} {
 677     catch {destroy .m1}
 678     menu .m1
 679     .m1 add command -label foo
 680     set tearoff [tkTearOffMenu .m1 40 40]
 681     list [update] [destroy .m1]
 682 } {{} {}}
 683 test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {
 684     catch {destroy .m1}
 685     menu .m1
 686     .m1 add checkbutton -label foo -selectcolor orange
 687     .m1 invoke 1
 688     set tearoff [tkTearOffMenu .m1 40 40]
 689     list [update] [destroy .m1]
 690 } {{} {}}
 691 test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} {
 692     catch {destroy .m1}
 693     menu .m1
 694     .m1 add checkbutton -label foo
 695     .m1 invoke 1
 696     set tearoff [tkTearOffMenu .m1 40 40]
 697     list [update] [destroy .m1]
 698 } {{} {}}
 699 test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} {
 700     catch {destroy .m1}
 701     menu .m1
 702     .m1 add command -label foo -activebackground green
 703     set tearoff [tkTearOffMenu .m1 40 40]
 704     .m1 entryconfigure 1 -state active
 705     list [update] [destroy .m1]
 706 } {{} {}}
 707 test unixMenu-23.12 {TkpDrawMenuEntry - border} {
 708     catch {destroy .m1}
 709     menu .m1
 710     .m1 add command -label foo
 711     set tearoff [tkTearOffMenu .m1 40 40]
 712     .m1 entryconfigure 1 -state active
 713     list [update] [destroy .m1]
 714 } {{} {}}
 715 test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} {
 716     catch {destroy .m1}
 717     set tk_strictMotif 1
 718     menu .m1
 719     .m1 add command -label foo
 720     set tearoff [tkTearOffMenu .m1 40 40]
 721     .m1 entryconfigure 1 -state active
 722     list [update] [destroy .m1] [set tk_strictMotif 0]
 723 } {{} {} 0}
 724 test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} {
 725     catch {destroy .m1}
 726     menu .m1
 727     .m1 add command -label foo -activeforeground yellow
 728     set tearoff [tkTearOffMenu .m1 40 40]
 729     .m1 entryconfigure 1 -state active
 730     list [update] [destroy .m1]
 731 } {{} {}}
 732 test unixMenu-23.15 {TkpDrawMenuEntry - active border} {
 733     catch {destroy .m1}
 734     menu .m1
 735     .m1 add command -label foo
 736     set tearoff [tkTearOffMenu .m1 40 40]
 737     .m1 entryconfigure 1 -state active
 738     list [update] [destroy .m1]
 739 } {{} {}}
 740 test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} {
 741     catch {destroy .m1}
 742     menu .m1
 743     .m1 add command -label foo -font "Helvectica 72"
 744     set tearoff [tkTearOffMenu .m1 40 40]
 745     list [update] [destroy .m1]
 746 } {{} {}}
 747 test unixMenu-23.17 {TkpDrawMenuEntry - font} {
 748     catch {destroy .m1}
 749     menu .m1 -font "Courier 72"
 750     .m1 add command -label foo
 751     set tearoff [tkTearOffMenu .m1 40 40]
 752     list [update] [destroy .m1]
 753 } {{} {}}
 754 test unixMenu-23.18 {TkpDrawMenuEntry - separator} {
 755     catch {destroy .m1}
 756     menu .m1
 757     .m1 add separator
 758     set tearoff [tkTearOffMenu .m1 40 40]
 759     list [update] [destroy .m1]
 760 } {{} {}}
 761 test unixMenu-23.19 {TkpDrawMenuEntry - standard} {
 762     catch {destroy .mb}
 763     menu .m1
 764     .m1 add command -label foo
 765     set tearoff [tkTearOffMenu .m1 40 40]
 766     list [update] [destroy .m1]
 767 } {{} {}}
 768 test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} {
 769     catch {destroy .m1}
 770     menu .m1
 771     .m1 add cascade -label File -menu .m1.file
 772     menu .m1.file
 773     .m1.file add command -label foo
 774     .m1 entryconfigure File -state disabled
 775     set tearoff [tkTearOffMenu .m1 40 40]
 776     list [update] [destroy .m1]
 777 } {{} {}}
 778 test unixMenu-23.21 {TkpDrawMenuEntry - indicator} {
 779     catch {destroy .m1}
 780     menu .m1
 781     .m1 add checkbutton -label Foo
 782     .m1 invoke Foo
 783     set tearoff [tkTearOffMenu .m1 40 40]
 784     list [update] [destroy .m1]
 785 } {{} {}}
 786 test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} {
 787     catch {destroy .m1}
 788     menu .m1
 789     .m1 add checkbutton -label Foo -hidemargin 1
 790     .m1 invoke Foo
 791     set tearoff [tkTearOffMenu .m1 40 40]
 792     list [update] [destroy .m1]
 793 } {{} {}}
 794
 795 test unixMenu-24.1 {GetMenuLabelGeometry - image} {
 796     catch {destroy .m1}
 797     catch {image delete image1}
 798     menu .m1
 799     image create test image1
 800     .m1 add command -image image1
 801     list [update idletasks] [destroy .m1] [image delete image1]
 802 } {{} {} {}}
 803 test unixMenu-24.2 {GetMenuLabelGeometry - bitmap} {
 804     catch {destroy .m1}
 805     menu .m1
 806     .m1 add command -bitmap questhead
 807     list [update idletasks] [destroy .m1]
 808 } {{} {}}
 809 test unixMenu-24.3 {GetMenuLabelGeometry - no text} {
 810     catch {destroy .m1}
 811     menu .m1
 812     .m1 add command
 813     list [update idletasks] [destroy .m1]
 814 } {{} {}}
 815 test unixMenu-24.4 {GetMenuLabelGeometry - text} {
 816     catch {destroy .m1}
 817     menu .m1
 818     .m1 add command -label "This is a test."
 819     list [update idletasks] [destroy .m1]
 820 } {{} {}}
 821
 822 test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} {
 823     catch {destroy .m1}
 824     menu .m1
 825     list [update idletasks] [destroy .m1]
 826 } {{} {}}
 827 test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} {
 828     catch {destroy .m1}
 829     menu .m1
 830     .m1 add command -label "one"
 831     list [update idletasks] [destroy .m1]
 832 } {{} {}}
 833 test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} {
 834     catch {destroy .m1}
 835     menu .m1
 836     .m1 add command -label "one"
 837     .m1 add command -label "two"
 838     list [update idletasks] [destroy .m1]
 839 } {{} {}}
 840 test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} {
 841     catch {destroy .m1}
 842     menu .m1
 843     .m1 add separator
 844     list [update idletasks] [destroy .m1]
 845 } {{} {}}
 846 test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
 847     catch {destroy .m1}
 848     menubutton .mb -text "test" -menu .mb.m
 849     menu .mb.m
 850     .mb.m add command -label test
 851     pack .mb
 852     catch {tkMbPost .mb}
 853     list [update] [tkMenuUnpost .mb.m] [destroy .mb]
 854 } {{} {} {}}
 855 test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
 856     catch {destroy .m1}
 857     menu .m1
 858     .m1 add command -label "test"
 859     list [update idletasks] [destroy .m1]
 860 } {{} {}}
 861 test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} {
 862     catch {destroy .m1}
 863     menu .m1 -font "Helvetica 12"
 864     .m1 add command -label "test" -font "Courier 12"
 865     list [update idletasks] [destroy .m1]
 866 } {{} {}}
 867 test unixMenu-25.8 {TkpComputeStandardMenuGeometry - second entry larger} {
 868     catch {destroy .m1}
 869     menu .m1
 870     .m1 add command -label "test"
 871     .m1 add command -label "test test"
 872     list [update idletasks] [destroy .m1]
 873 } {{} {}}
 874 test unixMenu-25.9 {TkpComputeStandardMenuGeometry - first entry larger} {
 875     catch {destroy .m1}
 876     menu .m1
 877     .m1 add command -label "test test"
 878     .m1 add command -label "test"
 879     list [update idletasks] [destroy .m1]
 880 } {{} {}}
 881 test unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} {
 882     catch {destroy .m1}
 883     menu .m1
 884     .m1 add command -label "test" -accel "Ctrl+S"
 885     list [update idletasks] [destroy .m1]
 886 } {{} {}}
 887 test unixMenu-25.11 {TkpComputeStandardMenuGeometry - second accel larger} {
 888     catch {destroy .m1}
 889     menu .m1
 890     .m1 add command -label "test" -accel "1"
 891     .m1 add command -label "test" -accel "1 1"
 892     list [update idletasks] [destroy .m1]
 893 } {{} {}}
 894 test unixMenu-25.12 {TkpComputeStandardMenuGeometry - second accel smaller} {
 895     catch {destroy .m1}
 896     menu .m1
 897     .m1 add command -label "test" -accel "1 1"
 898     .m1 add command -label "test" -accel "1"
 899     list [update idletasks] [destroy .m1]
 900 } {{} {}}
 901 test unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} {
 902     catch {destroy .m1}
 903     menu .m1
 904     .m1 add checkbutton -label test
 905     .m1 invoke 1
 906     list [update idletasks] [destroy .m1]
 907 } {{} {}}
 908 test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } {
 909     catch {destroy .m1}
 910     catch {image delete image1}
 911     image create test image1
 912     menu .m1
 913     .m1 add checkbutton -image image1
 914     .m1 invoke 1
 915     .m1 add checkbutton -label test
 916     .m1 invoke 2
 917     list [update idletasks] [destroy .m1] [image delete image1]
 918 } {{} {} {}}
 919 test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unixOnly} {
 920     catch {destroy .m1}
 921     catch {image delete image1}
 922     image create test image1
 923     menu .m1
 924     .m1 add checkbutton -image image1
 925     .m1 invoke 1
 926     .m1 add checkbutton -label test
 927     .m1 invoke 2
 928     list [update idletasks] [destroy .m1] [image delete image1]
 929 } {{} {} {}}
 930 test unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} {
 931     catch {destroy .m1}
 932     menu .m1 -tearoff 0
 933     list [update idletasks] [destroy .m1]
 934 } {{} {}}
 935 test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} {
 936     catch {destroy .m1}
 937     menu .m1
 938     .m1 add command -label one
 939     .m1 add command -label two
 940     .m1 add command -label three -columnbreak 1
 941     list [update idletasks] [destroy .m1]
 942 } {{} {}}
 943 test unixMenu-25.18 {TkpComputeStandardMenuGeometry - second column bigger} {
 944     catch {destroy .m1}
 945     menu .m1 -tearoff 0
 946     .m1 add command -label one
 947     .m1 add command -label two -columnbreak 1
 948     .m1 add command -label three
 949     list [update idletasks] [destroy .m1]
 950 } {{} {}}
 951 test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} {
 952     catch {destroy .m1}
 953     menu .m1 -tearoff 0
 954     .m1 add command -label one
 955     .m1 add command -label two -columnbreak 1
 956     .m1 add command -label three
 957     .m1 add command -label four
 958     .m1 add command -label five -columnbreak 1
 959     .m1 add command -label six
 960     list [update idletasks] [destroy .m1]
 961 } {{} {}}
 962 test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} {
 963     catch {destroy .m1}
 964     menu .m1 -tearoff 0
 965     .m1 add checkbutton -label one -hidemargin 1
 966     list [update idletasks] [destroy .m1]
 967 } {{} {}}
 968
 969 test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {}
 970
 971 # cleanup
 972 deleteWindows
 973 ::tcltest::cleanupTests
 974 return