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 10package require tcltest 2.1 11eval tcltest::configure $argv 12tcltest::loadTestedCommands 13 14test winMenu-1.1 {GetNewID} win { 15 catch {destroy .m1} 16 list [catch {menu .m1} msg] $msg [destroy .m1] 17} {0 .m1 {}} 18# Basically impossible to test menu IDs wrapping. 19 20test winMenu-2.1 {FreeID} win { 21 catch {destroy .m1} 22 menu .m1 23 list [catch {destroy .m1} msg] $msg 24} {0 {}} 25 26test winMenu-3.1 {TkpNewMenu} win { 27 catch {destroy .m1} 28 list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2 29} {0 .m1 0 {}} 30test winMenu-3.2 {TkpNewMenu} win { 31 catch {destroy .m1} 32 . configure -menu "" 33 menu .m1 34 .m1 add command -label "foo" 35 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 36} {0 {} {} 0 {}} 37 38test winMenu-4.1 {TkpDestroyMenu} win { 39 catch {destroy .m1} 40 menu .m1 41 list [catch {destroy .m1} msg] $msg 42} {0 {}} 43test winMenu-4.2 {TkpDestroyMenu - help menu} win { 44 catch {destroy .m1} 45 menu .m1 46 .m1 add cascade -menu .m1.system 47 . configure -menu .m1 48 list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1] 49} {0 {} {} {}} 50 51test winMenu-5.1 {TkpDestroyMenuEntry} win { 52 catch {destroy .m1} 53 . configure -menu "" 54 menu .m1 55 .m1 add command -label "test" 56 update idletasks 57 list [catch {.m1 delete 1} msg] $msg [destroy .m1] 58} {0 {} {}} 59 60test winMenu-6.1 {GetEntryText} win { 61 catch {destroy .m1} 62 list [catch {menu .m1} msg] $msg [destroy .m1] 63} {0 .m1 {}} 64test winMenu-6.2 {GetEntryText} {testImageType win} { 65 catch {destroy .m1} 66 catch {image delete image1} 67 menu .m1 68 image create test image1 69 list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1] 70} {0 {} {} {}} 71test winMenu-6.3 {GetEntryText} win { 72 catch {destroy .m1} 73 menu .m1 74 list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1] 75} {0 {} {}} 76test winMenu-6.4 {GetEntryText} win { 77 catch {destroy .m1} 78 menu .m1 79 list [catch {.m1 add command} msg] $msg [destroy .m1] 80} {0 {} {}} 81test winMenu-6.5 {GetEntryText} win { 82 catch {destroy .m1} 83 menu .m1 84 list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1] 85} {0 {} {}} 86test winMenu-6.6 {GetEntryText} win { 87 catch {destroy .m1} 88 menu .m1 89 list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1] 90} {0 {} {}} 91test winMenu-6.7 {GetEntryText} win { 92 catch {destroy .m1} 93 menu .m1 94 list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1] 95} {0 {} {}} 96test winMenu-6.8 {GetEntryText} win { 97 catch {destroy .m1} 98 menu .m1 99 list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1] 100} {0 {} {}} 101test winMenu-6.9 {GetEntryText} win { 102 catch {destroy .m1} 103 menu .m1 104 list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1] 105} {0 {} {}} 106test winMenu-6.10 {GetEntryText} win { 107 catch {destroy .m1} 108 menu .m1 109 list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1] 110} {0 {} {}} 111test winMenu-6.11 {GetEntryText} win { 112 catch {destroy .m1} 113 menu .m1 114 list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1] 115} {0 {} {}} 116test winMenu-6.12 {GetEntryText} win { 117 catch {destroy .m1} 118 menu .m1 119 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1] 120} {0 {} {}} 121test winMenu-6.13 {GetEntryText} win { 122 catch {destroy .m1} 123 menu .m1 124 list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1] 125} {0 {} {}} 126test winMenu-6.14 {GetEntryText} win { 127 catch {destroy .m1} 128 menu .m1 129 list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1] 130} {0 {} {}} 131test winMenu-6.15 {GetEntryText} win { 132 catch {destroy .m1} 133 menu .m1 134 list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] 135} {0 {} {}} 136test winMenu-6.16 {GetEntryText} win { 137 catch {destroy .m1} 138 menu .m1 139 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] 140} {0 {} {}} 141 142test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} win { 143 catch {destroy .m1} 144 menu .m1 145 .m1 add cascade -menu .m1.system 146 menu .m1.system 147 .m1.system add command -label foo 148 update idletasks 149 .m1.system add command -label bar 150 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] 151} {0 {} {} {}} 152test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} win { 153 catch {destroy .m1} 154 menu .m1 155 .m1 add command -label Hello 156 update idletasks 157 .m1 add command -label foo 158 list [catch {update idletasks} msg] $msg [destroy .m1] 159} {0 {} {}} 160test winMenu-7.3 {ReconfigureWindowsMenu - zero items} win { 161 catch {destroy .m1} 162 menu .m1 -tearoff 0 163 .m1 add command -label Hello 164 .m1 delete Hello 165 list [catch {update idletasks} msg] $msg [destroy .m1] 166} {0 {} {}} 167test winMenu-7.4 {ReconfigureWindowsMenu - one item} win { 168 catch {destroy .m1} 169 menu .m1 -tearoff 0 170 .m1 add command -label Hello 171 list [catch {update idletasks} msg] $msg [destroy .m1] 172} {0 {} {}} 173test winMenu-7.5 {ReconfigureWindowsMenu - two items} win { 174 catch {destroy .m1} 175 menu .m1 -tearoff 0 176 .m1 add command -label One 177 .m1 add command -label Two 178 list [catch {update idletasks} msg] $msg [destroy .m1] 179} {0 {} {}} 180test winMenu-7.6 {ReconfigureWindowsMenu - separator item} win { 181 catch {destroy .m1} 182 menu .m1 -tearoff 0 183 .m1 add separator 184 list [catch {update idletasks} msg] $msg [destroy .m1] 185} {0 {} {}} 186test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} win { 187 catch {destroy .m1} 188 menu .m1 -tearoff 0 189 .m1 add command -label Hello 190 list [catch {update idletasks} msg] $msg [destroy .m1] 191} {0 {} {}} 192test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} win { 193 catch {destroy .m1} 194 menu .m1 -tearoff 0 195 .m1 add command -label Hello -state disabled 196 list [catch {update idletasks} msg] $msg [destroy .m1] 197} {0 {} {}} 198test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} win { 199 catch {destroy .m1} 200 menu .m1 -tearoff 0 201 .m1 add checkbutton -label Hello 202 list [catch {update idletasks} msg] $msg [destroy .m1] 203} {0 {} {}} 204test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} win { 205 catch {destroy .m1} 206 menu .m1 -tearoff 0 207 .m1 add radiobutton -label Hello 208 list [catch {update idletasks} msg] $msg [destroy .m1] 209} {0 {} {}} 210test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} win { 211 catch {destroy .m1} 212 menu .m1 -tearoff 0 213 .m1 add checkbutton -label Hello 214 .m1 invoke Hello 215 list [catch {update idletasks} msg] $msg [destroy .m1] 216} {0 {} {}} 217test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} win { 218 catch {destroy .m1} 219 menu .m1 -tearoff 0 220 .m1 add radiobutton -label Hello 221 .m1 invoke Hello 222 list [catch {update idletasks} msg] $msg [destroy .m1] 223} {0 {} {}} 224test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} win { 225 catch {destroy .m1} 226 menu .m1 -tearoff 0 227 .m1 add cascade -label Hello 228 list [catch {update idletasks} msg] $msg [destroy .m1] 229} {0 {} {}} 230test winMenu-7.14 {ReconfigureWindowsMenu - cascade} win { 231 catch {destroy .m1} 232 catch {destroy .m2} 233 menu .m1 -tearoff 0 234 menu .m2 235 .m1 add cascade -menu .m2 -label Hello 236 list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2] 237} {0 {} {} {}} 238test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} win { 239 catch {destroy .m1} 240 menu .m1 -tearoff 0 241 .m1 add cascade -menu .m1.file 242 menu .m1.file -tearoff 0 243 . configure -menu .m1 244 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] 245} {0 {} {} {}} 246test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} win { 247 catch {destroy .m1} 248 menu .m1 -tearoff 0 249 .m1 add cascade -menu .m1.system 250 menu .m1.system -tearoff 0 251 . configure -menu .m1 252 update idletasks 253 .m1.system add command -label Hello 254 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] 255} {0 {} {} {}} 256test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} win { 257 catch {destroy .m1} 258 menu .m1 -tearoff 0 259 .m1 add cascade -menu .m1.system 260 menu .m1.system -tearoff 0 261 . configure -menu .m1 262 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] 263} {0 {} {} {}} 264test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} win { 265 catch {destroy .m1} 266 menu .m1 -tearoff 0 267 .m1 add cascade -menu .m1.system 268 menu .m1.system -tearoff 0 269 .m1.system add command -label Hello 270 update idletasks 271 . configure -menu .m1 272 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] 273} {0 {} {} {}} 274test winMenu-7.19 {ReconfigureWindowsMenu - column break} win { 275 catch {destroy .m1} 276 menu .m1 -tearoff 0 277 .m1 add command -label one 278 .m1 add command -label two -columnbreak 1 279 list [catch {update idletasks} msg] $msg [destroy .m1] 280} {0 {} {}} 281 282#Don't know how to generate nested post menus 283test winMenu-8.1 {TkpPostMenu} win { 284 catch {destroy .m1} 285 menu .m1 -postcommand "blork" 286 list [catch {.m1 post 40 40} msg] $msg [destroy .m1] 287} {1 {invalid command name "blork"} {}} 288test winMenu-8.2 {TkpPostMenu} win { 289 catch {destroy .m1} 290 menu .m1 -postcommand "destroy .m1" 291 list [.m1 post 40 40] [winfo exists .m1] 292} {{} 0} 293test winMenu-8.3 {TkpPostMenu - popup menu} {win userInteraction} { 294 catch {destroy .m1} 295 menu .m1 296 .m1 add command -label "winMenu-8.3: Hit ESCAPE." 297 list [.m1 post 40 40] [destroy .m1] 298} {{} {}} 299test winMenu-8.4 {TkpPostMenu - menu button} {win userInteraction} { 300 catch {destroy .mb} 301 menubutton .mb -text test -menu .mb.menu 302 menu .mb.menu 303 .mb.menu add command -label "winMenu-8.4 - Hit ESCAPE." 304 pack .mb 305 list [tk::MbPost .mb] [destroy .m1] 306} {{} {}} 307test winMenu-8.5 {TkpPostMenu - update not pending} {win userInteraction} { 308 catch {destroy .m1} 309 menu .m1 310 .m1 add command -label "winMenu-8.5 - Hit ESCAPE." 311 update idletasks 312 list [catch {.m1 post 40 40} msg] $msg [destroy .m1] 313} {0 {} {}} 314 315test winMenu-9.1 {TkpMenuNewEntry} win { 316 catch {destroy .m1} 317 menu .m1 318 list [catch {.m1 add command} msg] $msg [destroy .m1] 319} {0 {} {}} 320 321test winMenu-10.1 {TkwinMenuProc} {win userInteraction} { 322 catch {destroy .m1} 323 menu .m1 324 .m1 add command -label "winMenu-10.1: Hit ESCAPE." 325 list [.m1 post 40 40] [destroy .m1] 326} {{} {}} 327 328# Can't generate a WM_INITMENU without a Tk menu yet. 329test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {win userInteraction} { 330 catch {destroy .m1} 331 catch {unset foo} 332 menu .m1 -postcommand "set foo test" 333 .m1 add command -label "winMenu-11.1: Hit ESCAPE." 334 list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1] 335} {test test {} {}} 336test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {win userInteraction} { 337 catch {destroy .m1} 338 catch {unset foo} 339 menu .m1 340 .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item." 341 list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1] 342} {{} {} 1 {} {}} 343test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {win userInteraction} { 344 catch {destroy .m1} 345 catch {unset foo} 346 proc bgerror {args} { 347 global foo errorInfo 348 set foo [list $args $errorInfo] 349 } 350 menu .m1 351 .m1 add command -command {error 1} -label "winMenu-11.2: Please select this menu item." 352 list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1] 353} {{} {} {1 {1 354 while executing 355"error 1" 356 (menu invoke)}} {} {}} 357 358# Can't test WM_MENUCHAR 359test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {win userInteraction} { 360 catch {destroy .m1} 361 menu .m1 362 .m1 add command -label "winMenu-11.3: Hit ESCAPE." 363 list [.m1 post 40 40] [destroy .m1] 364} {{} {}} 365test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {win userInteraction} { 366 catch {destroy .m1} 367 menu .m1 368 .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1 369 list [.m1 post 40 40] [destroy .m1] 370} {{} {}} 371test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {win userInteraction} { 372 catch {destroy .m1} 373 menu .m1 374 .m1 add command -label "winMenu-11.5: Hit ESCAPE." 375 list [.m1 post 40 40] [destroy .m1] 376} {{} {}} 377test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \ 378 {win userInteraction} { 379 catch {destroy .m1} 380 menu .m1 381 .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled 382 list [.m1 post 40 40] [destroy .m1] 383} {{} {}} 384test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \ 385 {win userInteraction} { 386 catch {destroy .m1} 387 menu .m1 -tearoff 0 388 .m1 add command -label "winMenu-11.7: Hit ESCAPE" 389 update idletasks 390 list [catch {.m1 post 40 40} msg] $msg [destroy .m1] 391} {0 {} {}} 392 393test winMenu-12.1 {TkpSetWindowMenuBar} win { 394 catch {destroy .m1} 395 . configure -menu "" 396 menu .m1 397 .m1 add command -label foo 398 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 399} {0 {} {} 0 {}} 400test winMenu-12.2 {TkpSetWindowMenuBar} win { 401 catch {destroy .m1} 402 . configure -menu "" 403 menu .m1 404 .m1 add command -label foo 405 . configure -menu .m1 406 list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2 407} {0 {} 0 {}} 408test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} win { 409 catch {destroy .m1} 410 . configure -menu "" 411 menu .m1 -tearoff 0 412 .m1 add command -label foo 413 update idletasks 414 list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] 415} {0 {} {} {}} 416 417test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest win} {} {} 418 419test winMenu-14.1 {GetMenuIndicatorGeometry} win { 420 catch {destroy .m1} 421 menu .m1 422 .m1 add checkbutton -label foo 423 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 424} {0 {}} 425test winMenu-14.2 {GetMenuIndicatorGeometry} win { 426 catch {destroy .m1} 427 menu .m1 428 .m1 add checkbutton -label foo -hidemargin 1 429 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 430} {0 {}} 431 432test winMenu-15.1 {GetMenuAccelGeometry} win { 433 catch {destroy .m1} 434 menu .m1 435 .m1 add cascade -label foo -accel Ctrl+U 436 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 437} {0 {}} 438test winMenu-15.2 {GetMenuAccelGeometry} win { 439 catch {destroy .m1} 440 menu .m1 441 .m1 add command -label foo 442 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 443} {0 {}} 444test winMenu-15.3 {GetMenuAccelGeometry} win { 445 catch {destroy .m1} 446 menu .m1 447 .m1 add command -label foo -accel "Ctrl+U" 448 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 449} {0 {}} 450 451test winMenu-16.1 {GetTearoffEntryGeometry} {win userInteraction} { 452 catch {destroy .m1} 453 menu .m1 454 .m1 add command -label "winMenu-19.1: Hit ESCAPE." 455 list [.m1 post 40 40] [destroy .m1] 456} {{} {}} 457 458test winMenu-17.1 {GetMenuSeparatorGeometry} win { 459 catch {destroy .m1} 460 menu .m1 461 .m1 add separator 462 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 463} {0 {}} 464 465# Currently, the only callers to DrawWindowsSystemBitmap want things 466# centered vertically, and either centered or right aligned horizontally. 467test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} win { 468 catch {destroy .m1} 469 menu .m1 470 .m1 add checkbutton -label foo 471 .m1 invoke foo 472 set tearoff [tk::TearOffMenu .m1 40 40] 473 list [update] [destroy .m1] 474} {{} {}} 475test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} win { 476 catch {destroy .m1} 477 menu .m1 478 .m1 add cascade -label foo 479 set tearoff [tk::TearOffMenu .m1 40 40] 480 list [update] [destroy .m1] 481} {{} {}} 482 483test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \ 484 win { 485 catch {destroy .m1} 486 menu .m1 487 .m1 add command -label foo 488 set tearoff [tk::TearOffMenu .m1 40 40] 489 list [update] [destroy .m1] 490} {{} {}} 491test winMenu-19.2 {DrawMenuEntryIndicator - not selected} win { 492 catch {destroy .m1} 493 menu .m1 494 .m1 add checkbutton -label foo 495 set tearoff [tk::TearOffMenu .m1 40 40] 496 list [update] [destroy .m1] 497} {{} {}} 498test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} win { 499 catch {destroy .m1} 500 menu .m1 501 .m1 add checkbutton -label foo 502 .m1 invoke foo 503 set tearoff [tk::TearOffMenu .m1 40 40] 504 list [update] [destroy .m1] 505} {{} {}} 506test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} win { 507 catch {destroy .m1} 508 menu .m1 509 .m1 add radiobutton -label foo 510 .m1 invoke foo 511 set tearoff [tk::TearOffMenu .m1 40 40] 512 list [update] [destroy .m1] 513} {{} {}} 514test winMenu-19.5 {DrawMenuEntryIndicator - disabled} win { 515 catch {destroy .m1} 516 menu .m1 517 .m1 add checkbutton -label foo 518 .m1 invoke foo 519 .m1 entryconfigure foo -state disabled 520 set tearoff [tk::TearOffMenu .m1 40 40] 521 list [update] [destroy .m1] 522} {{} {}} 523test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} win { 524 catch {destroy .m1} 525 menu .m1 526 .m1 add checkbutton -label foo -indicatoron 0 527 .m1 invoke foo 528 set tearoff [tk::TearOffMenu .m1 40 40] 529 list [update] [destroy .m1] 530} {{} {}} 531 532test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} win { 533 catch {destroy .m1} 534 menu .m1 -disabledforeground red 535 .m1 add command -label foo -accel "Ctrl+U" -state disabled 536 set tearoff [tk::TearOffMenu .m1 40 40] 537 list [update] [destroy .m1] 538} {{} {}} 539test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} win { 540 catch {destroy .m1} 541 menu .m1 542 .m1 add command -label foo -accel "Ctrl+U" 543 set tearoff [tk::TearOffMenu .m1 40 40] 544 list [update] [destroy .m1] 545} {{} {}} 546test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} win { 547 catch {destroy .m1} 548 menu .m1 -disabledforeground "" 549 .m1 add command -label foo -accel "Ctrl+U" -state disabled 550 set tearoff [tk::TearOffMenu .m1 40 40] 551 list [update] [destroy .m1] 552} {{} {}} 553test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} win { 554 catch {destroy .m1} 555 menu .m1 556 .m1 add cascade -label foo 557 set tearoff [tk::TearOffMenu .m1 40 40] 558 list [update] [destroy .m1] 559} {{} {}} 560test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \ 561 {win userInteraction} { 562 catch {destroy .m1} 563 menu .m1 564 .m1 add cascade -label "winMenu-23.5: Hit ESCAPE." 565 list [.m1 post 40 40] [destroy .m1] 566} {{} {}} 567 568test winMenu-21.1 {DrawMenuSeparator} win { 569 catch {destroy .m1} 570 menu .m1 571 .m1 add separator 572 set tearoff [tk::TearOffMenu .m1 40 40] 573 list [update] [destroy .m1] 574} {{} {}} 575 576test winMenu-22.1 {DrawMenuUnderline} win { 577 catch {destroy .m1} 578 menu .m1 579 .m1 add command -label foo -underline 0 580 set tearoff [tk::TearOffMenu .m1 40 40] 581 list [update] [destroy .m1] 582} {{} {}} 583 584test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \ 585 {win emptyTest} {} {} 586test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \ 587 {win emptyTest} {} {} 588 589test winMenu-25.1 {DrawMenuEntryLabel - normal} win { 590 catch {destroy .m1} 591 menu .m1 592 .m1 add command -label foo 593 set tearoff [tk::TearOffMenu .m1 40 40] 594 list [update] [destroy .m1] 595} {{} {}} 596test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} win { 597 catch {destroy .m1} 598 menu .m1 -disabledforeground red 599 .m1 add command -label foo -state disabled 600 set tearoff [tk::TearOffMenu .m1 40 40] 601 list [update] [destroy .m1] 602} {{} {}} 603test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} win { 604 catch {destroy .m1} 605 menu .m1 -disabledforeground "" 606 .m1 add command -label foo -state disabled 607 set tearoff [tk::TearOffMenu .m1 40 40] 608 list [update] [destroy .m1] 609} {{} {}} 610 611test winMenu-26.1 {TkpComputeMenubarGeometry} win { 612 catch {destroy .m1} 613 menu .m1 614 .m1 add cascade -label File 615 list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] 616} {{} {} {}} 617 618test winMenu-27.1 {DrawTearoffEntry} {win userInteraction} { 619 catch {destroy .m1} 620 menu .m1 621 .m1 add command -label "winMenu-24.4: Hit ESCAPE." 622 list [.m1 post 40 40] [destroy .m1] 623} {{} {}} 624 625test winMenu-28.1 {TkpConfigureMenuEntry - update pending} win { 626 catch {destroy .m1} 627 menu .m1 -tearoff 0 628 .m1 add command -label Hello 629 list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] 630} {0 {} {}} 631test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} win { 632 catch {destroy .m1} 633 menu .m1 -tearoff 0 634 .m1 add command -label One 635 update idletasks 636 list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] 637} {0 {} {}} 638 639test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} win { 640 catch {destroy .m1} 641 menu .m1 642 .m1 add command -label foo 643 set tearoff [tk::TearOffMenu .m1 40 40] 644 .m1 entryconfigure 1 -state active 645 list [update] [destroy .m1] 646} {{} {}} 647test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} win { 648 catch {destroy .m1} 649 menu .m1 650 .m1 add command -label foo -activeforeground red 651 set tearoff [tk::TearOffMenu .m1 40 40] 652 .m1 entryconfigure 1 -state active 653 list [update] [destroy .m1] 654} {{} {}} 655test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} win { 656 catch {destroy .m1} 657 menu .m1 658 set tk_strictMotif 1 659 .m1 add command -label foo 660 set tearoff [tk::TearOffMenu .m1 40 40] 661 .m1 entryconfigure 1 -state active 662 list [update] [destroy .m1] [set tk_strictMotif 0] 663} {{} {} 0} 664test winMenu-29.4 \ 665 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \ 666 win { 667 catch {destroy .m1} 668 menu .m1 -disabledforeground blue 669 .m1 add command -label foo -state disabled -background red 670 set tearoff [tk::TearOffMenu .m1 40 40] 671 list [update] [destroy .m1] 672} {{} {}} 673test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} win { 674 catch {destroy .m1} 675 menu .m1 -disabledforeground blue 676 .m1 add command -label foo -state disabled 677 set tearoff [tk::TearOffMenu .m1 40 40] 678 list [update] [destroy .m1] 679} {{} {}} 680test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} win { 681 catch {destroy .m1} 682 menu .m1 -disabledforeground "" 683 .m1 add command -label foo -state disabled 684 set tearoff [tk::TearOffMenu .m1 40 40] 685 list [update] [destroy .m1] 686} {{} {}} 687test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} win { 688 catch {destroy .m1} 689 menu .m1 690 .m1 add command -label foo -foreground red 691 set tearoff [tk::TearOffMenu .m1 40 40] 692 list [update] [destroy .m1] 693} {{} {}} 694test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} win { 695 catch {destroy .m1} 696 menu .m1 697 .m1 add command -label foo 698 set tearoff [tk::TearOffMenu .m1 40 40] 699 list [update] [destroy .m1] 700} {{} {}} 701test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} win { 702 catch {destroy .m1} 703 menu .m1 704 .m1 add checkbutton -label foo -selectcolor orange 705 .m1 invoke 1 706 set tearoff [tk::TearOffMenu .m1 40 40] 707 list [update] [destroy .m1] 708} {{} {}} 709test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} win { 710 catch {destroy .m1} 711 menu .m1 712 .m1 add checkbutton -label foo 713 .m1 invoke 1 714 set tearoff [tk::TearOffMenu .m1 40 40] 715 list [update] [destroy .m1] 716} {{} {}} 717test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} win { 718 catch {destroy .m1} 719 menu .m1 720 .m1 add command -label foo -activebackground green 721 set tearoff [tk::TearOffMenu .m1 40 40] 722 .m1 entryconfigure 1 -state active 723 list [update] [destroy .m1] 724} {{} {}} 725test winMenu-29.12 {TkpDrawMenuEntry - border} win { 726 catch {destroy .m1} 727 menu .m1 728 .m1 add command -label foo 729 set tearoff [tk::TearOffMenu .m1 40 40] 730 .m1 entryconfigure 1 -state active 731 list [update] [destroy .m1] 732} {{} {}} 733test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} win { 734 catch {destroy .m1} 735 set tk_strictMotif 1 736 menu .m1 737 .m1 add command -label foo 738 set tearoff [tk::TearOffMenu .m1 40 40] 739 .m1 entryconfigure 1 -state active 740 list [update] [destroy .m1] [set tk_strictMotif 0] 741} {{} {} 0} 742test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} win { 743 catch {destroy .m1} 744 menu .m1 745 .m1 add command -label foo -activeforeground yellow 746 set tearoff [tk::TearOffMenu .m1 40 40] 747 .m1 entryconfigure 1 -state active 748 list [update] [destroy .m1] 749} {{} {}} 750test winMenu-29.15 {TkpDrawMenuEntry - active border} win { 751 catch {destroy .m1} 752 menu .m1 753 .m1 add command -label foo 754 set tearoff [tk::TearOffMenu .m1 40 40] 755 .m1 entryconfigure 1 -state active 756 list [update] [destroy .m1] 757} {{} {}} 758test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} win { 759 catch {destroy .m1} 760 menu .m1 761 .m1 add command -label foo -font "Helvectica 72" 762 set tearoff [tk::TearOffMenu .m1 40 40] 763 list [update] [destroy .m1] 764} {{} {}} 765test winMenu-29.17 {TkpDrawMenuEntry - font} win { 766 catch {destroy .m1} 767 menu .m1 -font "Courier 72" 768 .m1 add command -label foo 769 set tearoff [tk::TearOffMenu .m1 40 40] 770 list [update] [destroy .m1] 771} {{} {}} 772test winMenu-29.18 {TkpDrawMenuEntry - separator} win { 773 catch {destroy .m1} 774 menu .m1 775 .m1 add separator 776 set tearoff [tk::TearOffMenu .m1 40 40] 777 list [update] [destroy .m1] 778} {{} {}} 779test winMenu-29.19 {TkpDrawMenuEntry - standard} win { 780 catch {destroy .mb} 781 menu .m1 782 .m1 add command -label foo 783 set tearoff [tk::TearOffMenu .m1 40 40] 784 list [update] [destroy .m1] 785} {{} {}} 786test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} win { 787 catch {destroy .m1} 788 menu .m1 789 .m1 add cascade -label File -menu .m1.file 790 menu .m1.file 791 .m1.file add command -label foo 792 .m1 entryconfigure File -state disabled 793 set tearoff [tk::TearOffMenu .m1 40 40] 794 list [update] [destroy .m1] 795} {{} {}} 796test winMenu-29.21 {TkpDrawMenuEntry - indicator} win { 797 catch {destroy .m1} 798 menu .m1 799 .m1 add checkbutton -label winMenu-31.20 800 .m1 invoke winMenu-31.20 801 set tearoff [tk::TearOffMenu .m1 40 40] 802 list [update] [destroy .m1] 803} {{} {}} 804test winMenu-29.22 {TkpDrawMenuEntry - indicator} win { 805 catch {destroy .m1} 806 menu .m1 807 .m1 add checkbutton -label winMenu-31.21 -hidemargin 1 808 .m1 invoke winMenu-31.21 809 set tearoff [tk::TearOffMenu .m1 40 40] 810 list [update] [destroy .m1] 811} {{} {}} 812 813test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType win} { 814 catch {destroy .m1} 815 catch {image delete image1} 816 menu .m1 817 image create test image1 818 .m1 add command -image image1 819 list [update idletasks] [destroy .m1] [image delete image1] 820} {{} {} {}} 821test winMenu-30.2 {GetMenuLabelGeometry - bitmap} win { 822 catch {destroy .m1} 823 menu .m1 824 .m1 add command -bitmap questhead 825 list [update idletasks] [destroy .m1] 826} {{} {}} 827test winMenu-30.3 {GetMenuLabelGeometry - no text} win { 828 catch {destroy .m1} 829 menu .m1 830 .m1 add command 831 list [update idletasks] [destroy .m1] 832} {{} {}} 833test winMenu-30.4 {GetMenuLabelGeometry - text} win { 834 catch {destroy .m1} 835 menu .m1 836 .m1 add command -label "This is a test." 837 list [update idletasks] [destroy .m1] 838} {{} {}} 839 840test winMenu-31.1 {DrawMenuEntryBackground} win { 841 catch {destroy .m1} 842 menu .m1 843 .m1 add command -label foo 844 set tearoff [tk::TearOffMenu .m1 40 40] 845 list [update] [destroy .m1] 846} {{} {}} 847test winMenu-31.2 {DrawMenuEntryBackground} win { 848 catch {destroy .m1} 849 menu .m1 850 .m1 add command -label foo 851 set tearoff [tk::TearOffMenu .m1 40 40] 852 $tearoff activate 0 853 list [update] [destroy .m1] 854} {{} {}} 855 856test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} win { 857 catch {destroy .m1} 858 menu .m1 859 list [update idletasks] [destroy .m1] 860} {{} {}} 861test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} win { 862 catch {destroy .m1} 863 menu .m1 864 .m1 add command -label "one" 865 list [update idletasks] [destroy .m1] 866} {{} {}} 867test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} win { 868 catch {destroy .m1} 869 menu .m1 870 .m1 add command -label "one" 871 .m1 add command -label "two" 872 list [update idletasks] [destroy .m1] 873} {{} {}} 874test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} win { 875 catch {destroy .m1} 876 menu .m1 877 .m1 add separator 878 list [update idletasks] [destroy .m1] 879} {{} {}} 880test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} { 881 catch {destroy .m1} 882 menubutton .mb -text "test" -menu .mb.m 883 menu .mb.m 884 .mb.m add command -label test 885 pack .mb 886 catch {tk::MbPost .mb} 887 list [update] [destroy .mb] 888} {{} {}} 889test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \ 890 win { 891 catch {destroy .m1} 892 menu .m1 893 .m1 add command -label "test" 894 list [update idletasks] [destroy .m1] 895} {{} {}} 896test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \ 897 win { 898 catch {destroy .m1} 899 menu .m1 -font "Helvetica 12" 900 .m1 add command -label "test" -font "Courier 12" 901 list [update idletasks] [destroy .m1] 902} {{} {}} 903test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} win { 904 catch {destroy .m1} 905 menu .m1 906 .m1 add command -label "test" 907 .m1 add command -label "test test" 908 list [update idletasks] [destroy .m1] 909} {{} {}} 910test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} win { 911 catch {destroy .m1} 912 menu .m1 913 .m1 add command -label "test test" 914 .m1 add command -label "test" 915 list [update idletasks] [destroy .m1] 916} {{} {}} 917test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} win { 918 catch {destroy .m1} 919 menu .m1 920 .m1 add command -label "test" -accel "Ctrl+S" 921 list [update idletasks] [destroy .m1] 922} {{} {}} 923test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} win { 924 catch {destroy .m1} 925 menu .m1 926 .m1 add command -label "test" -accel "1" 927 .m1 add command -label "test" -accel "1 1" 928 list [update idletasks] [destroy .m1] 929} {{} {}} 930test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} win { 931 catch {destroy .m1} 932 menu .m1 933 .m1 add command -label "test" -accel "1 1" 934 .m1 add command -label "test" -accel "1" 935 list [update idletasks] [destroy .m1] 936} {{} {}} 937test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} win { 938 catch {destroy .m1} 939 menu .m1 940 .m1 add checkbutton -label test 941 .m1 invoke 1 942 list [update idletasks] [destroy .m1] 943} {{} {}} 944test winMenu-32.14 \ 945 {TkpComputeStandardMenuGeometry - second indicator less or equal} \ 946 {testImageType win} { 947 catch {destroy .m1} 948 catch {image delete image1} 949 image create test image1 950 menu .m1 951 .m1 add checkbutton -image image1 952 .m1 invoke 1 953 .m1 add checkbutton -label test 954 .m1 invoke 2 955 list [update idletasks] [destroy .m1] [image delete image1] 956} {{} {} {}} 957test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \ 958 {testImageType unix} { 959 catch {destroy .m1} 960 catch {image delete image1} 961 image create test image1 962 menu .m1 963 .m1 add checkbutton -image image1 964 .m1 invoke 1 965 .m1 add checkbutton -label test 966 .m1 invoke 2 967 list [update idletasks] [destroy .m1] [image delete image1] 968} {{} {} {}} 969test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} win { 970 catch {destroy .m1} 971 menu .m1 -tearoff 0 972 list [update idletasks] [destroy .m1] 973} {{} {}} 974test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} win { 975 catch {destroy .m1} 976 menu .m1 977 .m1 add command -label one 978 .m1 add command -label two 979 .m1 add command -label three -columnbreak 1 980 list [update idletasks] [destroy .m1] 981} {{} {}} 982test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \ 983 win { 984 catch {destroy .m1} 985 menu .m1 -tearoff 0 986 .m1 add command -label one 987 .m1 add command -label two -columnbreak 1 988 .m1 add command -label three 989 list [update idletasks] [destroy .m1] 990} {{} {}} 991test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} win { 992 catch {destroy .m1} 993 menu .m1 -tearoff 0 994 .m1 add command -label one 995 .m1 add command -label two -columnbreak 1 996 .m1 add command -label three 997 .m1 add command -label four 998 .m1 add command -label five -columnbreak 1 999 .m1 add command -label six 1000 list [update idletasks] [destroy .m1] 1001} {{} {}} 1002 1003test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} win { 1004 catch {destroy .t2} 1005 catch {destroy .m1} 1006 toplevel .t2 -menu .m1 1007 wm geometry .t2 +0+0 1008 list [update idletasks] [destroy .t2] 1009} {{} {}} 1010test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} win { 1011 catch {destroy .t2} 1012 catch {destroy .m1} 1013 menu .m1 1014 menu .m1.system 1015 .m1 add cascade -menu .m1.system 1016 .m1.system add separator 1017 .m1.system add command -label foo 1018 toplevel .t2 -menu .m1 1019 wm geometry .t2 +0+0 1020 list [update idletasks] [destroy .m1] [destroy .t2] 1021} {{} {} {}} 1022 1023test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest win} {} {} 1024 1025# cleanup 1026deleteWindows 1027cleanupTests 1028return 1029