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