~ubuntu-branches/ubuntu/dapper/tk8.0/dapper-updates

« back to all changes in this revision

Viewing changes to library/demos/menu.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Mike Markley
  • Date: 2001-07-24 21:57:40 UTC
  • Revision ID: james.westby@ubuntu.com-20010724215740-r70t25rtmbqjil2h
Tags: upstream-8.0.5
ImportĀ upstreamĀ versionĀ 8.0.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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
}