1 | # menu.tcl -- |
---|
2 | # |
---|
3 | # This demonstration script creates a window with a bunch of menus |
---|
4 | # and cascaded menus using menubars. |
---|
5 | # |
---|
6 | # RCS: @(#) $Id: menu.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ |
---|
7 | |
---|
8 | if {![info exists widgetDemo]} { |
---|
9 | error "This script should be run from the \"widget\" demo." |
---|
10 | } |
---|
11 | |
---|
12 | set w .menu |
---|
13 | catch {destroy $w} |
---|
14 | toplevel $w |
---|
15 | wm title $w "Menu Demonstration" |
---|
16 | wm iconname $w "menu" |
---|
17 | positionWindow $w |
---|
18 | |
---|
19 | label $w.msg -font $font -wraplength 4i -justify left |
---|
20 | if {$tcl_platform(platform) == "macintosh"} { |
---|
21 | $w.msg configure -text "This window contains a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by dragging outside of its bounds and releasing the mouse." |
---|
22 | } else { |
---|
23 | $w.msg configure -text "This window contains a menubar with cascaded menus. You can post a menu from the keyboard by typing Alt+x, where \"x\" is the character underlined on the menu. You can then traverse among the menus using the arrow keys. When a menu is posted, you can invoke the current entry by typing space, or you can invoke any entry by typing its underlined character. If a menu entry has an accelerator, you can invoke the entry without posting the menu just by typing the accelerator. The rightmost menu can be torn off into a palette by selecting the first item in the menu." |
---|
24 | } |
---|
25 | pack $w.msg -side top |
---|
26 | |
---|
27 | set menustatus " " |
---|
28 | frame $w.statusBar |
---|
29 | label $w.statusBar.label -textvariable menustatus -relief sunken -bd 1 -font "Helvetica 10" -anchor w |
---|
30 | pack $w.statusBar.label -side left -padx 2 -expand yes -fill both |
---|
31 | pack $w.statusBar -side bottom -fill x -pady 2 |
---|
32 | |
---|
33 | frame $w.buttons |
---|
34 | pack $w.buttons -side bottom -fill x -pady 2m |
---|
35 | button $w.buttons.dismiss -text Dismiss -command "destroy $w" |
---|
36 | button $w.buttons.code -text "See Code" -command "showCode $w" |
---|
37 | pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 |
---|
38 | |
---|
39 | menu $w.menu -tearoff 0 |
---|
40 | |
---|
41 | set m $w.menu.file |
---|
42 | menu $m -tearoff 0 |
---|
43 | $w.menu add cascade -label "File" -menu $m -underline 0 |
---|
44 | $m add command -label "Open..." -command {error "this is just a demo: no action has been defined for the \"Open...\" entry"} |
---|
45 | $m add command -label "New" -command {error "this is just a demo: no action has been defined for the \"New\" entry"} |
---|
46 | $m add command -label "Save" -command {error "this is just a demo: no action has been defined for the \"Save\" entry"} |
---|
47 | $m add command -label "Save As..." -command {error "this is just a demo: no action has been defined for the \"Save As...\" entry"} |
---|
48 | $m add separator |
---|
49 | $m add command -label "Print Setup..." -command {error "this is just a demo: no action has been defined for the \"Print Setup...\" entry"} |
---|
50 | $m add command -label "Print..." -command {error "this is just a demo: no action has been defined for the \"Print...\" entry"} |
---|
51 | $m add separator |
---|
52 | $m add command -label "Dismiss Menus Demo" -command "destroy $w" |
---|
53 | |
---|
54 | set m $w.menu.basic |
---|
55 | $w.menu add cascade -label "Basic" -menu $m -underline 0 |
---|
56 | menu $m -tearoff 0 |
---|
57 | $m add command -label "Long entry that does nothing" |
---|
58 | if {$tcl_platform(platform) == "macintosh"} { |
---|
59 | set modifier Command |
---|
60 | } elseif {$tcl_platform(platform) == "windows"} { |
---|
61 | set modifier Control |
---|
62 | } else { |
---|
63 | set modifier Meta |
---|
64 | } |
---|
65 | foreach i {A B C D E F} { |
---|
66 | $m add command -label "Print letter \"$i\"" -underline 14 \ |
---|
67 | -accelerator Meta+$i -command "puts $i" -accelerator $modifier+$i |
---|
68 | bind $w <$modifier-[string tolower $i]> "puts $i" |
---|
69 | } |
---|
70 | |
---|
71 | set m $w.menu.cascade |
---|
72 | $w.menu add cascade -label "Cascades" -menu $m -underline 0 |
---|
73 | menu $m -tearoff 0 |
---|
74 | $m add command -label "Print hello" \ |
---|
75 | -command {puts stdout "Hello"} -accelerator $modifier+H -underline 6 |
---|
76 | bind $w <$modifier-h> {puts stdout "Hello"} |
---|
77 | $m add command -label "Print goodbye" -command {\ |
---|
78 | puts stdout "Goodbye"} -accelerator $modifier+G -underline 6 |
---|
79 | bind $w <$modifier-g> {puts stdout "Goodbye"} |
---|
80 | $m add cascade -label "Check buttons" \ |
---|
81 | -menu $w.menu.cascade.check -underline 0 |
---|
82 | $m add cascade -label "Radio buttons" \ |
---|
83 | -menu $w.menu.cascade.radio -underline 0 |
---|
84 | |
---|
85 | set m $w.menu.cascade.check |
---|
86 | menu $m -tearoff 0 |
---|
87 | $m add check -label "Oil checked" -variable oil |
---|
88 | $m add check -label "Transmission checked" -variable trans |
---|
89 | $m add check -label "Brakes checked" -variable brakes |
---|
90 | $m add check -label "Lights checked" -variable lights |
---|
91 | $m add separator |
---|
92 | $m add command -label "Show current values" \ |
---|
93 | -command "showVars $w.menu.cascade.dialog oil trans brakes lights" |
---|
94 | $m invoke 1 |
---|
95 | $m invoke 3 |
---|
96 | |
---|
97 | set m $w.menu.cascade.radio |
---|
98 | menu $m -tearoff 0 |
---|
99 | $m add radio -label "10 point" -variable pointSize -value 10 |
---|
100 | $m add radio -label "14 point" -variable pointSize -value 14 |
---|
101 | $m add radio -label "18 point" -variable pointSize -value 18 |
---|
102 | $m add radio -label "24 point" -variable pointSize -value 24 |
---|
103 | $m add radio -label "32 point" -variable pointSize -value 32 |
---|
104 | $m add sep |
---|
105 | $m add radio -label "Roman" -variable style -value roman |
---|
106 | $m add radio -label "Bold" -variable style -value bold |
---|
107 | $m add radio -label "Italic" -variable style -value italic |
---|
108 | $m add sep |
---|
109 | $m add command -label "Show current values" \ |
---|
110 | -command "showVars $w.menu.cascade.dialog pointSize style" |
---|
111 | $m invoke 1 |
---|
112 | $m invoke 7 |
---|
113 | |
---|
114 | set m $w.menu.icon |
---|
115 | $w.menu add cascade -label "Icons" -menu $m -underline 0 |
---|
116 | menu $m -tearoff 0 |
---|
117 | $m add command \ |
---|
118 | -bitmap @[file join $tk_library demos images pattern.bmp] \ |
---|
119 | -hidemargin 1 \ |
---|
120 | -command { |
---|
121 | tk_dialog .pattern {Bitmap Menu Entry} {The menu entry you invoked displays a bitmap rather than a text string. Other than this, it is just like any other menu entry.} {} 0 OK |
---|
122 | } |
---|
123 | foreach i {info questhead error} { |
---|
124 | $m add command -bitmap $i -command "puts {You invoked the $i bitmap}" -hidemargin 1 |
---|
125 | } |
---|
126 | $m entryconfigure 2 -columnbreak 1 |
---|
127 | |
---|
128 | set m $w.menu.more |
---|
129 | $w.menu add cascade -label "More" -menu $m -underline 0 |
---|
130 | menu $m -tearoff 0 |
---|
131 | foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} { |
---|
132 | $m add command -label $i -command [list puts "You invoked \"$i\""] |
---|
133 | } |
---|
134 | |
---|
135 | set m $w.menu.colors |
---|
136 | $w.menu add cascade -label "Colors" -menu $m -underline 1 |
---|
137 | menu $m |
---|
138 | foreach i {red orange yellow green blue} { |
---|
139 | $m add command -label $i -background $i \ |
---|
140 | -command [list puts "You invoked \"$i\""] |
---|
141 | } |
---|
142 | |
---|
143 | $w configure -menu $w.menu |
---|
144 | |
---|
145 | bind Menu <<MenuSelect>> { |
---|
146 | global $menustatus |
---|
147 | if {[catch {%W entrycget active -label} label]} { |
---|
148 | set label " " |
---|
149 | } |
---|
150 | set menustatus $label |
---|
151 | update idletasks |
---|
152 | } |
---|