OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [menu.test] - Blame information for rev 1780

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test menus in Tk.  It is
2 
# organized in the standard fashion for Tcl tests.
3 
#
4 
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
5 
#
6 
# See the file "license.terms" for information on usage and redistribution
7 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
8 
#
9 
# RCS: @(#) $Id: menu.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
10 
 
11 
if {[lsearch [image types] test] < 0} {
12 
    puts "This application hasn't been compiled with the \"test\" image"
13 
    puts "type, so I can't run this test.  Are you sure you're using"
14 
    puts "tktest instead of wish?"
15 
    return
16 
}
17 
 
18 
if {[info procs test] != "test"} {
19 
    source defs
20 
}
21 
 
22 
if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
23 
    puts " Some tests were skipped because they could not be performed"
24 
    puts " automatically on this platform. If you wish to execute them"
25 
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
26 
    puts " the test."
27 
    set testConfig(menuInteractive) 0
28 
} else {
29 
    set testConfig(menuInteractive) 1
30 
}
31 
 
32 
proc deleteWindows {} {
33 
    foreach i [winfo children .] {
34 
        catch [destroy $i]
35 
    }
36 
}
37 
 
38 
deleteWindows
39 
wm geometry . {}
40 
raise .
41 
 
42 
test menu-1.1 {Tk_MenuCmd procedure} {
43 
    list [catch menu msg] $msg
44 
} {1 {wrong # args: should be "menu pathName ?options?"}}
45 
test menu-1.2 {Tk_MenuCmd procedure} {
46 
    list [catch "menu bogus" msg] $msg
47 
} {1 {bad window path name "bogus"}}
48 
test menu-1.3 {Tk_MenuCmd procedure} {
49 
    list [catch "menu .m1 foo" msg] $msg
50 
} {1 {unknown option "foo"}}
51 
test menu-1.4 {Tk_MenuCmd procedure} {
52 
    catch {destroy .m1}
53 
    list [catch {menu .m1} msg] $msg [destroy .m1]
54 
} {0 .m1 {}}
55 
test menu-1.5 {Tk_MenuCmd - creating menubar} {
56 
    catch {destroy .m1}
57 
    menu .m1
58 
    .m1 add cascade -label Test -menu ""
59 
    list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
60 
} {{} {} {}}
61 
test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} {
62 
    catch {destroy .t2}
63 
    catch {destroy .m1}
64 
    toplevel .t2 -menu .m1
65 
    wm geometry .t2 +0+0
66 
    list [catch {menu .m1} msg] $msg [destroy .m1 .t2]
67 
} {0 .m1 {}}
68 
test menu-1.7 {Tk_MenuCmd procedure one clone cascade} {
69 
    catch {destroy .m1}
70 
    catch {destroy .m2}
71 
    catch {destroy .t2}
72 
    toplevel .t2 -menu .m1
73 
    wm geometry .t2 +0+0
74 
    menu .m1
75 
    .m1 add cascade -menu .m2
76 
    list [catch {menu .m2} msg] $msg [destroy .t2 .m1 .m2]
77 
} {0 .m2 {}}
78 
test menu-1.8 {Tk_MenuCmd procedure two clone cascades} {
79 
    catch {destroy .m1}
80 
    catch {destroy .t2}
81 
    catch {destroy .t3}
82 
    catch {destroy .m2}
83 
    menu .m1
84 
    .m1 add cascade -menu .m2
85 
    toplevel .t2 -menu .m1
86 
    wm geometry .t2 +0+0
87 
    toplevel .t3 -menu .m1
88 
    wm geometry .t3 +0+0
89 
    list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
90 
} {0 .m2 {}}
91 
test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} {
92 
    catch {destroy .t2}
93 
    catch {destroy .m1}
94 
    catch {destroy .t3}
95 
    catch {destroy .m2}
96 
    toplevel .t2 -menu .m1
97 
    wm geometry .t2 +0+0
98 
    menu .m1
99 
    .m1 add cascade -menu .m2
100 
    toplevel .t3 -menu .m1
101 
    wm geometry .t3 +0+0
102 
    list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
103 
} {0 .m2 {}}
104 
test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} {
105 
    catch {destroy .t2}
106 
    catch {destroy .t3}
107 
    catch {destroy .m1}
108 
    catch {destroy .m2}
109 
    toplevel .t2 -menu .m1
110 
    wm geometry .t2 +0+0
111 
    toplevel .t3 -menu .m1
112 
    wm geometry .t3 +0+0
113 
    menu .m1
114 
    .m1 add cascade -menu .m2
115 
    list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
116 
} {0 .m2 {}}
117 
test menu-1.11 {Tk_MenuCmd procedure three clones cascades} {
118 
    catch {destroy .t2}
119 
    catch {destroy .t3}
120 
    catch {destroy .t4}
121 
    catch {destroy .m1}
122 
    catch {destroy .m2}
123 
    toplevel .t2 -menu .m1
124 
    wm geometry .t2 +0+0
125 
    toplevel .t3 -menu .m1
126 
    wm geometry .t3 +0+0
127 
    toplevel .t4 -menu .m1
128 
    wm geometry .t4 +0+0
129 
    menu .m1
130 
    .m1 add cascade -menu .m2
131 
    list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .t4 .m1 .m2]
132 
} {0 .m2 {}}
133 
test menu-1.12 {Tk_MenuCmd procedure} {
134 
    catch {destroy .t2}
135 
    catch {destroy .m1}
136 
    toplevel .t2 -menu .m1
137 
    wm geometry .t2 +0+0
138 
    list [catch {menu .m1} msg] $msg [destroy .t2 .m1]
139 
} {0 .m1 {}}
140 
test menu-1.13 {Tk_MenuCmd procedure} {
141 
    catch {destroy .t2}
142 
    catch {destroy .t3}
143 
    catch {destroy .m1}
144 
    toplevel .t2 -menu .m1
145 
    wm geometry .t2 +0+0
146 
    toplevel .t3 -menu .m1
147 
    wm geometry .t3 +0+0
148 
    list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .m1]
149 
} {0 .m1 {}}
150 
test menu-1.14 {Tk_MenuCmd procedure} {
151 
    catch {destroy .t2}
152 
    catch {destroy .t3}
153 
    catch {destroy .t4}
154 
    catch {destroy .m1}
155 
    toplevel .t2 -menu .m1
156 
    wm geometry .t2 +0+0
157 
    toplevel .t3 -menu .m1
158 
    wm geometry .t3 +0+0
159 
    toplevel .t4 -menu .m1
160 
    wm geometry .t4 +0+0
161 
    list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1]
162 
} {0 .m1 {}}
163 
 
164 
catch {destroy .m1}
165 
menu .m1
166 
set i 1
167 
foreach test {
168 
    {-activebackground #012345 #012345 non-existent
169 
            {unknown color name "non-existent"}}
170 
    {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
171 
    {-activeforeground #ff0000 #ff0000 non-existent
172 
            {unknown color name "non-existent"}}
173 
    {-background #ff0000 #ff0000 non-existent
174 
            {unknown color name "non-existent"}}
175 
    {-bg #110022 #110022 bogus {unknown color name "bogus"}}
176 
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
177 
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
178 
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
179 
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
180 
    {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
181 
            -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
182 
            {font "" doesn't exist}}
183 
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
184 
    {-postcommand "any old string" "any old string" {} {}}
185 
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
186 
    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
187 
    {-takefocus "any string" "any string" {} {}}
188 
    {-tearoff 0 0}
189 
    {-tearoff 1 1}
190 
    {-tearoffcommand "any old string" "any old string" {} {}}
191 
} {
192 
    set name [lindex $test 0]
193 
    test menu-2.$i {configuration options} {
194 
        .m1 configure $name [lindex $test 1]
195 
        lindex [.m1 configure $name] 4
196 
    } [lindex $test 2]
197 
    incr i
198 
    if {[lindex $test 3] != ""} {
199 
        test menu-2.$i {configuration options} {
200 
            list [catch {.m1 configure $name [lindex $test 3]} msg] $msg
201 
        } [list 1 [lindex $test 4]]
202 
    }
203 
    .m1 configure $name [lindex [.m1 configure $name] 3]
204 
    incr i
205 
}
206 
destroy .m1
207 
 
208 
# We need to test all of the options with all of the different types of
209 
# menu entries. The following code sets up .m1 with 6 items. It then
210 
# runs through the big table below it.
211 
# index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton,
212 
# 5 radiobutton
213 
 
214 
menu .m1
215 
.m1 add command -label "command"
216 
menu .m2
217 
.m2 add command -label "test"
218 
.m1 add cascade -label "cascade" -menu .m2
219 
.m1 add separator
220 
.m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
221 
.m1 add radiobutton -label "radiobutton" -variable radio
222 
image create photo image1 -file [file join $tk_library demos images earth.gif]
223 
 
224 
foreach test {
225 
    {-activebackground
226 
        {{#012345
227 
            {{unknown option "-activebackground"} #012345 #012345
228 
            {unknown option "-activebackground"} #012345 #012345
229 
            }
230 
        }
231 
        {non-existent
232 
            {{unknown option "-activebackground"}
233 
            {unknown color name "non-existent"}
234 
            {unknown color name "non-existent"}
235 
            {unknown option "-activebackground"}
236 
            {unknown color name "non-existent"}
237 
            {unknown color name "non-existent"}
238 
            }
239 
        }}
240 
    }
241 
    {-activeforeground
242 
        {{#ff0000
243 
            {{unknown option "-activeforeground"}
244 
            #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
245 
            }
246 
        }
247 
        {non-existent
248 
            {{unknown option "-activeforeground"}
249 
            {unknown color name "non-existent"}
250 
            {unknown color name "non-existent"}
251 
            {unknown option "-activeforeground"}
252 
            {unknown color name "non-existent"}
253 
            {unknown color name "non-existent"}
254 
            }
255 
        }}
256 
    }
257 
    {-accelerator
258 
        {{"Ctrl+S"
259 
            {{unknown option "-accelerator"}
260 
            "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"}
261 
            "Ctrl+S" "Ctrl+S"
262 
            }
263 
        }}
264 
    }
265 
    {-background
266 
        {{#ff0000
267 
            {#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000
268 
            }
269 
        }
270 
        {non-existent
271 
            {{unknown color name "non-existent"}
272 
            {unknown color name "non-existent"}
273 
            {unknown color name "non-existent"}
274 
            {unknown color name "non-existent"}
275 
            {unknown color name "non-existent"}
276 
            {unknown color name "non-existent"}
277 
            }
278 
        }}
279 
    }
280 
    {-bitmap
281 
        {{questhead
282 
            {{unknown option "-bitmap"} questhead questhead
283 
            {unknown option "-bitmap"} questhead questhead
284 
            }
285 
        }
286 
        {badValue
287 
            {{unknown option "-bitmap"}
288 
            {bitmap "badValue" not defined}
289 
            {bitmap "badValue" not defined}
290 
            {unknown option "-bitmap"}
291 
            {bitmap "badValue" not defined}
292 
            {bitmap "badValue" not defined}
293 
            }
294 
        }}
295 
    }
296 
    {-columnbreak
297 
        {{1
298 
            {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1}
299 
        }}
300 
    }
301 
    {-command
302 
        {{beep
303 
            {{unknown option "-command"} beep beep
304 
            {unknown option "-command"} beep beep
305 
            }
306 
        }}
307 
    }
308 
    {-font
309 
        {{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
310 
            {{unknown option "-font"}
311 
            -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
312 
            -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
313 
            {unknown option "-font"}
314 
            -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
315 
            -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
316 
            }
317 
        }
318 
        {{kill rock stars}
319 
            {{unknown option "-font"}
320 
            {expected integer but got "rock"}
321 
            {expected integer but got "rock"}
322 
            {unknown option "-font"}
323 
            {expected integer but got "rock"}
324 
            {expected integer but got "rock"}
325 
            }
326 
        }}
327 
    }
328 
    {-foreground
329 
        {{#110022
330 
            {{unknown option "-foreground"} #110022 #110022
331 
            {unknown option "-foreground"} #110022 #110022
332 
            }
333 
        }
334 
        {non-existent
335 
            {{unknown option "-foreground"}
336 
            {unknown color name "non-existent"}
337 
            {unknown color name "non-existent"}
338 
            {unknown option "-foreground"}
339 
            {unknown color name "non-existent"}
340 
            {unknown color name "non-existent"}
341 
            }
342 
        }}
343 
    }
344 
    {-image
345 
        {{image1
346 
            {{unknown option "-image"} image1 image1
347 
            {unknown option "-image"} image1 image1
348 
            }
349 
        }
350 
        {bogus
351 
            {{unknown option "-image"}
352 
            {image "bogus" doesn't exist}
353 
            {image "bogus" doesn't exist}
354 
            {unknown option "-image"}
355 
            {image "bogus" doesn't exist}
356 
            {image "bogus" doesn't exist}
357 
            }
358 
        }
359 
        {""
360 
            {{unknown option "-image"}
361 
            {}
362 
            {}
363 
            {unknown option "-image"}
364 
            {}
365 
            {}
366 
            }
367 
        }}
368 
    }
369 
    {-indicatoron
370 
        {{1
371 
            {{unknown option "-indicatoron"}
372 
            {unknown option "-indicatoron"}
373 
            {unknown option "-indicatoron"}
374 
            {unknown option "-indicatoron"} 1 1
375 
            }
376 
        }}
377 
    }
378 
    {-label
379 
        {{test
380 
            {{unknown option "-label"} test test
381 
            {unknown option "-label"} test test
382 
            }
383 
        }}
384 
    }
385 
    {-menu
386 
        {{.m2
387 
            {{unknown option "-menu"}
388 
            {unknown option "-menu"} .m2
389 
            {unknown option "-menu"}
390 
            {unknown option "-menu"}
391 
            {unknown option "-menu"}
392 
            }
393 
        }}
394 
    }
395 
    {-offvalue
396 
        {{off
397 
            {{unknown option "-offvalue"}
398 
            {unknown option "-offvalue"}
399 
            {unknown option "-offvalue"}
400 
            {unknown option "-offvalue"}
401 
            off
402 
            {unknown option "-offvalue"}
403 
            }
404 
        }}
405 
    }
406 
    {-onvalue
407 
        {{on
408 
            {{unknown option "-onvalue"}
409 
            {unknown option "-onvalue"}
410 
            {unknown option "-onvalue"}
411 
            {unknown option "-onvalue"}
412 
            on
413 
            {unknown option "-onvalue"}
414 
            }
415 
        }}
416 
    }
417 
    {-selectcolor
418 
        {{#110022
419 
            {{unknown option "-selectcolor"}
420 
            {unknown option "-selectcolor"}
421 
            {unknown option "-selectcolor"}
422 
            {unknown option "-selectcolor"}
423 
            #110022
424 
            #110022
425 
            }
426 
        }
427 
        {non-existent
428 
            {{unknown option "-selectcolor"}
429 
            {unknown option "-selectcolor"}
430 
            {unknown option "-selectcolor"}
431 
            {unknown option "-selectcolor"}
432 
            {unknown color name "non-existent"}
433 
            {unknown color name "non-existent"}
434 
            }
435 
        }}
436 
    }
437 
    {-selectimage
438 
        {{image1
439 
            {{unknown option "-selectimage"}
440 
            {unknown option "-selectimage"}
441 
            {unknown option "-selectimage"}
442 
            {unknown option "-selectimage"} image1 image1
443 
            }
444 
        }
445 
        {bogus
446 
            {{unknown option "-selectimage"}
447 
            {unknown option "-selectimage"}
448 
            {unknown option "-selectimage"}
449 
            {unknown option "-selectimage"}
450 
            {image "bogus" doesn't exist}
451 
            {image "bogus" doesn't exist}
452 
            }
453 
        }
454 
        {""
455 
            {{unknown option "-selectimage"}
456 
            {unknown option "-selectimage"}
457 
            {unknown option "-selectimage"}
458 
            {unknown option "-selectimage"}
459 
            {}
460 
            {}
461 
            }
462 
        }}
463 
    }
464 
    {-state
465 
        {{normal
466 
            {normal normal normal
467 
            {unknown option "-state"} normal normal
468 
            }
469 
        }}
470 
    }
471 
    {-value
472 
        {{"any string"
473 
            {{unknown option "-value"}
474 
            {unknown option "-value"}
475 
            {unknown option "-value"}
476 
            {unknown option "-value"}
477 
            {unknown option "-value"} "any string"
478 
            }
479 
        }}
480 
    }
481 
    {-variable
482 
        {{"any string"
483 
            {{unknown option "-variable"}
484 
            {unknown option "-variable"}
485 
            {unknown option "-variable"}
486 
            {unknown option "-variable"}
487 
            "any string"
488 
            "any string"
489 
            }
490 
        }}
491 
    }
492 
    {-underline
493 
        {{0
494 
            {{unknown option "-underline"} 0 0
495 
            {unknown option "-underline"} 0 0
496 
            }
497 
        }
498 
        {3p
499 
            {{unknown option "-underline"}
500 
            {expected integer but got "3p"}
501 
            {expected integer but got "3p"}
502 
            {unknown option "-underline"}
503 
            {expected integer but got "3p"}
504 
            {expected integer but got "3p"}
505 
            }
506 
        }}
507 
    }
508 
} {
509 
    set name [lindex $test 0]
510 
    foreach attempt [lindex $test 1] {
511 
        set value [lindex $attempt 0]
512 
        set options [lindex $attempt 1]
513 
        foreach item {0 1 2 3 4 5} {
514 
            catch {unset msg}
515 
            test menu-2.$i [list entry configuration options $name $item $value] {
516 
                set result [catch {.m1 entryconfigure $item $name $value} msg]
517 
                if {$result == 1} {
518 
                    set msg
519 
                } else {
520 
                    lindex [.m1 entryconfigure $item $name] 4
521 
                }
522 
            } [lindex $options $item]
523 
            incr i
524 
        }
525 
    }
526 
}
527 
 
528 
image delete image1
529 
destroy .m1
530 
destroy .m2
531 
 
532 
test menu-3.1 {MenuWidgetCmd procedure} {
533 
    catch {destroy .m1}
534 
    menu .m1
535 
    list [catch {.m1} msg] $msg [destroy .m1]
536 
} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
537 
test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
538 
    catch {destroy .m1}
539 
    menu .m1 -postcommand "destroy .m1"
540 
    .m1 add command -label "menu-3.2: Hit Escape"
541 
    list [catch {.m1 post 40 40} msg] $msg
542 
} {0 {}}
543 
test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
544 
    catch {destroy .m1}
545 
    menu .m1
546 
    .m1 add command -label "test"
547 
    list [catch {.m1 activate} msg] $msg [destroy .m1]
548 
} {1 {wrong # args: should be ".m1 activate index"} {}}
549 
test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
550 
    catch {destroy .m1}
551 
    menu .m1
552 
    list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
553 
} {1 {bad menu entry index "foo"} {}}
554 
test menu-3.5 {MenuWidgetCmd procedure, "activate" option}  {
555 
    catch {destroy .m1}
556 
    menu .m1
557 
    .m1 add command -label "test"
558 
    .m1 add separator
559 
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
560 
} {0 {} {}}
561 
test menu-3.6 {MenuWidgetCmd procedure, "activate" option}  {
562 
    catch {destroy .m1}
563 
    menu .m1
564 
    .m1 add command -label "test"
565 
    .m1 entryconfigure 1 -state disabled
566 
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
567 
} {0 {} {}}
568 
test menu-3.7 {MenuWidgetCmd procedure, "activate" option}  {
569 
    catch {destroy .m1}
570 
    menu .m1
571 
    .m1 add command -label "test"
572 
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
573 
} {0 {} {}}
574 
test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
575 
    catch {destroy .m1}
576 
    menu .m1
577 
    list [catch {.m1 add} msg] $msg [destroy .m1]
578 
} {1 {wrong # args: should be ".m1 add type ?options?"} {}}
579 
test menu-3.9 {MenuWidgetCmd procedure, "add" option} {
580 
    catch {destroy .m1}
581 
    menu .m1
582 
    list [catch {.m1 add foo} msg] $msg [destroy .m1]
583 
} {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}}
584 
test menu-3.10 {MenuWidgetCmd procedure, "add" option} {
585 
    catch {destroy .m1}
586 
    menu .m1
587 
    list [catch {.m1 add separator} msg] $msg [destroy .m1]
588 
} {0 {} {}}
589 
test menu-3.11 {MenuWidgetCmd procedure, "cget" option} {
590 
    catch {destroy .m1}
591 
    menu .m1
592 
    list [catch {.m1 cget} msg] $msg [destroy .m1]
593 
} {1 {wrong # args: should be ".m1 cget option"} {}}
594 
test menu-3.12 {MenuWidgetCmd procedure, "cget" option} {
595 
    catch {destroy .m1}
596 
    menu .m1
597 
    list [catch {.m1 cget -gorp} msg] $msg [destroy .m1]
598 
} {1 {unknown option "-gorp"} {}}
599 
test menu-3.13 {MenuWidgetCmd procedure, "cget" option} {
600 
    catch {destroy .m1}
601 
    menu .m1
602 
    .m1 configure -postcommand "Some string"
603 
    list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1]
604 
} {0 {Some string} {}}
605 
test menu-3.14 {MenuWidgetCmd procedure, "clone" option} {
606 
    catch {destroy .m1}
607 
    menu .m1
608 
    list [catch {.m1 clone} msg] $msg [destroy .m1]
609 
} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
610 
test menu-3.15 {MenuWidgetCmd procedure, "clone" option} {
611 
    catch {destroy .m1}
612 
    menu .m1
613 
    list [catch {.m1 clone a b c d} msg] $msg [destroy .m1]
614 
} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
615 
test menu-3.16 {MenuWidgetCmd procedure, "clone" option} {
616 
    catch {destroy .m1}
617 
    menu .m1
618 
    list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1]
619 
} {0 {} {}}
620 
test menu-3.17 {MenuWidgetCmd procedure, "clone" option} {
621 
    catch {destroy .m1}
622 
    menu .m1
623 
    list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1]
624 
} {0 {} {}}
625 
test menu-3.18 {MenuWidgetCmd procedure, "configure" option} {
626 
    catch {destroy .m1}
627 
    menu .m1
628 
    list [catch {llength [.m1 configure]} msg] $msg [destroy .m1]
629 
} {0 20 {}}
630 
test menu-3.19 {MenuWidgetCmd procedure, "configure" option} {
631 
    catch {destroy .m1}
632 
    menu .m1
633 
    list [catch {.m1 configure -gorp} msg] $msg [destroy .m1]
634 
} {1 {unknown option "-gorp"} {}}
635 
test menu-3.20 {MenuWidgetCmd procedure, "configure" option} {
636 
    catch {destroy .m1}
637 
    menu .m1
638 
    list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1]
639 
} {0 {} {}}
640 
test menu-3.21 {MenuWidgetCmd procedure, "configure" option} {
641 
    catch {destroy .m1}
642 
    menu .m1
643 
    .m1 configure -postcommand "Another string"
644 
    list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1]
645 
} {0 {Another string} {}}
646 
test menu-3.22 {MenuWidgetCmd procedure, "delete" option} {
647 
    catch {destroy .m1}
648 
    menu .m1
649 
    list [catch {.m1 delete} msg] $msg [destroy .m1]
650 
} {1 {wrong # args: should be ".m1 delete first ?last?"} {}}
651 
test menu-3.23 {MenuWidgetCmd procedure, "delete" option} {
652 
    catch {destroy .m1}
653 
    menu .m1
654 
    list [catch {.m1 delete foo} msg] $msg [destroy .m1]
655 
} {1 {bad menu entry index "foo"} {}}
656 
test menu-3.24 {MenuWidgetCmd procedure, "delete" option} {
657 
    catch {destroy .m1}
658 
    menu .m1
659 
    list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1]
660 
} {1 {bad menu entry index "foo"} {}}
661 
test menu-3.25 {MenuWidgetCmd procedure, "delete" option} {
662 
    catch {destroy .m1}
663 
    menu .m1
664 
    list [catch {.m1 delete 0} msg] $msg [destroy .m1]
665 
} {0 {} {}}
666 
test menu-3.26 {MenuWidgetCmd procedure, "delete" option} {
667 
    catch {destroy .m1}
668 
    menu .m1
669 
    .m1 add command -label "foo"
670 
    list [catch {.m1 delete 1 0} msg] $msg [destroy .m1]
671 
} {0 {} {}}
672 
test menu-3.27 {MenuWidgetCmd procedure, "delete" option} {
673 
    catch {destroy .m1}
674 
    menu .m1
675 
    .m1 add command -label "1"
676 
    .m1 add command -label "2"
677 
    .m1 add command -label "3"
678 
    list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
679 
} {0 {} {}}
680 
test menu-3.28 {MenuWidgetCmd procedure, "delete" option} {
681 
    catch {destroy .m1}
682 
    menu .m1
683 
    .m1 add command -label "1"
684 
    .m1 add command -label "2"
685 
    .m1 add command -label "3"
686 
    .m1 activate 2
687 
    list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
688 
} {0 {} {}}
689 
test menu-3.29 {MenuWidgetCmd procedure, "delete" option} {
690 
    catch {destroy .m1}
691 
    menu .m1
692 
    .m1 add command -label "1"
693 
    .m1 add command -label "2"
694 
    .m1 add command -label "3"
695 
    .m1 activate 3
696 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
697 
} {0 {} {}}
698 
test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} {
699 
    catch {destroy .m1}
700 
    menu .m1
701 
    list [catch {.m1 entrycget} msg] $msg [destroy .m1]
702 
} {1 {wrong # args: should be ".m1 entrycget index option"} {}}
703 
test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} {
704 
    catch {destroy .m1}
705 
    menu .m1
706 
    list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1]
707 
} {1 {wrong # args: should be ".m1 entrycget index option"} {}}
708 
test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} {
709 
    catch {destroy .m1}
710 
    menu .m1
711 
    list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1]
712 
} {1 {bad menu entry index "foo"} {}}
713 
test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} {
714 
    catch {destroy .m1}
715 
    menu .m1
716 
    .m1 add command -label "test"
717 
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
718 
} {0 test {}}
719 
test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} {
720 
    catch {destroy .m1}
721 
    menu .m1
722 
    list [catch {.m1 entryconfigure} msg] $msg [destroy .m1]
723 
} {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}}
724 
test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} {
725 
    catch {destroy .m1}
726 
    menu .m1
727 
    list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1]
728 
} {1 {bad menu entry index "foo"} {}}
729 
test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} {
730 
    catch {destroy .m1}
731 
    menu .m1
732 
    .m1 add command -label "test"
733 
    list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1]
734 
} {0 14 {}}
735 
test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} {
736 
    catch {destroy .m1}
737 
    menu .m1
738 
    .m1 add command -label "test"
739 
    list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
740 
} {0 test {}}
741 
test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} {
742 
    catch {destroy .m1}
743 
    menu .m1
744 
    .m1 add command -label "test"
745 
    .m1 entryconfigure 1 -label "changed"
746 
    list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
747 
} {0 changed {}}
748 
test menu-3.39 {MenuWidgetCmd procedure, "index" option} {
749 
    catch {destroy .m1}
750 
    menu .m1
751 
    list [catch {.m1 index} msg] $msg [destroy .m1]
752 
} {1 {wrong # args: should be ".m1 index string"} {}}
753 
test menu-3.40 {MenuWidgetCmd procedure, "index" option} {
754 
    catch {destroy .m1}
755 
    menu .m1
756 
    list [catch {.m1 index foo} msg] $msg [destroy .m1]
757 
} {1 {bad menu entry index "foo"} {}}
758 
test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
759 
    catch {destroy .m1}
760 
    menu .m1
761 
    .m1 add command -label "test"
762 
    list [catch {.m1 index "test"} msg] $msg [destroy .m1]
763 
} {0 1 {}}
764 
test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
765 
    catch {destroy .m1}
766 
    menu .m1
767 
    list [catch {.m1 insert} msg] $msg [destroy .m1]
768 
} {1 {wrong # args: should be ".m1 insert index type ?options?"} {}}
769 
test menu-3.43 {MenuWidgetCmd procedure, "insert" option} {
770 
    catch {destroy .m1}
771 
    menu .m1
772 
    .m1 insert 1 command -label "test"
773 
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
774 
} {0 test {}}
775 
test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} {
776 
    catch {destroy .m1}
777 
    menu .m1
778 
    list [catch {.m1 invoke} msg] $msg [destroy .m1]
779 
} {1 {wrong # args: should be ".m1 invoke index"} {}}
780 
test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} {
781 
    catch {destroy .m1}
782 
    menu .m1
783 
    list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
784 
} {1 {bad menu entry index "foo"} {}}
785 
test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} {
786 
    catch {destroy .m1}
787 
    catch {unset foo}
788 
    menu .m1
789 
    .m1 add command -label "set foo" -command "set foo hello"
790 
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
791 
} {0 hello 0 hello 0 {} {}}
792 
test menu-3.47 {MenuWidgetCmd procedure, "post" option} {
793 
    catch {destroy .m1}
794 
    menu .m1
795 
    .m1 add command -label "On Windows, hit Escape to get this menu to go away"
796 
    list [catch {.m1 post} msg] $msg [destroy .m1]
797 
} {1 {wrong # args: should be ".m1 post x y"} {}}
798 
test menu-3.48 {MenuWidgetCmd procedure, "post" option} {
799 
    catch {destroy .m1}
800 
    menu .m1
801 
    list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
802 
} {1 {expected integer but got "foo"} {}}
803 
test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
804 
    catch {destroy .m1}
805 
    menu .m1
806 
    list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
807 
} {1 {expected integer but got "bar"} {}}
808 
test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
809 
    catch {destroy .m1}
810 
    menu .m1
811 
    .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
812 
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
813 
} {0 {} {}}
814 
test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
815 
    catch {destroy .m1}
816 
    menu .m1
817 
    list [catch {.m1 postcascade} msg] $msg [destroy .m1]
818 
} {1 {wrong # args: should be ".m1 postcascade index"} {}}
819 
test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
820 
    catch {destroy .m1}
821 
    menu .m1
822 
    list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
823 
} {1 {bad menu entry index "foo"} {}}
824 
test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {menuInteractive} {
825 
    catch {destroy .m1}
826 
    catch {destroy .m2}
827 
    menu .m1
828 
    .m1 add command -label "menu-3.56 - hit Escape"
829 
    menu .m2
830 
    .m1 post 40 40
831 
    .m1 add cascade -menu .m2
832 
    list [catch {.m1 postcascade 1} msg] $msg [destroy .m1 .m2]
833 
} {0 {} {}}
834 
test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} {
835 
    catch {destroy .m1}
836 
    catch {destroy .m2}
837 
    menu .m1
838 
    menu .m2
839 
    .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape"
840 
    .m1 postcascade 1
841 
    list [catch {.m1 postcascade none} msg] $msg [destroy .m1 .m2]
842 
} {0 {} {}}
843 
test menu-3.55 {MenuWidgetCmd procedure, "type" option} {
844 
    catch {destroy .m1}
845 
    menu .m1
846 
    list [catch {.m1 type} msg] $msg [destroy .m1]
847 
} {1 {wrong # args: should be ".m1 type index"} {}}
848 
test menu-3.56 {MenuWidgetCmd procedure, "type" option} {
849 
    catch {destroy .m1}
850 
    menu .m1
851 
    list [catch {.m1 type foo} msg] $msg [destroy .m1]
852 
} {1 {bad menu entry index "foo"} {}}
853 
test menu-3.57 {MenuWidgetCmd procedure, "type" option} {
854 
    catch {destroy .m1}
855 
    menu .m1
856 
    .m1 add command -label "test"
857 
    list [catch {.m1 type 1} msg] $msg [destroy .m1]
858 
} {0 command {}}
859 
test menu-3.58 {MenuWidgetCmd procedure, "type" option} {
860 
    catch {destroy .m1}
861 
    menu .m1
862 
    .m1 add separator
863 
    list [catch {.m1 type 1} msg] $msg [destroy .m1]
864 
} {0 separator {}}
865 
test menu-3.59 {MenuWidgetCmd procedure, "type" option} {
866 
    catch {destroy .m1}
867 
    menu .m1
868 
    .m1 add checkbutton -label "test"
869 
    list [catch {.m1 type 1} msg] $msg [destroy .m1]
870 
} {0 checkbutton {}}
871 
test menu-3.60 {MenuWidgetCmd procedure, "type" option} {
872 
    catch {destroy .m1}
873 
    menu .m1
874 
    .m1 add radiobutton -label "test"
875 
    list [catch {.m1 type 1} msg] $msg [destroy .m1]
876 
} {0 radiobutton {}}
877 
test menu-3.61 {MenuWidgetCmd procedure, "type" option} {
878 
    catch {destroy .m1}
879 
    menu .m1
880 
    .m1 add cascade -label "test"
881 
    list [catch {.m1 type 1} msg] $msg [destroy .m1]
882 
} {0 cascade {}}
883 
test menu-3.62 {MenuWidgetCmd procedure, "type" option} {
884 
    catch {destroy .m1}
885 
    menu .m1
886 
    list [catch {.m1 type 0} msg] $msg [destroy .m1]
887 
} {0 tearoff {}}
888 
test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
889 
    catch {destroy .m1}
890 
    menu .m1
891 
    list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
892 
} {1 {wrong # args: should be ".m1 unpost"} {}}
893 
test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {menuInteractive} {
894 
    catch {destroy .m1}
895 
    menu .m1
896 
    .m1 add command -label "menu-3.68 - hit Escape"
897 
    .m1 post 40 40
898 
    list [catch {.m1 unpost} msg] $msg [destroy .m1]
899 
} {0 {} {}}
900 
test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {
901 
    catch {destroy .m1}
902 
    menu .m1
903 
    list [catch {.m1 yposition} msg] $msg [destroy .m1]
904 
} {1 {wrong # args: should be ".m1 yposition index"} {}}
905 
test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} {
906 
    catch {destroy .m1}
907 
    menu .m1
908 
    list [catch {.m1 yposition 1}] [destroy .m1]
909 
} {0 {}}
910 
test menu-3.67 {MenuWidgetCmd procedure, bad option} {
911 
    catch {destroy .m1}
912 
    menu .m1
913 
    list [catch {.m1 foo} msg] $msg [destroy .m1]
914 
} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
915 
 
916 
test menu-4.1 {TkInvokeMenu} {
917 
    catch {destroy .m1}
918 
    menu .m1
919 
    list [catch {.m1 invoke 0} msg] [destroy .m1]
920 
} {0 {}}
921 
test menu-4.2 {TkInvokeMenu} {
922 
    catch {destroy .m1}
923 
    catch {unset foo}
924 
    menu .m1
925 
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
926 
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
927 
} {0 {} 0 on 0 {} {}}
928 
test menu-4.3 {TkInvokeMenu} {
929 
    catch {destroy .m1}
930 
    catch {unset foo}
931 
    menu .m1
932 
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
933 
    .m1 invoke 1
934 
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
935 
} {0 {} 0 off 0 {} {}}
936 
test menu-4.4 {TkInvokeMenu} {
937 
    catch {destroy .m1}
938 
    catch {unset foo}
939 
    menu .m1
940 
    .m1 add radiobutton -label "1" -variable foo -value one
941 
    .m1 add radiobutton -label "2" -variable foo -value two
942 
    .m1 add radiobutton -label "3" -variable foo -value three
943 
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
944 
} {0 {} 0 one 0 {} {}}
945 
test menu-4.5 {TkInvokeMenu} {
946 
    catch {destroy .m1}
947 
    catch {unset foo}
948 
    menu .m1
949 
    .m1 add radiobutton -label "1" -variable foo -value one
950 
    .m1 add radiobutton -label "2" -variable foo -value two
951 
    .m1 add radiobutton -label "3" -variable foo -value three
952 
    list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
953 
} {0 {} 0 two 0 {} {}}
954 
test menu-4.6 {TkInvokeMenu} {
955 
    catch {destroy .m1}
956 
    catch {unset foo}
957 
    menu .m1
958 
    .m1 add radiobutton -label "1" -variable foo -value one
959 
    .m1 add radiobutton -label "2" -variable foo -value two
960 
    .m1 add radiobutton -label "3" -variable foo -value three
961 
    list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
962 
} {0 {} 0 three 0 {} {}}
963 
test menu-4.7 {TkInvokeMenu} {
964 
    catch {destroy .m1}
965 
    catch {unset menu_test}
966 
    menu .m1
967 
    .m1 add command -label "test" -command "set menu_test menu-4.8"
968 
    list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
969 
} {0 menu-4.8 0 menu-4.8 0 {} {}}
970 
test menu-4.8 {TkInvokeMenu} {
971 
    catch {destroy .m1}
972 
    menu .m1
973 
    .m1 add cascade -label "test" -menu .m1.m2
974 
    list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
975 
} {0 {} {}}
976 
test menu-4.9 {TkInvokeMenu} {
977 
    catch {destroy .m1}
978 
    menu .m1
979 
    .m1 add command -label "test" -command ".m1 delete 1"
980 
    list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
981 
} {0 {} 1 {bad menu entry index "test"} {}}
982 
 
983 
test menu-5.1 {DestroyMenuInstance} {
984 
    catch {destroy .m1}
985 
    menu .m1
986 
    list [catch {destroy .m1} msg] $msg
987 
} {0 {}}
988 
test menu-5.2 {DestroyMenuInstance - cascade menu} {
989 
    catch {destroy .m1}
990 
    catch {destroy .m2}
991 
    menu .m1
992 
    .m1 add cascade -menu .m2
993 
    menu .m2
994 
    list [catch {destroy .m2} msg] $msg [destroy .m1]
995 
} {0 {} {}}
996 
test menu-5.3 {DestroyMenuInstance - multiple cascade parents} {
997 
    catch {destroy .m1}
998 
    catch {destroy .m2}
999 
    catch {destroy .m3}
1000 
    menu .m1
1001 
    .m1 add cascade -menu .m3
1002 
    menu .m2
1003 
    .m2 add cascade -menu .m3
1004 
    menu .m3
1005 
    list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
1006 
} {0 {} {}}
1007 
test menu-5.4 {DestroyMenuInstance - multiple cascade parents} {
1008 
    catch {destroy .m1}
1009 
    catch {destroy .m2}
1010 
    catch {destroy .m3}
1011 
    catch {destroy .m4}
1012 
    menu .m1
1013 
    .m1 add cascade -menu .m4
1014 
    menu .m2
1015 
    .m2 add cascade -menu .m4
1016 
    menu .m3
1017 
    .m3 add cascade -menu .m4
1018 
    menu .m4
1019 
    list [catch {destroy .m4} msg] $msg [destroy .m1 .m2 .m3]
1020 
} {0 {} {}}
1021 
test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} {
1022 
    catch {destroy .m1}
1023 
    catch {destroy .m2}
1024 
    menu .m1
1025 
    menu .m2
1026 
    .m1 add cascade -menu .m2
1027 
    . configure -menu .m1
1028 
    list [catch {destroy .m2} msg] $msg [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1]
1029 
} {0 {} .m2 {} {}}
1030 
test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} {
1031 
    catch {destroy .m1}
1032 
    catch {destroy .m2}
1033 
    catch {destroy .t2}
1034 
    menu .m1
1035 
    .m1 add cascade -menu .m2
1036 
    menu .m2
1037 
    . configure -menu .m1
1038 
    toplevel .t2
1039 
    wm geometry .t2 +0+0
1040 
    .t2 configure -menu .m1
1041 
    list [catch {destroy .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
1042 
} {0 {} {} {}}
1043 
test menu-5.7 {DestroyMenuInstance - basic clones} {
1044 
    catch {destroy .m1}
1045 
    menu .m1
1046 
    set tearoff [tkTearOffMenu .m1]
1047 
    list [catch {destroy $tearoff} msg] $msg [destroy .m1]
1048 
} {0 {} {}}
1049 
test menu-5.8 {DestroyMenuInstance - multiple clones} {
1050 
    catch {destroy .m1}
1051 
    menu .m1
1052 
    set tearoff1 [tkTearOffMenu .m1]
1053 
    set tearoff2 [tkTearOffMenu .m1]
1054 
    list [catch {destroy $tearoff1} msg] $msg [destroy .m1]
1055 
} {0 {} {}}
1056 
test menu-5.9 {DestroyMenuInstace - master menu} {
1057 
    catch {destroy .m1}
1058 
    menu .m1
1059 
    tkTearOffMenu .m1
1060 
    list [catch {destroy .m1} msg] $msg
1061 
} {0 {}}
1062 
test menu-5.10 {DestroyMenuInstance - freeing entries} {
1063 
    catch {destroy .m1}
1064 
    menu .m1
1065 
    .m1 add command -label "foo"
1066 
    list [catch {destroy .m1} msg] $msg
1067 
} {0 {}}
1068 
test menu-5.11 {DestroyMenuInstace - no entries} {
1069 
    catch {destroy .m1}
1070 
    menu .m1
1071 
    .m1 configure -tearoff 0
1072 
    list [catch {destroy .m1} msg] $msg
1073 
} {0 {}}
1074 
test menu-5.12 {DestroyMenuInstance - platform data} {
1075 
    catch {destroy .m1}
1076 
    menu .m1
1077 
    list [catch {destroy .m1} msg] $msg
1078 
} {0 {}}
1079 
test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} {
1080 
    catch {destroy .m1}
1081 
    catch {destroy .m2}
1082 
    menu .m1
1083 
    menu .m2
1084 
    .m1 add cascade -menu .m2
1085 
    set tearoff [tkTearOffMenu .m1 40 40]
1086 
    list [destroy .m2] [destroy .m1]
1087 
} {{} {}}
1088 
 
1089 
test menu-6.1 {TkDestroyMenu} {
1090 
    catch {destroy .m1}
1091 
    menu .m1
1092 
    list [catch {destroy .m1} msg] $msg
1093 
} {0 {}}
1094 
test menu-6.2 {TkDestroyMenu - reentrancy} {
1095 
    catch {destroy .m1}
1096 
    catch {destroy .m2}
1097 
    menu .m1
1098 
    bind .m1  {destroy .m1}
1099 
    menu .m2
1100 
    bind .m2  {destroy .m2}
1101 
    list [catch {destroy .m1} msg] $msg [destroy .m2]
1102 
} {0 {} {}}
1103 
test menu-6.3 {TkDestroyMenu - reentrancy} {
1104 
    catch {destroy .m1}
1105 
    catch {destroy .m2}
1106 
    catch {destroy .m3}
1107 
    menu .m1
1108 
    bind .m1  {destroy .m2}
1109 
    .m1 clone .m2
1110 
    .m1 clone .m3
1111 
    list [catch {destroy .m1} msg] $msg [winfo exists .m2]
1112 
} {0 {} 0}
1113 
test menu-6.4 {TkDestroyMenu - reentrancy - clones} {
1114 
    catch {destroy .m1}
1115 
    catch {destroy .m2}
1116 
    menu .m1
1117 
    .m1 clone .m2
1118 
    .m1 clone .m1.m3
1119 
    list [catch {destroy .m1} msg] $msg
1120 
} {0 {}}
1121 
test menu-6.5 {TkDestroyMenu} {
1122 
    catch {destroy .m1}
1123 
    catch {destroy .m2}
1124 
    menu .m1
1125 
    .m1 clone .m2
1126 
    destroy .m1
1127 
    winfo exists .m2
1128 
} {0}
1129 
test menu-6.6 {TkDestroyMenu} {
1130 
    catch {destroy .m1}
1131 
    catch {destroy .m2}
1132 
    menu .m1
1133 
    .m1 clone .m2 tearoff
1134 
    list [catch {destroy .m1} msg] $msg
1135 
} {0 {}}
1136 
test menu-6.7 {TkDestroyMenu} {
1137 
    catch {destroy .m1}
1138 
    catch {destroy .m2}
1139 
    menu .m1
1140 
    .m1 clone .m2
1141 
    destroy .m2
1142 
    list [catch {destroy .m1} msg] $msg
1143 
} {0 {}}
1144 
test menu-6.8 {TkDestroyMenu} {
1145 
    catch {destroy .m1}
1146 
    catch {destroy .m2}
1147 
    catch {destroy .m3}
1148 
    menu .m1
1149 
    .m1 clone .m2
1150 
    .m1 clone .m3
1151 
    destroy .m1
1152 
    list [winfo exists .m2] [winfo exists .m3]
1153 
} {0 0}
1154 
test menu-6.9 {TkDestroyMenu} {
1155 
    catch {destroy .m1}
1156 
    catch {destroy .m2}
1157 
    catch {destroy .m3}
1158 
    menu .m1
1159 
    .m1 clone .m2
1160 
    .m1 clone .m3
1161 
    list [catch {destroy .m2} msg] $msg [catch {destroy .m3} msg2] $msg2 [catch {destroy .m1} msg3] $msg3
1162 
} {0 {} 0 {} 0 {}}
1163 
test menu-6.10 {TkDestroyMenu} {
1164 
    catch {destroy .m1}
1165 
    catch {destroy .m2}
1166 
    catch {destroy .m3}
1167 
    menu .m1
1168 
    .m1 clone .m2
1169 
    .m1 clone .m3
1170 
    list [catch {destroy .m3} msg] $msg [catch {destroy .m1} msg2] $msg2
1171 
} {0 {} 0 {}}
1172 
test menu-6.11 {TkDestroyMenu} {
1173 
    catch {destroy .m1}
1174 
    catch {destroy .m2}
1175 
    catch {destroy .m3}
1176 
    catch {destroy .m4}
1177 
    menu .m1
1178 
    .m1 clone .m2
1179 
    .m1 clone .m3
1180 
    .m1 clone .m4
1181 
    list [catch {destroy .m2} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
1182 
} {0 {} 0 {}}
1183 
test menu-6.12 {TkDestroyMenu} {
1184 
    catch {destroy .m1}
1185 
    catch {destroy .m2}
1186 
    catch {destroy .m3}
1187 
    catch {destroy .m4}
1188 
    menu .m1
1189 
    .m1 clone .m2
1190 
    .m1 clone .m3
1191 
    .m1 clone .m4
1192 
    list [catch {destroy .m3} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
1193 
} {0 {} 0 {}}
1194 
test menu-6.13 {TkDestroyMenu} {
1195 
    catch {destroy .m1}
1196 
    catch {destroy .m2}
1197 
    catch {destroy .m3}
1198 
    catch {destroy .m4}
1199 
    menu .m1
1200 
    .m1 clone .m2
1201 
    .m1 clone .m3
1202 
    .m1 clone .m4
1203 
    list [catch {destroy .m4} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
1204 
} {0 {} 0 {}}
1205 
test menu-6.14 {TkDestroyMenu} {
1206 
    catch {destroy .m1}
1207 
    menu .m1
1208 
    . configure -menu .m1
1209 
    list [catch {destroy .m1} msg] $msg [. configure -menu ""]
1210 
} {0 {} {}}
1211 
test menu-6.15 {TkDestroyMenu} {
1212 
    catch {destroy .m1}
1213 
    catch {destroy .t2}
1214 
    menu .m1
1215 
    toplevel .t2
1216 
    wm geometry .t2 +0+0
1217 
    . configure -menu .m1
1218 
    .t2 configure -menu .m1
1219 
    list [catch {destroy .m1} msg] $msg [destroy .t2] [. configure -menu ""]
1220 
} {0 {} {} {}}
1221 
test menu-6.16 {TkDestroyMenu} {
1222 
    catch {destroy .m1}
1223 
    catch {destroy .t2}
1224 
    catch {destroy .t3}
1225 
    menu .m1
1226 
    toplevel .t2
1227 
    wm geometry .t2 +0+0
1228 
    toplevel .t3
1229 
    wm geometry .t3 +0+0
1230 
    . configure -menu .m1
1231 
    .t2 configure -menu .m1
1232 
    .t3 configure -menu .m1
1233 
    list [catch {destroy .m1} msg] $msg [destroy .t2] [destroy .t3] [. configure -menu ""]
1234 
} {0 {} {} {} {}}
1235 
 
1236 
test menu-7.1 {UnhookCascadeEntry} {
1237 
    catch {destroy .m1}
1238 
    menu .m1
1239 
    .m1 add command -label "test"
1240 
    list [catch {destroy .m1} msg] $msg
1241 
} {0 {}}
1242 
test menu-7.2 {UnhookCascadeEntry} {
1243 
    catch {destroy .m1}
1244 
    menu .m1
1245 
    .m1 add cascade -menu .m2
1246 
    list [catch {destroy .m1} msg] $msg
1247 
} {0 {}}
1248 
test menu-7.3 {UnhookCascadeEntry} {
1249 
    catch {destroy .m1}
1250 
    catch {destroy .m2}
1251 
    menu .m1
1252 
    menu .m2
1253 
    .m2 add cascade -menu .cascade
1254 
    .m1 add cascade -menu .cascade
1255 
    list [catch {destroy .m1} msg] $msg [destroy .m2]
1256 
} {0 {} {}}
1257 
test menu-7.4 {UnhookCascadeEntry} {
1258 
    catch {destroy .m1}
1259 
    catch {destroy .m2}
1260 
    menu .m1
1261 
    menu .m2
1262 
    .m1 add cascade -menu .cascade
1263 
    .m2 add cascade -menu .cascade
1264 
    list [catch {destroy .m1} msg] $msg [destroy .m2]
1265 
} {0 {} {}}
1266 
test menu-7.5 {UnhookCascadeEntry} {
1267 
    catch {destroy .m1}
1268 
    catch {destroy .m2}
1269 
    catch {destroy .m3}
1270 
    menu .m1
1271 
    menu .m2
1272 
    menu .m3
1273 
    .m1 add cascade -menu .cascade
1274 
    .m2 add cascade -menu .cascade
1275 
    .m3 add cascade -menu .cascade
1276 
    list [catch {destroy .m1} msg] $msg [destroy .m2 .m3]
1277 
} {0 {} {}}
1278 
test menu-7.6 {UnhookCascadeEntry} {
1279 
    catch {destroy .m1}
1280 
    catch {destroy .m2}
1281 
    catch {destroy .m3}
1282 
    menu .m1
1283 
    menu .m2
1284 
    menu .m3
1285 
    .m1 add cascade -menu .cascade
1286 
    .m2 add cascade -menu .cascade
1287 
    .m3 add cascade -menu .cascade
1288 
    list [catch {destroy .m2} msg] $msg [destroy .m1 .m3]
1289 
} {0 {} {}}
1290 
test menu-7.7 {UnhookCascadeEntry} {
1291 
    catch {destroy .m1}
1292 
    catch {destroy .m2}
1293 
    catch {destroy .m3}
1294 
    menu .m1
1295 
    menu .m2
1296 
    menu .m3
1297 
    .m1 add cascade -menu .cascade
1298 
    .m2 add cascade -menu .cascade
1299 
    .m3 add cascade -menu .cascade
1300 
    list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
1301 
} {0 {} {}}
1302 
test menu-7.8 {UnhookCascadeEntry} {
1303 
    catch {destroy .m1}
1304 
    catch {destroy .m2}
1305 
    menu .m1
1306 
    menu .m2
1307 
    .m1 add cascade -menu .m2
1308 
    list [catch {destroy .m1} msg] $msg [destroy .m2]
1309 
} {0 {} {}}
1310 
test menu-7.9 {UnhookCascadeEntry} {
1311 
    catch {destroy .m1}
1312 
    catch {destroy .m2}
1313 
    menu .m1
1314 
    menu .m2
1315 
    .m1 add cascade -menu .m2
1316 
    destroy .m1
1317 
    list [catch {destroy .m2} msg] $msg
1318 
} {0 {}}
1319 
 
1320 
test menu-8.1 {DestroyMenuEntry} {
1321 
    catch {destroy .m1}
1322 
    catch {destroy .m2}
1323 
    menu .m1
1324 
    menu .m2
1325 
    .m1 add cascade -menu .m2
1326 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1 .m2]
1327 
} {0 {} {}}
1328 
test menu-8.2 {DestroyMenuEntry} {
1329 
    catch {image delete image1a}
1330 
    catch {destroy .m1}
1331 
    image create photo image1a -file [file join $tk_library demos images earth.gif]
1332 
    menu .m1
1333 
    .m1 add command -image image1a
1334 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a]
1335 
} {0 {} {} {}}
1336 
test menu-8.3 {DestroyMenuEntry} {
1337 
    catch {eval image delete [image names]}
1338 
    catch {destroy .m1}
1339 
    image create test image1
1340 
    image create test image2
1341 
    menu .m1
1342 
    .m1 add checkbutton -image image1 -selectimage image2
1343 
    .m1 invoke 1
1344 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1] [eval image delete [image names]]
1345 
} {0 {} {} {}}
1346 
test menu-8.4 {DestroyMenuEntry} {
1347 
    catch {destroy .m1}
1348 
    menu .m1
1349 
    .m1 add checkbutton -variable foo
1350 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
1351 
} {0 {} {}}
1352 
test menu-8.5 {DestroyMenuEntry} {
1353 
    catch {destroy .m1}
1354 
    menu .m1
1355 
    .m1 add command -label "test"
1356 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
1357 
} {0 {} {}}
1358 
test menu-8.6 {DestroyMenuEntry} {
1359 
    catch {destroy .m1}
1360 
    menu .m1
1361 
    .m1 add command -label "one"
1362 
    .m1 add command -label "two"
1363 
    list [catch {.m1 delete 1} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1364 
} {0 {} two {}}
1365 
test menu-8.7 {DestroyMenuEntry} {
1366 
    catch {destroy .m1}
1367 
    catch {destroy .m2}
1368 
    menu .m1
1369 
    .m1 add command -label "one"
1370 
    .m1 clone .m2 tearoff
1371 
    list [catch {.m2 delete 0} msg] $msg [destroy .m1]
1372 
} {0 {} {}}
1373 
 
1374 
# test menu-9 - Can only change when fonts change on system, which cannot
1375 
# be done from tcl.
1376 
 
1377 
test menu-9.1 {ConfigureMenu} {
1378 
    catch {destroy .m1}
1379 
    menu .m1
1380 
    list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
1381 
} {0 {} beep {}}
1382 
test menu-9.2 {ConfigureMenu} {
1383 
    catch {destroy .m1}
1384 
    menu .m1
1385 
    .m1 add command -label "test"
1386 
    list [catch {.m1 configure -tearoff 0} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1387 
} {0 {} test {}}
1388 
test menu-9.3 {ConfigureMenu} {
1389 
    catch {destroy .m1}
1390 
    menu .m1
1391 
    list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
1392 
} {0 {} beep {}}
1393 
test menu-9.4 {ConfigureMenu} {
1394 
    catch {destroy .m1}
1395 
    menu .m1
1396 
    .m1 add command -label "test"
1397 
    list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
1398 
} {0 {} {}}
1399 
test menu-9.5 {ConfigureMenu} {
1400 
    catch {destroy .m1}
1401 
    menu .m1
1402 
    .m1 add command -label "test"
1403 
    .m1 add command -label "two"
1404 
    list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
1405 
} {0 {} {}}
1406 
test menu-9.6 {ConfigureMenu} {
1407 
    catch {destroy .m1}
1408 
    menu .m1
1409 
    .m1 add command -label "test"
1410 
    .m1 add command -label "two"
1411 
    .m1 add command -label "three"
1412 
    list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
1413 
} {0 {} {}}
1414 
test menu-9.7 {ConfigureMenu} {
1415 
    catch {destroy .m1}
1416 
    catch {destroy .m2}
1417 
    menu .m1
1418 
    .m1 clone .m2 tearoff
1419 
    list [catch {.m1 configure -fg red} msg] $msg [.m2 cget -fg] [destroy .m1]
1420 
} {0 {} red {}}
1421 
test menu-9.8 {ConfigureMenu} {
1422 
    catch {destroy .m1}
1423 
    catch {destroy .m2}
1424 
    menu .m1
1425 
    .m1 clone .m2 tearoff
1426 
    list [catch {.m2 configure -fg red} msg] $msg [.m1 cget -fg] [destroy .m1]
1427 
} {0 {} red {}}
1428 
test menu-9.9 {ConfigureMenu} {
1429 
    catch {destroy .m1}
1430 
    menu .m1
1431 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
1432 
} {0 {} {} {}}
1433 
 
1434 
test menu-10.1 {ConfigureMenuEntry} {
1435 
    catch {destroy .m1}
1436 
    catch {unset foo}
1437 
    menu .m1
1438 
    .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
1439 
    list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
1440 
} {0 {} bar {}}
1441 
test menu-10.2 {ConfigureMenuEntry} {
1442 
    catch {destroy .m1}
1443 
    menu .m1
1444 
    .m1 add command -label "test"
1445 
    list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1446 
} {0 {} {} {}}
1447 
test menu-10.3 {ConfigureMenuEntry} {
1448 
    catch {destroy .m1}
1449 
    menu .m1
1450 
    .m1 add command
1451 
    list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
1452 
} {0 {} test {}}
1453 
test menu-10.4 {ConfigureMenuEntry} {
1454 
    catch {destroy .m1}
1455 
    menu .m1
1456 
    .m1 add command
1457 
    list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
1458 
} {0 {} S {}}
1459 
test menu-10.5 {ConfigureMenuEntry} {
1460 
    catch {destroy .m1}
1461 
    menu .m1
1462 
    .m1 add command
1463 
    list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
1464 
} {0 {} test {}}
1465 
test menu-10.6 {ConfigureMenuEntry} {
1466 
    catch {destroy .m1}
1467 
    menu .m1
1468 
    .m1 add command
1469 
    list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
1470 
} {0 {} {}}
1471 
test menu-10.7 {ConfigureMenuEntry} {
1472 
    catch {destroy .m1}
1473 
    catch {destroy .m2}
1474 
    menu .m2
1475 
    menu .m1
1476 
    .m1 add cascade
1477 
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
1478 
} {0 {} {}}
1479 
test menu-10.8 {ConfigureMenuEntry} {
1480 
    catch {destroy .m1}
1481 
    menu .m1
1482 
    .m1 add cascade
1483 
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1484 
} {0 {} {}}
1485 
test menu-10.9 {ConfigureMenuEntry} {
1486 
    catch {destroy .m1}
1487 
    menu .m1
1488 
    .m1 add cascade -menu .m3
1489 
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1490 
} {0 {} {}}
1491 
test menu-10.10 {ConfigureMenuEntry} {
1492 
    catch {destroy .m1}
1493 
    menu .m1
1494 
    .m1 add cascade
1495 
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1496 
} {0 {} {}}
1497 
test menu-10.11 {ConfigureMenuEntry} {
1498 
    catch {destroy .m1}
1499 
    menu .m1
1500 
    .m1 add cascade -menu .m2
1501 
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
1502 
} {0 {} {}}
1503 
test menu-10.12 {ConfigureMenuEntry} {
1504 
    catch {destroy .m1}
1505 
    catch {destroy .m2}
1506 
    catch {destroy .m3}
1507 
    catch {destroy .m4}
1508 
    catch {destroy .m5}
1509 
    menu .m1
1510 
    menu .m2
1511 
    .m2 add cascade -menu .m1
1512 
    menu .m3
1513 
    .m3 add cascade -menu .m1
1514 
    menu .m4
1515 
    .m4 add cascade -menu .m1
1516 
    menu .m5
1517 
    .m5 add cascade
1518 
    list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
1519 
} {0 {} {}}
1520 
test menu-10.13 {ConfigureMenuEntry} {
1521 
    catch {destroy .m1}
1522 
    catch {destroy .m2}
1523 
    catch {destroy .m3}
1524 
    catch {destroy .m4}
1525 
    menu .m1
1526 
    menu .m2
1527 
    .m2 add cascade -menu .m1
1528 
    menu .m3
1529 
    .m3 add cascade -menu .m1
1530 
    menu .m4
1531 
    .m4 add cascade -menu .m1
1532 
    list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
1533 
} {0 {} {}}
1534 
test menu-10.14 {ConfigureMenuEntry} {
1535 
    catch {destroy .m1}
1536 
    menu .m1
1537 
    .m1 add checkbutton
1538 
    list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
1539 
} {0 {} test {}}
1540 
test menu-10.15 {ConfigureMenuEntry} {
1541 
    catch {destroy .m1}
1542 
    menu .m1
1543 
    list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
1544 
} {0 {} test {}}
1545 
test menu-10.16 {ConfigureMenuEntry} {
1546 
    catch {destroy .m1}
1547 
    menu .m1
1548 
    list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
1549 
} {0 {} {}}
1550 
test menu-10.17 {ConfigureMenuEntry} {
1551 
    catch {destroy .m1}
1552 
    menu .m1
1553 
    .m1 add checkbutton
1554 
    list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
1555 
} {0 {} test {}}
1556 
test menu-10.18 {ConfigureMenuEntry} {
1557 
    catch {destroy .m1}
1558 
    catch {image delete image1}
1559 
    menu .m1
1560 
    .m1 add command
1561 
    image create test image1
1562 
    list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
1563 
} {0 {} {} {}}
1564 
test menu-10.19 {ConfigureMenuEntry} {
1565 
    catch {destroy .m1}
1566 
    catch {image delete image1}
1567 
    catch {image delete image2}
1568 
    image create test image1
1569 
    image create photo image2 -file [file join $tk_library demos images earth.gif]
1570 
    menu .m1
1571 
    .m1 add command -image image1
1572 
    list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
1573 
} {0 {} {} {} {}}
1574 
test menu-10.20 {ConfigureMenuEntry} {
1575 
    catch {destroy .m1}
1576 
    catch {image delete image1}
1577 
    catch {image delete image2}
1578 
    image create photo image1 -file [file join $tk_library demos images earth.gif]
1579 
    image create test image2
1580 
    menu .m1
1581 
    .m1 add checkbutton -image image1
1582 
    list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
1583 
} {0 {} {} {} {}}
1584 
test menu-10.21 {ConfigureMenuEntry} {
1585 
    catch {destroy .m1}
1586 
    catch {image delete image1}
1587 
    catch {image delete image2}
1588 
    catch {image delete image3}
1589 
    image create photo image1 -file [file join $tk_library demos images earth.gif]
1590 
    image create test image2
1591 
    image create test image3
1592 
    menu .m1
1593 
    .m1 add checkbutton -image image1 -selectimage image2
1594 
    list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
1595 
} {0 {} {} {} {} {}}
1596 
 
1597 
test menu-11.1 {ConfigureMenuCloneEntries} {
1598 
    catch {destroy .m1}
1599 
    catch {destroy .m2}
1600 
    catch {destroy .m3}
1601 
    menu .m1
1602 
    .m1 clone .m2
1603 
    .m2 configure -tearoff 0
1604 
    .m1 clone .m3
1605 
    .m1 add command -label "test"
1606 
    .m1 add command -label "test2"
1607 
    list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
1608 
} {{1 {unknown option "-gork"}} {}}
1609 
test menu-11.2 {ConfigureMenuCloneEntries} {
1610 
    catch {destroy .m1}
1611 
    catch {destroy .m2}
1612 
    catch {destroy .m3}
1613 
    catch {destroy .m4}
1614 
    menu .m1
1615 
    .m1 clone .m2
1616 
    menu .m3
1617 
    .m1 add cascade -menu .m3
1618 
    menu .m4
1619 
    list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
1620 
} {0 {} {} {} {}}
1621 
test menu-11.3 {ConfigureMenuCloneEntries} {
1622 
    catch {destroy .m1}
1623 
    catch {destroy .m2}
1624 
    menu .m1
1625 
    .m1 clone .m2
1626 
    .m1 add cascade -label dummy
1627 
    list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
1628 
} {0 {} {}}
1629 
 
1630 
test menu-12.1 {TkGetMenuIndex} {
1631 
    catch {destroy .m1}
1632 
    menu .m1
1633 
    .m1 add command -label "active"
1634 
    .m1 add command -label "test2"
1635 
    .m1 add command -label "test3"
1636 
    .m1 activate 2
1637 
    list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
1638 
} {0 test2 {}}
1639 
test menu-12.2 {TkGetMenuIndex} {
1640 
    catch {destroy .m1}
1641 
    menu .m1
1642 
    .m1 add command -label "last"
1643 
    .m1 add command -label "test2"
1644 
    .m1 add command -label "test3"
1645 
    .m1 activate 2
1646 
    list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
1647 
} {0 test3 {}}
1648 
test menu-12.3 {TkGetMenuIndex} {
1649 
    catch {destroy .m1}
1650 
    menu .m1
1651 
    .m1 add command -label "last"
1652 
    .m1 add command -label "test2"
1653 
    .m1 add command -label "test3"
1654 
    .m1 activate 2
1655 
    list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
1656 
} {0 test3 {}}
1657 
test menu-12.4 {TkGetMenuIndex} {
1658 
    catch {destroy .m1}
1659 
    menu .m1
1660 
    .m1 add command -label "test"
1661 
    list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
1662 
} {0 {} test2 {}}
1663 
test menu-12.5 {TkGetMenuIndex} {
1664 
    catch {destroy .m1}
1665 
    menu .m1
1666 
    .m1 add command -label "test"
1667 
    list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
1668 
} {0 {} test2 {}}
1669 
test menu-12.6 {TkGetMenuIndex} {
1670 
    catch {destroy .m1}
1671 
    menu .m1
1672 
    .m1 add command -label "active"
1673 
    .m1 add command -label "test2"
1674 
    .m1 add command -label "test3"
1675 
    .m1 activate 2
1676 
    list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
1677 
} {0 {} {}}
1678 
#test menu-13.7 - Need to add @test here.
1679 
test menu-12.7 {TkGetMenuIndex} {
1680 
    catch {destroy .m1}
1681 
    menu .m1
1682 
    .m1 add command -label "active"
1683 
    .m1 add command -label "test2"
1684 
    .m1 add command -label "test3"
1685 
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
1686 
} {0 active {}}
1687 
test menu-12.8 {TkGetMenuIndex} {
1688 
    catch {destroy .m1}
1689 
    menu .m1
1690 
    .m1 add command -label "active"
1691 
    list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
1692 
} {1 {bad menu entry index "-1"} {}}
1693 
test menu-12.9 {TkGetMenuIndex} {
1694 
    catch {destroy .m1}
1695 
    menu .m1
1696 
    .m1 add command -label "test"
1697 
    .m1 add command -label "test2"
1698 
    list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
1699 
} {0 test2 {}}
1700 
test menu-12.10 {TkGetMenuIndex} {
1701 
    catch {destroy .m1}
1702 
    menu .m1
1703 
    .m1 insert 999 command -label "test"
1704 
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
1705 
} {0 test {}}
1706 
test menu-12.11 {TkGetMenuIndex} {
1707 
    catch {destroy .m1}
1708 
    menu .m1
1709 
    .m1 add command -label "1test"
1710 
    list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
1711 
} {0 1test {}}
1712 
test menu-12.12 {TkGetMenuIndex} {
1713 
    catch {destroy .m1}
1714 
    menu .m1
1715 
    .m1 add command -label "test"
1716 
    .m1 add command -label "test2" -command "beep"
1717 
    .m1 add command -label "test3"
1718 
    list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
1719 
} {0 beep {}}
1720 
 
1721 
test menu-13.1 {MenuCmdDeletedProc} {
1722 
    catch {destroy .m1}
1723 
    menu .m1
1724 
    list [catch {destroy .m1} msg] $msg
1725 
} {0 {}}
1726 
test menu-13.2 {MenuCmdDeletedProc} {
1727 
    catch {destroy .m1}
1728 
    menu .m1
1729 
    .m1 clone .m2
1730 
    list [catch {destroy .m1} msg] $msg
1731 
} {0 {}}
1732 
 
1733 
test menu-14.1 {MenuNewEntry} {
1734 
    catch {destroy .m1}
1735 
    menu .m1
1736 
    list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
1737 
} {0 {} {}}
1738 
test menu-14.2 {MenuNewEntry} {
1739 
    catch {destroy .m1}
1740 
    menu .m1
1741 
    .m1 add command -label "test"
1742 
    .m1 add command -label "test3"
1743 
    list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
1744 
} {0 {} {}}
1745 
test menu-14.3 {MenuNewEntry} {
1746 
    catch {destroy .m1}
1747 
    menu .m1
1748 
    .m1 add command -label "test"
1749 
    list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
1750 
} {0 {} {}}
1751 
test menu-14.4 {MenuNewEntry} {
1752 
    catch {destroy .m1}
1753 
    menu .m1
1754 
    list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
1755 
} {0 {} {}}
1756 
 
1757 
test menu-15.1 {MenuAddOrInsert} {
1758 
    catch {destroy .m1}
1759 
    menu .m1
1760 
    list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
1761 
} {1 {bad menu entry index "foo"} {}}
1762 
test menu-15.2 {MenuAddOrInsert} {
1763 
    catch {destroy .m1}
1764 
    menu .m1
1765 
    .m1 add command -label "test"
1766 
    list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
1767 
} {0 {} {}}
1768 
test menu-15.3 {MenuAddOrInsert} {
1769 
    catch {destroy .m1}
1770 
    menu .m1
1771 
    list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
1772 
} {1 {bad menu entry index "-1"} {}}
1773 
test menu-15.4 {MenuAddOrInsert} {
1774 
    catch {destroy .m1}
1775 
    menu .m1
1776 
    .m1 add command -label "test"
1777 
    .m1 insert 0 command -label "test2"
1778 
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
1779 
} {0 test2 {}}
1780 
test menu-15.5 {MenuAddOrInsert} {
1781 
    catch {destroy .m1}
1782 
    menu .m1
1783 
    list [catch {.m1 add cascade} msg] $msg [destroy .m1]
1784 
} {0 {} {}}
1785 
test menu-15.6 {MenuAddOrInsert} {
1786 
    catch {destroy .m1}
1787 
    menu .m1
1788 
    list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
1789 
} {0 {} {}}
1790 
test menu-15.7 {MenuAddOrInsert} {
1791 
    catch {destroy .m1}
1792 
    menu .m1
1793 
    list [catch {.m1 add command} msg] $msg [destroy .m1]
1794 
} {0 {} {}}
1795 
test menu-15.8 {MenuAddOrInsert} {
1796 
    catch {destroy .m1}
1797 
    menu .m1
1798 
    list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
1799 
} {0 {} {}}
1800 
test menu-15.9 {MenuAddOrInsert} {
1801 
    catch {destroy .m1}
1802 
    menu .m1
1803 
    list [catch {.m1 add separator} msg] $msg [destroy .m1]
1804 
} {0 {} {}}
1805 
test menu-15.10 {MenuAddOrInsert} {
1806 
    catch {destroy .m1}
1807 
    menu .m1
1808 
    list [catch {.m1 add blork} msg] $msg [destroy .m1]
1809 
} {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
1810 
test menu-15.11 {MenuAddOrInsert} {
1811 
    catch {destroy .m1}
1812 
    menu .m1
1813 
    list [catch {.m1 add command} msg] $msg [destroy .m1]
1814 
} {0 {} {}}
1815 
test menu-15.12 {MenuAddOrInsert} {
1816 
    catch {destroy .m1}
1817 
    catch {destroy .m2}
1818 
    catch {destroy .m3}
1819 
    menu .m1
1820 
    .m1 clone .m2
1821 
    .m2 clone .m3
1822 
    list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
1823 
} {0 {} 0 test 0 test {}}
1824 
test menu-15.13 {MenuAddOrInsert} {
1825 
    catch {destroy .m1}
1826 
    catch {destroy .m2}
1827 
    catch {destroy .m3}
1828 
    menu .m1
1829 
    .m1 clone .m2
1830 
    .m2 clone .m3
1831 
    list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
1832 
} {0 {} 0 test 0 test {}}
1833 
test menu-15.14 {MenuAddOrInsert} {
1834 
    catch {destroy .m1}
1835 
    menu .m1
1836 
    list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
1837 
} {1 {unknown option "-blork"} {}}
1838 
test menu-15.15 {MenuAddOrInsert} {
1839 
    catch {destroy .m1}
1840 
    catch {destroy .container}
1841 
    menu .m1
1842 
    .m1 add command -label "File"
1843 
    menu .container
1844 
    . configure -menu .container
1845 
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
1846 
} {0 {} {} {}}
1847 
test menu-15.16 {MenuAddOrInsert} {
1848 
    catch {destroy .m1}
1849 
    catch {destroy .m2}
1850 
    menu .m1
1851 
    menu .m2
1852 
    set tearoff [tkTearOffMenu .m2]
1853 
    list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
1854 
} {0 {} {} 0 {} 0 {}}
1855 
test menu-15.17 {MenuAddOrInsert} {
1856 
    catch {destroy .m1}
1857 
    catch {destroy .container}
1858 
    menu .m1
1859 
    menu .container
1860 
    . configure -menu .container
1861 
    set tearoff [tkTearOffMenu .container]
1862 
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
1863 
} {0 {} {} {}}
1864 
test menu-15.18 {MenuAddOrInsert} {
1865 
    catch {destroy .m1}
1866 
    catch {destroy .container}
1867 
    menu .m1
1868 
    menu .container
1869 
    .container add cascade -menu .m1
1870 
    . configure -menu .container
1871 
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
1872 
} {0 {} {} {}}
1873 
test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
1874 
    catch {destroy .menubar}
1875 
    menu .menubar
1876 
    menu .menubar.test -tearoff 0
1877 
    .menubar add cascade -label Test -underline 0 -menu .menubar.test
1878 
    menu .menubar.test.cascade -tearoff 0
1879 
    .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
1880 
    . configure -menu .menubar
1881 
    list [catch {.menubar.test add cascade -label SubMenu \
1882 
        -menu .menubar.test.cascade} msg] \
1883 
        [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
1884 
        [. configure -menu ""] [destroy .menubar]
1885 
} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
1886 
 
1887 
test menu-16.1 {MenuVarProc} {
1888 
    catch {destroy .m1}
1889 
    catch {unset foo}
1890 
    menu .m1
1891 
    set foo "hello"
1892 
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
1893 
} {0 {} 0 {} {}}
1894 
# menu-17.2 - Don't know how to generate the flags in the if
1895 
test menu-16.2 {MenuVarProc} {
1896 
    catch {destroy .m1}
1897 
    catch {unset foo}
1898 
    menu .m1
1899 
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
1900 
} {0 {} {} {}}
1901 
test menu-16.3 {MenuVarProc} {
1902 
    catch {destroy .m1}
1903 
    catch {unset foo}
1904 
    menu .m1
1905 
    set foo "hello"
1906 
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
1907 
} {0 {} hello {} 0 {}}
1908 
test menu-16.4 {MenuVarProc} {
1909 
    catch {destroy .m1}
1910 
    menu .m1
1911 
    set foo "goodbye"
1912 
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
1913 
} {0 {} hello {} 0 {}}
1914 
test menu-16.5 {MenuVarProc} {
1915 
    catch {destroy .m1}
1916 
    menu .m1
1917 
    set foo "hello"
1918 
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
1919 
} {0 {} goodbye {} 0 {}}
1920 
 
1921 
test menu-17.1 {TkActivateMenuEntry} {
1922 
    catch {destroy .m1}
1923 
    menu .m1
1924 
    .m1 add command -label "test"
1925 
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
1926 
} {0 {} {}}
1927 
test menu-17.2 {TkActivateMenuEntry} {
1928 
    catch {destroy .m1}
1929 
    menu .m1
1930 
    .m1 add command -label "test"
1931 
    list [catch {.m1 activate 0} msg] $msg [destroy .m1]
1932 
} {0 {} {}}
1933 
test menu-17.3 {TkActivateMenuEntry} {
1934 
    catch {destroy .m1}
1935 
    menu .m1
1936 
    .m1 add command -label "test"
1937 
    .m1 add command -label "test2"
1938 
    .m1 activate 1
1939 
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
1940 
} {0 {} {}}
1941 
test menu-17.4 {TkActivateMenuEntry} {
1942 
    catch {destroy .m1}
1943 
    menu .m1
1944 
    .m1 add command -label "test"
1945 
    .m1 add command -label "test2"
1946 
    .m1 activate 1
1947 
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
1948 
} {0 {} {}}
1949 
 
1950 
test menu-18.1 {TkPostCommand} {menuInteractive} {
1951 
    catch {destroy .m1}
1952 
    menu .m1 -postcommand "set menu_test menu-19.1"
1953 
    .m1 add command -label "menu-19.1 - hit Escape"
1954 
    list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
1955 
} {0 menu-19.1 {} menu-19.1 {}}
1956 
test menu-18.2 {TkPostCommand} {menuInteractive} {
1957 
    catch {destroy .m1}
1958 
    menu .m1
1959 
    .m1 add command -label "menu-19.2 - hit Escape"
1960 
    list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
1961 
} {0 {} {} {}}
1962 
 
1963 
test menu-19.1 {CloneMenu} {
1964 
    catch {destroy .m1}
1965 
    catch {destroy .m2}
1966 
    menu .m1
1967 
    list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
1968 
} {0 {} {}}
1969 
test menu-19.2 {CloneMenu} {
1970 
    catch {destroy .m1}
1971 
    catch {destroy .m2}
1972 
    menu .m1
1973 
    list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
1974 
} {0 {} {}}
1975 
test menu-19.3 {CloneMenu} {
1976 
    catch {destroy .m1}
1977 
    catch {destroy .m2}
1978 
    menu .m1
1979 
    list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
1980 
} {0 {} {}}
1981 
test menu-19.4 {CloneMenu} {
1982 
    catch {destroy .m1}
1983 
    catch {destroy .m2}
1984 
    menu .m1
1985 
    list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
1986 
} {0 {} {}}
1987 
test menu-19.5 {CloneMenu} {
1988 
    catch {destroy .m1}
1989 
    catch {destroy .m2}
1990 
    menu .m1
1991 
    list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
1992 
} {1 {bad menu type - must be normal, tearoff, or menubar} {}}
1993 
test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
1994 
    catch {destroy .m1}
1995 
    catch {destroy .m2}
1996 
    menu .m1
1997 
    list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
1998 
 } {0 {} {}}
1999 
 test menu-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
2000 
    catch {destroy .m1}
2001 
    catch {destroy .m2}
2002 
    catch {destroy .m3}
2003 
    menu .m1
2004 
    .m1 clone .m2
2005 
    list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
2006 
 } {0 {} {}}
2007 
 test menu-19.8 {CloneMenu - cascade entries} {
2008 
    catch {destroy .m1}
2009 
    catch {destroy .foo}
2010 
    menu .m1
2011 
    .m1 add cascade -menu .m2
2012 
    list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
2013 
 } {0 {} {}}
2014 
 test menu-19.9 {CloneMenu - cascades entries} {
2015 
    catch {destroy .m1}
2016 
    catch {destroy .m2}
2017 
    catch {destroy .foo}
2018 
    menu .m1
2019 
    .m1 add cascade -menu .m2
2020 
    menu .m2
2021 
    list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
2022 
 } {0 {} {}}
2023 
test menu-19.10 {CloneMenu - tearoff fields} {
2024 
    catch {destroy .m1}
2025 
    catch {destroy .m2}
2026 
    menu .m1
2027 
    list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
2028 
} {0 {} 0 1 {}}
2029 
test menu-19.11 {CloneMenu} {
2030 
    catch {destroy .m1}
2031 
    catch {destroy .m2}
2032 
    menu .m1
2033 
    menu .m2
2034 
    list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
2035 
} {1 {window name "m2" already exists in parent} {}}
2036 
 
2037 
test menu-20.1 {MenuDoYPosition} {
2038 
    catch {destroy .m1}
2039 
    menu .m1
2040 
    list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
2041 
} {1 {bad menu entry index "glorp"} {}}
2042 
test menu-20.2 {MenuDoYPosition} {
2043 
    catch {destroy .m1}
2044 
    menu .m1
2045 
    .m1 add command -label "Test"
2046 
    list [catch {.m1 yposition 1}] [destroy .m1]
2047 
} {0 {}}
2048 
 
2049 
test menu-21.1 {GetIndexFromCoords} {
2050 
    catch {destroy .m1}
2051 
    menu .m1
2052 
    .m1 add command -label "test"
2053 
    .m1 configure -tearoff 0
2054 
    list [catch {.m1 index @5} msg] $msg [destroy .m1]
2055 
} {0 0 {}}
2056 
test menu-21.2 {GetIndexFromCoords} {
2057 
    catch {destroy .m1}
2058 
    menu .m1
2059 
    .m1 add command -label "test"
2060 
    .m1 configure -tearoff 0
2061 
    list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
2062 
} {0 0 {}}
2063 
 
2064 
test menu-22.1 {RecursivelyDeleteMenu} {
2065 
    catch {destroy .m1}
2066 
    menu .m1
2067 
    . configure -menu .m1
2068 
    list [catch {. configure -menu ""} msg] $msg [destroy .m1]
2069 
} {0 {} {}}
2070 
test menu-22.2 {RecursivelyDeleteMenu} {
2071 
    catch {destroy .m1}
2072 
    catch {destroy .m2}
2073 
    menu .m2
2074 
    .m2 add command -label "test2"
2075 
    menu .m1
2076 
    .m1 add cascade -label "test1" -menu .m2
2077 
    . configure -menu .m1
2078 
    list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
2079 
} {0 {} {}}
2080 
 
2081 
test menu-23.1 {TkNewMenuName} {
2082 
    catch {destroy .m1}
2083 
    menu .m1
2084 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2085 
} {0 {} {} {}}
2086 
test menu-23.2 {TkNewMenuName} {
2087 
    catch {destroy .m1}
2088 
    catch {destroy .m1\#0}
2089 
    menu .m1
2090 
    menu .m1\#0
2091 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2092 
} {0 {} {} {}}
2093 
test menu-23.3 {TkNewMenuName} {
2094 
    catch {destroy .#m}
2095 
    menu .#m
2096 
    rename .#m hideme
2097 
    list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
2098 
} {0 {} {} {} {}}
2099 
 
2100 
test menu-24.1 {TkSetWindowMenuBar} {
2101 
    . configure -menu ""
2102 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2103 
} {0 {} {}}
2104 
test menu-24.2 {TkSetWindowMenuBar} {
2105 
    . configure -menu ""
2106 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2107 
} {0 {} {}}
2108 
test menu-24.3 {TkSetWindowMenuBar} {
2109 
    . configure -menu ""
2110 
    catch {destroy .m1}
2111 
    menu .m1
2112 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2113 
} {0 {} {} {}}
2114 
test menu-24.4 {TkSetWindowMenuBar} {
2115 
    catch {destroy .m1}
2116 
    catch {destroy .m2}
2117 
    . configure -menu ""
2118 
    menu .m1
2119 
    . configure -menu .m1
2120 
    menu .m2
2121 
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
2122 
} {0 {} {} {}}
2123 
test menu-24.5 {TkSetWindowMenuBar} {
2124 
    catch {destroy .m1}
2125 
    catch {destroy .m2}
2126 
    catch {destroy .m3}
2127 
    . configure -menu ""
2128 
    menu .m1
2129 
    . configure -menu .m1
2130 
    .m1 clone .m2
2131 
    menu .m3
2132 
    list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
2133 
} {0 {} {} {}}
2134 
test menu-24.6 {TkSetWindowMenuBar} {
2135 
    catch {destroy .m1}
2136 
    catch {destroy .m2}
2137 
    catch {destroy .m3}
2138 
    . configure -menu ""
2139 
    menu .m1
2140 
    .m1 clone .m2
2141 
    . configure -menu .m2
2142 
    menu .m3
2143 
    list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
2144 
} {0 {} {} {}}
2145 
test menu-24.7 {TkSetWindowMenuBar} {
2146 
    catch {destroy .m1}
2147 
    catch {destroy .m2}
2148 
    . configure -menu ""
2149 
    menu .m1
2150 
    menu .m2
2151 
    . configure -menu .m1
2152 
    toplevel .t2
2153 
    .t2 configure -menu .m1
2154 
    list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
2155 
} {0 {} {} {}}
2156 
test menu-24.8 {TkSetWindowMenuBar} {
2157 
    catch {destroy .m1}
2158 
    catch {destroy .m2}
2159 
    catch {destroy .t2}
2160 
    . configure -menu ""
2161 
    menu .m1
2162 
    menu .m2
2163 
    . configure -menu .m1
2164 
    toplevel .t2
2165 
    wm geometry .t2 +0+0
2166 
    .t2 configure -menu .m1
2167 
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
2168 
} {0 {} {} {}}
2169 
test menu-24.9 {TkSetWindowMenuBar} {
2170 
    catch {destroy .m1}
2171 
    catch {destroy .m2}
2172 
    catch {destroy .t2}
2173 
    catch {destroy .t3}
2174 
    . configure -menu ""
2175 
    menu .m1
2176 
    menu .m2
2177 
    . configure -menu .m1
2178 
    toplevel .t2 -menu .m1
2179 
    wm geometry .t2 +0+0
2180 
    toplevel .t3 -menu .m1
2181 
    wm geometry .t3 +0+0
2182 
    list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
2183 
} {0 {} {} {}}
2184 
test menu-24.10 {TkSetWindowMenuBar} {
2185 
    catch {destroy .m1}
2186 
    catch {destroy .m2}
2187 
    catch {destroy .t2}
2188 
    catch {destroy .t3}
2189 
    . configure -menu ""
2190 
    menu .m1
2191 
    menu .m2
2192 
    . configure -menu .m1
2193 
    toplevel .t2 -menu .m1
2194 
    wm geometry .t2 +0+0
2195 
    toplevel .t3 -menu .m1
2196 
    wm geometry .t3 +0+0
2197 
    list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
2198 
} {0 {} {} {}}
2199 
test menu-24.11 {TkSetWindowMenuBar} {
2200 
    catch {destroy .m1}
2201 
    catch {destroy .m2}
2202 
    catch {destroy .t2}
2203 
    catch {destroy .t3}
2204 
    . configure -menu ""
2205 
    menu .m1
2206 
    menu .m2
2207 
    . configure -menu .m1
2208 
    toplevel .t2 -menu .m1
2209 
    wm geometry .t2 +0+0
2210 
    toplevel .t3 -menu .m1
2211 
    wm geometry .t3 +0+0
2212 
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
2213 
} {0 {} {} {}}
2214 
test menu-24.12 {TkSetWindowMenuBar} {
2215 
    catch {destroy .m1}
2216 
    . configure -menu ""
2217 
    menu .m1
2218 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2219 
} {0 {} {} {}}
2220 
test menu-24.13 {TkSetWindowMenuBar} {
2221 
    . configure -menu ""
2222 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2223 
} {0 {} {}}
2224 
test menu-24.14 {TkSetWindowMenuBar} {
2225 
    catch {destroy .m1}
2226 
    . configure -menu ""
2227 
    menu .m1
2228 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2229 
} {0 {} {} {}}
2230 
test menu-24.15 {TkSetWindowMenuBar} {
2231 
    . configure -menu ""
2232 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
2233 
} {0 {} {}}
2234 
test menu-24.16 {TkSetWindowMenuBar} {
2235 
    catch {destroy .m1}
2236 
    . configure -menu ""
2237 
    menu .m1
2238 
    . configure -menu .m1
2239 
    list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
2240 
} {0 .t2 {} {}}
2241 
 
2242 
test menu-25.1 {DestroyMenuHashTable} {
2243 
    catch {interp destroy testinterp}
2244 
    interp create testinterp
2245 
    load {} Tk testinterp
2246 
    interp eval testinterp {menu .m1}
2247 
    list [catch {interp delete testinterp} msg] $msg
2248 
} {0 {}}
2249 
 
2250 
test menu-26.1 {GetMenuHashTable} {
2251 
    catch {interp destroy testinterp}
2252 
    interp create testinterp
2253 
    load {} tk testinterp
2254 
    list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
2255 
} {0 .m1 {}}
2256 
 
2257 
test menu-27.1 {TkCreateMenuReferences - not there before} {
2258 
    catch {destroy .m1}
2259 
    list [catch {menu .m1} msg] $msg [destroy .m1]
2260 
} {0 .m1 {}}
2261 
test menu-27.2 {TkCreateMenuReferences - there already} {
2262 
    catch {destroy .m1}
2263 
    catch {destroy .m2}
2264 
    menu .m1
2265 
    .m1 add cascade -menu .m2
2266 
    list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
2267 
} {0 .m2 {}}
2268 
 
2269 
test menu-28.1 {TkFindMenuReferences - not there} {
2270 
    catch {destroy .m1}
2271 
    . configure -menu ""
2272 
    menu .m1
2273 
    .m1 add cascade -menu .m2
2274 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
2275 
} {0 {} {} {}}
2276 
test menu-29.1 {TkFindMenuReferences - there already} {
2277 
    catch {destroy .m1}
2278 
    catch {destroy .m2}
2279 
    . configure -menu ""
2280 
    menu .m1
2281 
    menu .m2
2282 
    .m1 add cascade -menu .m2
2283 
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
2284 
} {0 {} {} {}}
2285 
 
2286 
test menu-30.1 {TkFreeMenuReferences - menuPtr} {
2287 
    catch {destroy .m1}
2288 
    menu .m1
2289 
    list [catch {destroy .m1} msg] $msg
2290 
} {0 {}}
2291 
test menu-30.2 {TkFreeMenuReferences - cascadePtr} {
2292 
    catch {destroy .m1}
2293 
    . configure -menu ""
2294 
    menu .m1
2295 
    .m1 add cascade -menu .m2
2296 
    list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
2297 
} {0 {} {}}
2298 
test menu-30.3 {TkFreeMenuReferences - topLevelListPtr} {
2299 
    . configure -menu .m1
2300 
    list [catch {. configure -menu ""} msg] $msg
2301 
} {0 {}}
2302 
test menu-30.4 {TkFreeMenuReferences - not empty} {
2303 
    catch {destroy .m1}
2304 
    catch {destroy .m2}
2305 
    menu .m1
2306 
    .m1 add cascade -menu .m3
2307 
    menu .m2
2308 
    .m2 add cascade -menu .m3
2309 
    list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
2310 
} {0 {} {}}
2311 
 
2312 
test menu-31.1 {DeleteMenuCloneEntries} {
2313 
    catch {destroy .m1}
2314 
    catch {destroy .m2}
2315 
    menu .m1
2316 
    .m1 add command -label foo
2317 
    .m1 clone .m2
2318 
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
2319 
} {0 {} {}}
2320 
test menu-31.2 {DeleteMenuCloneEntries} {
2321 
    catch {destroy .m1}
2322 
    catch {destroy .m2}
2323 
    menu .m1
2324 
    .m1 add command -label one
2325 
    .m1 add command -label two
2326 
    .m1 add command -label three
2327 
    .m1 add command -label four
2328 
    .m1 clone .m2
2329 
    list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
2330 
} {0 {} {}}
2331 
test menu-31.3 {DeleteMenuCloneEntries} {
2332 
    catch {destroy .m1}
2333 
    catch {destroy .m2}
2334 
    menu .m1 -tearoff 0
2335 
    .m1 add command -label one
2336 
    .m1 add command -label two
2337 
    .m1 add command -label three
2338 
    .m1 add command -label four
2339 
    .m1 clone .m2
2340 
    .m2 configure -tearoff 1
2341 
    list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
2342 
} {0 {} {}}
2343 
test menu-31.4 {DeleteMenuCloneEntries} {
2344 
    catch {destroy .m1}
2345 
    catch {destroy .m2}
2346 
    menu .m1
2347 
    .m1 add command -label one
2348 
    .m1 add command -label two
2349 
    .m1 add command -label three
2350 
    .m1 add command -label four
2351 
    .m1 clone .m2
2352 
    .m2 configure -tearoff 0
2353 
    list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
2354 
} {0 {} {}}
2355 
test menu-31.5 {DeleteMenuCloneEntries} {
2356 
    catch {destroy .m1}
2357 
    catch {destroy .m2}
2358 
    menu .m1
2359 
    .m1 add command -label one
2360 
    .m1 add command -label two
2361 
    .m1 clone .m2
2362 
    .m1 activate one
2363 
    list [catch {.m1 delete one} msg] $msg [destroy .m1]
2364 
} {0 {} {}}
2365 
test menu-31.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
2366 
    catch {destroy .m1}
2367 
    menu .m1
2368 
    .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
2369 
    list [catch {.m1 invoke test} msg] $msg [destroy .m1]
2370 
} {0 {} {}}
2371 
 
2372 
set l [interp hidden]
2373 
eval destroy [winfo children .]
2374 
 
2375 
test menu-32.1 {menu vs command hiding} {
2376 
    catch {destroy .m}
2377 
    menu .m
2378 
    interp hide {} .m
2379 
    destroy .m
2380 
    list [winfo children .] [interp hidden]
2381 
} [list {} $l]
2382 
 
2383 
# menu-34 MenuInit only called at boot time
2384 
 
2385 
deleteWindows

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.