proc m+ {head name {cmd ""}} {
if {![winfo exists .m.m$head]} {
.m add cascade -label $head -menu [menu .m.m$head -tearoff 0]
}
if [regexp ^-+$ $name] {
.m.m$head add separator
} elseif {[regexp {^\?(.+)} $name -> name]} {
.m.m$head add checkbutton -label $name -variable $cmd
} else {.m.m$head add command -label $name -comm $cmd}
}
#-- Demo example:
pack [text .t]
. configure -menu [menu .m]
m+ File Open {.t insert end "opened\n"}
m+ File Save {.t insert end "saved\n"}
m+ File -----
m+ File Exit exit
m+ Edit Cut ...
m+ ?Verbose verbose ;# checkbutton, toggles the global variable "verbose"
pack [text .t -wrap word] -fill both -expand 1An earlier, less simple approach is at Menus made easy
DKF: Here's a version that does a little bit more processing:
proc m+ {head name {cmd ""}} {
# OK, it's using an undocumented and unsupported feature of Tk; it's convenient though
if {![winfo exists .m.m$head]} {
foreach {l u} [::tk::UnderlineAmpersand $head] break
.m add cascade -label $l -underline $u -menu [menu .m.m$head -tearoff 0]
}
if {[regexp ^-+$ $name]} {
.m.m$head add separator
} else {
foreach {l u} [::tk::UnderlineAmpersand $name] break
.m.m$head add command -label $l -underline $u -comm $cmd
}
}I've done even more complex versions in the past where I'd also give the binding for the hotkey for the menu entry and the code would generate the accelerator to go with that as well as binding the accelerator correctly. It's nice, but the code is (very) long-winded.Here's how I'd write the above example with this new version: pack [text .t]
. configure -menu [menu .m]
m+ &File &Open {.t insert end "opened\n"}
m+ &File &Save {.t insert end "saved\n"}
m+ &File -----
m+ &File E&xit exit
m+ &Edit &Cut ... Bryan Oakley I've never liked the overly complex menu systems like Menus made easy but I also don't like spelling them out longhand. The above m+ approach is great. In the past I've done something similar, though I allow one to specify all the menu options and use a slightly different syntax that allows for arbitrarily deep menus (though I rarely go beyond two, and never beyond three):
mm &View->&Fonts->&Choose... -command {...}Alas, at the moment I don't have the code handy, but it's pretty darn easy to recreate.ENJ I grabbed this lovely concept for my project, and extended it to handle deep menus. I also added support for radiobuttons and for spaces in the menu labels. (Underscore in the name will display as a space.) So for the next person that needs it, I thought I'd post my version here.
proc m+ {head name {param ""}} {
if {![winfo exists .m]} {
. configure -menu [menu .m]
}
set newhead .m
# Follow the cascade of submenus (e.g. &File->&New Work&space), creating them if they don't exist
while {1} {
if {[regexp {^([^\->]+)->(.+)} $head -> cascname remain]} {
if {![winfo exists $newhead.m$cascname]} {
foreach {l u} [::tk::UnderlineAmpersand [string map {_ " "} $cascname]] break
$newhead add cascade -label $l -underline $u -menu [menu $newhead.m$cascname -tearoff 0]
}
set newhead $newhead.m$cascname
set head $remain
} else {
if {![winfo exists $newhead.m$head]} {
foreach {l u} [::tk::UnderlineAmpersand [string map {_ " "} $head]] break
$newhead add cascade -label $l -underline $u -menu [menu $newhead.m$head -tearoff 0]
}
set newhead $newhead.m$head
break
}
}
if {[regexp ^-+$ $name]} {
# Separators are added with "m+ ----"
$newhead add separator
} elseif {[regexp {^\?(.+)} $name -> name]} {
# Checkbuttons are added with "m+ ?name variable"
foreach {l u} [::tk::UnderlineAmpersand [string map {_ " "} $name]] break
$newhead add checkbutton -label $l -underline $u -variable $param
} elseif {[regexp {^\#(.+)} $name -> name]} {
# Radiobuttons are added with "m+ #name variable"
foreach {l u} [::tk::UnderlineAmpersand [string map {_ " "} $name]] break
$newhead add radiobutton -label $l -underline $u -variable $param
} else {
# General commands are added with "m+ name command"
foreach {l u} [::tk::UnderlineAmpersand [string map {_ " "} $name]] break
$newhead add command -label $l -underline $u -comm $param
}
}My version of the example, with extra lines for the extra features: pack [text .t]
m+ &File->&Open &Text_file {.t insert end "opened\n"}
m+ &File->&Open &Param_file {.t insert end "set params from file\n"}
m+ &File &Save {.t insert end "saved\n"}
m+ &File -----
m+ &File E&xit exit
m+ &Edit &Cut ...
set portL [RawListSerialPorts] ;# Wraps a registry query
foreach port $portL {
# Sets the global variable comport to the selected port ID.
m+ &Config->&COM_Port #$port ::comport
}
m+ &Config ?Show_&Debug debug ;# enable debug-level loggingHJG What unsupported Tk-feature is used here ?ZB It seems, he meant ::tk::UnderlineAmpersand. Very nice and handy solution, indeed...
