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