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

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tk/] [tests/] [unixMenu.test] - Blame information for rev 1782

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

powered by: WebSVN 2.1.0

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