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