# menu.tcl -- # # This demonstration script creates a window with a bunch of menus # and cascaded menus using menubars. if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." } package require Tk 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 {[tk windowingsystem] eq "aqua"} { catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1} $w.msg configure -text "This window has 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 selecting the first item in the menu." } 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 ## See Code / Dismiss buttons set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x 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 {[tk windowingsystem] eq "aqua"} { set modifier Command } elseif {[tk windowingsystem] == "win32"} { 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 # Main widget program sets variable tk_demoDirectory $m add command -bitmap @[file join $tk_demoDirectory images pattern.xbm] \ -hidemargin 1 -command [list \ tk_dialog $w.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 -hidemargin 1 -command [list \ puts "You invoked the $i bitmap" ] } $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 [list \ tk_dialog $w.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 -tearoff 1 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 } if {[tk windowingsystem] eq "aqua"} {catch {set ::tk::mac::useCustomMDEF $origUseCustomMDEF}}
Name | Type | Size | Permission | Actions |
---|---|---|---|---|
images | Folder | 0755 |
|
|
README | File | 2.03 KB | 0644 |
|
anilabel.tcl | File | 6.51 KB | 0644 |
|
aniwave.tcl | File | 3.41 KB | 0644 |
|
arrow.tcl | File | 7.8 KB | 0644 |
|
bind.tcl | File | 2.87 KB | 0644 |
|
bitmap.tcl | File | 1.38 KB | 0644 |
|
browse | File | 1.72 KB | 0755 |
|
button.tcl | File | 1.47 KB | 0644 |
|
check.tcl | File | 2.22 KB | 0644 |
|
clrpick.tcl | File | 1.4 KB | 0644 |
|
colors.tcl | File | 4.88 KB | 0644 |
|
combo.tcl | File | 1.94 KB | 0644 |
|
cscroll.tcl | File | 3.31 KB | 0644 |
|
ctext.tcl | File | 4.76 KB | 0644 |
|
dialog1.tcl | File | 660 B | 0644 |
|
dialog2.tcl | File | 613 B | 0644 |
|
en.msg | File | 3.8 KB | 0644 |
|
entry1.tcl | File | 1.35 KB | 0644 |
|
entry2.tcl | File | 2.06 KB | 0644 |
|
entry3.tcl | File | 5.95 KB | 0644 |
|
filebox.tcl | File | 2.2 KB | 0644 |
|
floor.tcl | File | 77.24 KB | 0644 |
|
form.tcl | File | 1.02 KB | 0644 |
|
goldberg.tcl | File | 55.23 KB | 0644 |
|
hello | File | 512 B | 0755 |
|
hscale.tcl | File | 1.46 KB | 0644 |
|
icon.tcl | File | 2.01 KB | 0644 |
|
image1.tcl | File | 1002 B | 0644 |
|
image2.tcl | File | 3.28 KB | 0644 |
|
items.tcl | File | 9.5 KB | 0644 |
|
ixset | File | 7.91 KB | 0755 |
|
knightstour.tcl | File | 8.38 KB | 0644 |
|
label.tcl | File | 1.29 KB | 0644 |
|
labelframe.tcl | File | 1.8 KB | 0644 |
|
license.terms | File | 2.16 KB | 0644 |
|
mclist.tcl | File | 3.89 KB | 0644 |
|
menu.tcl | File | 6.57 KB | 0644 |
|
menubu.tcl | File | 4.37 KB | 0644 |
|
msgbox.tcl | File | 1.98 KB | 0644 |
|
nl.msg | File | 6.61 KB | 0644 |
|
paned1.tcl | File | 1.08 KB | 0644 |
|
paned2.tcl | File | 2.18 KB | 0644 |
|
pendulum.tcl | File | 7.46 KB | 0644 |
|
plot.tcl | File | 2.69 KB | 0644 |
|
puzzle.tcl | File | 2.54 KB | 0644 |
|
radio.tcl | File | 2.69 KB | 0644 |
|
rmt | File | 5.22 KB | 0755 |
|
rolodex | File | 8.11 KB | 0755 |
|
ruler.tcl | File | 5.09 KB | 0644 |
|
sayings.tcl | File | 2.21 KB | 0644 |
|
search.tcl | File | 4.29 KB | 0644 |
|
spin.tcl | File | 1.78 KB | 0644 |
|
states.tcl | File | 1.63 KB | 0644 |
|
style.tcl | File | 6.78 KB | 0644 |
|
tclIndex | File | 4.25 KB | 0644 |
|
tcolor | File | 10.99 KB | 0755 |
|
text.tcl | File | 3.34 KB | 0644 |
|
textpeer.tcl | File | 2.13 KB | 0644 |
|
timer | File | 1.09 KB | 0755 |
|
toolbar.tcl | File | 3.19 KB | 0644 |
|
tree.tcl | File | 3.29 KB | 0644 |
|
ttkbut.tcl | File | 3.34 KB | 0644 |
|
ttkmenu.tcl | File | 2.35 KB | 0644 |
|
ttknote.tcl | File | 2.41 KB | 0644 |
|
ttkpane.tcl | File | 3.95 KB | 0644 |
|
ttkprogress.tcl | File | 1.52 KB | 0644 |
|
ttkscale.tcl | File | 1.39 KB | 0644 |
|
twind.tcl | File | 10.57 KB | 0644 |
|
unicodeout.tcl | File | 3.45 KB | 0644 |
|
vscale.tcl | File | 1.44 KB | 0644 |
|
widget | File | 22.83 KB | 0755 |
|