1# This file is a Tcl script to test drawing of menus in Tk. It is 2# organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1996-1997 Sun Microsystems, Inc. 5# Copyright (c) 1998-1999 by Scriptics Corporation. 6# All rights reserved. 7# 8# RCS: @(#) $Id$ 9 10package require tcltest 2.1 11eval tcltest::configure $argv 12tcltest::loadTestedCommands 13 14test menuDraw-1.1 {TkMenuInitializeDrawingFields} { 15 catch {destroy .m1} 16 list [menu .m1] [destroy .m1] 17} {.m1 {}} 18 19test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} { 20 catch {destroy .m1} 21 menu .m1 22 list [.m1 add command] [destroy .m1] 23} {{} {}} 24 25test menuDraw-3.1 {TkMenuFreeDrawOptions} { 26 catch {destroy .m1} 27 menu .m1 28 list [destroy .m1] 29} {{}} 30 31test menuDraw-4.1 {TkMenuEntryFreeDrawOptions} { 32 catch {destroy .m1} 33 menu .m1 34 .m1 add command -label "This is a test" 35 list [destroy .m1] 36} {{}} 37test menuDraw-4.2 {TkMenuEntryFreeDrawOptions} { 38 catch {destroy .m1} 39 menu .m1 40 .m1 add checkbutton -label "This is a test." -font "Courier 12" -activeforeground red -background green -selectcolor purple 41 list [destroy .m1] 42} {{}} 43 44test menuDraw-5.1 {TkMenuConfigureDrawOptions - new menu} { 45 catch {destroy .m1} 46 list [menu .m1] [destroy .m1] 47} {.m1 {}} 48test menuDraw-5.2 {TkMenuConfigureDrawOptions - old menu} { 49 catch {destroy .m1} 50 menu .m1 51 list [.m1 configure -fg red] [destroy .m1] 52} {{} {}} 53test menuDraw-5.3 {TkMenuConfigureDrawOptions - no disabledFg} { 54 catch {destroy .m1} 55 list [menu .m1 -disabledforeground ""] [destroy .m1] 56} {.m1 {}} 57 58test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} { 59 catch {destroy .m1} 60 menu .m1 61 list [.m1 add command -label "foo"] [destroy .m1] 62} {{} {}} 63test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} { 64 catch {destroy .m1} 65 menu .m1 66 list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1] 67} {{} {}} 68test menuDraw-6.3 {TkMenuConfigureEntryDrawOptions - active state - wrong entry} { 69 catch {destroy .m1} 70 menu .m1 71 .m1 add command -label "foo" 72 list [.m1 entryconfigure 1 -state active] [destroy .m1] 73} {{} {}} 74test menuDraw-6.4 {TkMenuConfigureEntryDrawOptions - active state - correct entry} { 75 catch {destroy .m1} 76 menu .m1 77 .m1 add command -label "foo" 78 .m1 activate 1 79 list [.m1 entryconfigure 1 -state active] [destroy .m1] 80} {{} {}} 81test menuDraw-6.5 {TkMenuConfigureEntryDrawOptions - deactivate entry} { 82 catch {destroy .m1} 83 menu .m1 84 .m1 add command -label "foo" 85 .m1 activate 1 86 list [.m1 entryconfigure 1 -state normal] [destroy .m1] 87} {{} {}} 88test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} { 89 catch {destroy .m1} 90 menu .m1 91 .m1 add command -label "foo" 92 list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1] 93} {1 {bad state "foo": must be active, normal, or disabled} {}} 94test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} { 95 catch {destroy .m1} 96 menu .m1 97 list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1] 98} {{} {}} 99test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} { 100 catch {destroy .m1} 101 menu .m1 102 list [.m1 add command -label "foo" -background "red"] [destroy .m1] 103} {{} {}} 104test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} { 105 catch {destroy .m1} 106 menu .m1 107 list [.m1 add command -label "foo" -foreground "red"] [destroy .m1] 108} {{} {}} 109test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} { 110 catch {destroy .m1} 111 menu .m1 112 list [.m1 add command -label "foo" -activebackground "red"] [destroy .m1] 113} {{} {}} 114test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} { 115 catch {destroy .m1} 116 menu .m1 117 list [.m1 add command -label "foo" -activeforeground "red"] [destroy .m1] 118} {{} {}} 119test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} { 120 catch {destroy .m1} 121 menu .m1 122 list [.m1 add radiobutton -label "foo" -selectcolor "red"] [destroy .m1] 123} {{} {}} 124test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} { 125 catch {destroy .m1} 126 menu .m1 127 .m1 add command -label "foo" -font "Helvetica 12" 128 list [.m1 entryconfigure 1 -font "Courier 12"] [destroy .m1] 129} {{} {}} 130test menuDraw-6.14 {TkMenuConfigureEntryDrawOptions - activeGC disposal} { 131 catch {destroy .m1} 132 menu .m1 133 .m1 add command -label "foo" -activeforeground "red" 134 list [.m1 entryconfigure 1 -activeforeground "green"] [destroy .m1] 135} {{} {}} 136test menuDraw-6.15 {TkMenuConfigureEntryDrawOptions - disabledGC disposal} { 137 catch {destroy .m1} 138 menu .m1 -disabledforeground "red" 139 .m1 add command -label "foo" 140 list [.m1 configure -disabledforeground "green"] [destroy .m1] 141} {{} {}} 142test menuDraw-6.16 {TkMenuConfigureEntryDrawOptions - indicatorGC disposal} { 143 catch {destroy .m1} 144 menu .m1 145 .m1 add radiobutton -label "foo" -selectcolor "red" 146 list [.m1 entryconfigure 1 -selectcolor "green"] [destroy .m1] 147} {{} {}} 148 149test menuDraw-7.1 {TkEventuallyRecomputeMenu} { 150 catch {destroy .m1} 151 menu .m1 152 .m1 add command -label "This is a long label" 153 set tearoff [tk::TearOffMenu .m1] 154 update idletasks 155 list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] 156} {{} {}} 157test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} { 158 catch {destroy .m1} 159 menu .m1 160 .m1 add command -label "This is a long label" 161 set tearoff [tk::TearOffMenu .m1] 162 list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] 163} {{} {}} 164 165 166test menuDraw-8.1 {TkRecomputeMenu} {win userInteraction} { 167 catch {destroy .m1} 168 menu .m1 169 .m1 configure -postcommand [.m1 add command -label foo] 170 .m1 add command -label "Hit ESCAPE to make this menu go away." 171 list [.m1 post 0 0] [destroy .m1] 172} {{} {}} 173 174 175test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} { 176 catch {destroy .m1} 177 catch {unset foo} 178 menu .m1 179 set foo 0 180 .m1 add radiobutton -variable foo -label test 181 tk::TearOffMenu .m1 182 update idletasks 183 list [set foo test] [destroy .m1] [unset foo] 184} {test {} {}} 185test menuDraw-9.2 {TkEventuallyRedrawMenu - whole menu} { 186 catch {destroy .m1} 187 menu .m1 188 list [catch {tk::TearOffMenu .m1}] [destroy .m1] 189} {0 {}} 190 191# Don't know how to test when window has been deleted and ComputeMenuGeometry 192# gets called. 193test menuDraw-10.1 {ComputeMenuGeometry - menubar} { 194 catch {destroy .m1} 195 menu .m1 196 .m1 add command -label test 197 . configure -menu .m1 198 list [update idletasks] [. configure -menu ""] [destroy .m1] 199} {{} {} {}} 200test menuDraw-10.2 {ComputeMenuGeometry - non-menubar} { 201 catch {destroy .m1} 202 menu .m1 203 .m1 add command -label test 204 list [update idletasks] [destroy .m1] 205} {{} {}} 206test menuDraw-10.3 {ComputeMenuGeometry - Resize necessary} { 207 catch {destroy .m1} 208 menu .m1 209 .m1 add command -label test 210 list [update idletasks] [destroy .m1] 211} {{} {}} 212test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} { 213 catch {destroy .m1} 214 menu .m1 215 .m1 add command -label test 216 update idletasks 217 .m1 entryconfigure 1 -label test 218 list [update idletasks] [destroy .m1] 219} {{} {}} 220 221test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} testImageType { 222 catch {destroy .m1} 223 catch {eval image delete [image names]} 224 image create test image1 225 image create test image2 226 menu .m1 227 .m1 add checkbutton -image image1 -selectimage image2 228 .m1 invoke 1 229 set tearoff [tk::TearOffMenu .m1 40 40] 230 update idletasks 231 list [image delete image2] [destroy .m1] [eval image delete [image names]] 232} {{} {} {}} 233test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} testImageType { 234 catch {destroy .m1} 235 catch {eval image delete [image names]} 236 image create test image1 237 image create test image2 238 menu .m1 239 .m1 add checkbutton -image image1 -selectimage image2 240 .m1 invoke 1 241 set tearoff [tk::TearOffMenu .m1 40 40] 242 list [image delete image2] [destroy .m1] [eval image delete [image names]] 243} {{} {} {}} 244test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} testImageType { 245 catch {destroy .m1} 246 catch {eval image delete [image names]} 247 image create test image1 248 image create test image2 249 menu .m1 250 .m1 add checkbutton -image image1 -selectimage image2 251 set tearoff [tk::TearOffMenu .m1 40 40] 252 update idletasks 253 list [image delete image2] [destroy .m1] [eval image delete [image names]] 254} {{} {} {}} 255 256#Don't know how to test missing tkwin in DisplayMenu 257test menuDraw-12.1 {DisplayMenu - menubar background} unix { 258 catch {destroy .m1} 259 menu .m1 260 .m1 add cascade -label foo -menu .m2 261 . configure -menu .m1 262 list [update] [. configure -menu ""] [destroy .m1] 263} {{} {} {}} 264test menuDraw-12.2 {Display menu - no entries} { 265 catch {destroy .m1} 266 menu .m1 267 set tearoff [tk::TearOffMenu .m1 40 40] 268 list [update] [destroy .m1] 269} {{} {}} 270test menuDraw-12.3 {DisplayMenu - one entry} { 271 catch {destroy .m1} 272 menu .m1 273 .m1 add command -label foo 274 set tearoff [tk::TearOffMenu .m1 40 40] 275 list [update] [destroy .m1] 276} {{} {}} 277test menuDraw-12.4 {DisplayMenu - two entries} { 278 catch {destroy .m1} 279 menu .m1 280 .m1 add command -label "one" 281 .m1 add command -label "two" 282 set tearoff [tk::TearOffMenu .m1 40 40] 283 list [update] [destroy .m1] 284} {{} {}} 285test menuDraw.12.5 {DisplayMenu - two columns - first bigger} { 286 catch {destroy .m1} 287 menu .m1 288 .m1 add command -label "one" 289 .m1 add command -label "two" 290 .m1 add command -label "three" -columnbreak 1 291 set tearoff [tk::TearOffMenu .m1 40 40] 292 list [update] [destroy .m1] 293} {{} {}} 294test menuDraw-12.5 {DisplayMenu - two column - second bigger} { 295 catch {destroy .m1} 296 menu .m1 297 .m1 add command -label "one" 298 .m1 add command -label "two" -columnbreak 1 299 .m1 add command -label "three" 300 set tearoff [tk::TearOffMenu .m1 40 40] 301 list [update] [destroy .m1] 302} {{} {}} 303test menuDraw.12.7 {DisplayMenu - three columns} { 304 catch {destroy .m1} 305 menu .m1 306 .m1 add command -label "one" 307 .m1 add command -label "two" -columnbreak 1 308 .m1 add command -label "three" 309 .m1 add command -label "four" 310 .m1 add command -label "five" 311 .m1 add command -label "six" 312 set tearoff [tk::TearOffMenu .m1 40 40] 313 list [update] [destroy .m1] 314} {{} {}} 315test menuDraw-12.6 {Display menu - testing for extra space and menubars} unix { 316 catch {destroy .m1} 317 menu .m1 318 .m1 add cascade -label foo 319 . configure -menu .m1 320 list [update] [. configure -menu ""] [destroy .m1] 321} {{} {} {}} 322test menuDraw-12.7 {Display menu - extra space at end of menu} { 323 catch {destroy .m1} 324 menu .m1 325 .m1 add cascade -label foo 326 set tearoff [tk::TearOffMenu .m1 40 40] 327 wm geometry $tearoff 200x100 328 list [update] [destroy .m1] 329} {{} {}} 330 331test menuDraw-13.1 {TkMenuEventProc - Expose} { 332 catch {destroy .m1} 333 catch {destroy .m2} 334 menu .m1 335 .m1 add command -label "one" 336 menu .m2 337 .m2 add command -label "two" 338 set tearoff1 [tk::TearOffMenu .m1 40 40] 339 set tearoff2 [tk::TearOffMenu .m2 40 40] 340 list [raise $tearoff2] [update] [destroy .m1] [destroy .m2] 341} {{} {} {} {}} 342test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} { 343 catch {destroy .m1} 344 menu .m1 345 .m1 add command -label "foo" 346 set tearoff [tk::TearOffMenu .m1 40 40] 347 list [wm geometry $tearoff 200x100] [update] [destroy .m1] 348} {{} {} {}} 349# Testing deletes is hard, and I am going to do my best. Don't know how 350# to test the case where we have already cleared the tkwin field in the 351# menuPtr. 352test menuDraw-13.4 {TkMenuEventProc - simple delete} { 353 catch {destroy .m1} 354 menu .m1 355 list [destroy .m1] 356} {{}} 357test menuDraw-13.5 {TkMenuEventProc - nothing pending} { 358 catch {destroy .m1} 359 menu .m1 360 .m1 add command -label foo 361 update idletasks 362 list [destroy .m1] 363} {{}} 364 365test menuDraw-14.1 {TkMenuImageProc} testImageType { 366 catch {destroy .m1} 367 catch {image delete image1} 368 menu .m1 369 image create test image1 370 .m1 add command -image image1 371 update idletasks 372 list [image delete image1] [destroy .m1] 373} {{} {}} 374test menuDraw-14.2 {TkMenuImageProc} testImageType { 375 catch {destroy .m1} 376 catch {image delete image1} 377 menu .m1 378 image create test image1 379 .m1 add command -image image1 380 list [image delete image1] [destroy .m1] 381} {{} {}} 382 383test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} { 384 catch {destroy .m1} 385 menu .m1 386 .m1 add command -label "foo" 387 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] 388} {0 {}} 389test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} { 390 catch {destroy .m1} 391 menu .m1 392 .m1 add command -label "foo" -state active 393 set tearoff [tk::TearOffMenu .m1 40 40] 394 list [$tearoff index active] [destroy .m1] 395} {none {}} 396test menuDraw-15.3 {TkPostTearoffMenu - post command} { 397 catch {destroy .m1} 398 catch {unset foo} 399 menu .m1 -postcommand "set foo .m1" 400 .m1 add command -label "foo" 401 list [catch {tk::TearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1] 402} {0 .m1 {} {}} 403test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} { 404 catch {destroy .m1} 405 menu .m1 -postcommand "destroy .m1" 406 .m1 add command -label "foo" 407 list [catch {tk::TearOffMenu .m1 40 40} msg] $msg [winfo exists .m1] 408} {0 {} 0} 409test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} { 410 catch {destroy .m1} 411 menu .m1 412 .m1 add command -label "foo" 413 set height [winfo screenheight .m1] 414 list [catch {tk::TearOffMenu .m1 40 $height}] [destroy .m1] 415} {0 {}} 416test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} { 417 catch {destroy .m1} 418 menu .m1 419 .m1 add command -label "foo" 420 set width [winfo screenwidth .m1] 421 list [catch {tk::TearOffMenu .m1 $width 40}] [destroy .m1] 422} {0 {}} 423 424 425test menuDraw-16.1 {TkPostSubmenu} nonUnixUserInteraction { 426 catch {destroy .m1} 427 catch {destroy .m2} 428 menu .m1 429 .m1 add cascade -label test -menu .m2 430 menu .m2 431 .m2 add command -label "Hit ESCAPE to make this menu go away." 432 set tearoff [tk::TearOffMenu .m1 40 40] 433 $tearoff postcascade 0 434 list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] 435} {{} {} {}} 436test menuDraw-16.2 {TkPostSubMenu} nonUnixUserInteraction { 437 catch {destroy .m1} 438 catch {destroy .m2} 439 catch {destroy .m3} 440 menu .m1 441 .m1 add cascade -label "two" -menu .m2 442 .m1 add cascade -label "three" -menu .m3 443 menu .m2 444 .m2 add command -label "two" 445 menu .m3 446 .m3 add command -label "three" 447 set tearoff [tk::TearOffMenu .m1 40 40] 448 $tearoff postcascade 0 449 list [$tearoff postcascade 1] [destroy .m1] [destroy .m2] [destroy .m3] 450} {{} {} {} {}} 451test menuDraw-16.3 {TkPostSubMenu} { 452 catch {destroy .m1} 453 menu .m1 454 .m1 add cascade -label test -menu .m2 455 list [.m1 postcascade 1] [destroy .m1] 456} {{} {}} 457test menuDraw-16.4 {TkPostSubMenu} { 458 catch {destroy .m1} 459 menu .m1 460 .m1 add cascade -label test 461 set tearoff [tk::TearOffMenu .m1 40 40] 462 list [$tearoff postcascade 0] [destroy .m1] 463} {{} {}} 464test menuDraw-16.5 {TkPostSubMenu} unix { 465 catch {destroy .m1} 466 catch {destroy .m2} 467 menu .m1 468 .m1 add cascade -label test -menu .m2 469 menu .m2 -postcommand "glorp" 470 set tearoff [tk::TearOffMenu .m1 40 40] 471 list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2] 472} {1 {invalid command name "glorp"} {} {}} 473test menuDraw-16.6 {TkPostSubMenu} {win userInteraction} { 474 catch {destroy .m1} 475 catch {destroy .m2} 476 menu .m1 477 .m1 add cascade -label test -menu .m2 478 menu .m2 479 .m2 add command -label "Hit ESCAPE to get rid of this menu" 480 set tearoff [tk::TearOffMenu .m1 40 40] 481 list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] 482} {{} {} {}} 483 484test menuDraw-17.1 {AdjustMenuCoords - menubar} unix { 485 catch {destroy .m1} 486 catch {destroy .m2} 487 menu .m1 -tearoff 0 488 .m1 add cascade -label test -menu .m2 489 menu .m2 -tearoff 0 490 .m2 add command -label foo 491 . configure -menu .m1 492 foreach w [winfo children .] { 493 if {[$w cget -type] == "menubar"} { 494 break 495 } 496 } 497 list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2] 498} {{} {} {} {}} 499test menuDraw-17.2 {AdjustMenuCoords - menu} {win userInteraction} { 500 catch {destroy .m1} 501 catch {destroy .m2} 502 menu .m1 503 .m1 add cascade -label test -menu .m2 504 menu .m2 505 .m2 add command -label "Hit ESCAPE to make this menu go away" 506 set tearoff [tk::TearOffMenu .m1 40 40] 507 list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] 508} {{} {} {}} 509 510# cleanup 511deleteWindows 512cleanupTests 513return 514