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