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