Richard Suchenwirth -- Here's some helper routines that extract menu implementations, including cascaded radios (R), separators(-- --), checkbuttons(x), initially disabled items (-) etc., from a pretty simple specification that might look like this:
menu:create . {
File {
Open.. {puts open}
New.. {puts new}
-- --
"x Check me" {puts $Check_me}
Exit exit
}
Edit {
Cut {puts cut; menu:enable . Edit Paste}
Copy {puts copy}
-Paste {puts paste}
}
Radio {
"R Band" {
band FM
FM {}
AM {}
SW {}
}
}
Help {
About {puts about}
}
}For each menu item, you may specify the associated command to be called when the menu is selected. NB: It is recommended and more efficient to call a handler proc there, which has all the details and will be compiled! Checkbuttons toggle a global variable (in whose name, spaces are replaced by underscores, e.g. "x Check me" toggles ::Check_me). Radios set the specified variable ("band" in the example) to the selected value, initially to the specified default (here: FM).
After the initial specification, you may add new top or lower items, delete, disable or enable lower items by the appropriate procedures (see below).
menu:add . Help {More {puts "sorry, no more"}}And here's the code (absolutely no warranty, but it has worked in my killer app for years now. Enjoy!):
proc menu:create {w menulist} {
if {$w=="."} {set w2 ""} else {set w2 $w}
menu $w2.menubar; $w config -menu $w2.menubar
foreach {hdr items} $menulist {menu:add $w $hdr $items}
}
proc menu:add {w top descr} {
if {$w=="."} {set w ""}
set it $w.menubar.m$top
if {![winfo exists $it]} {
menu $it
$w.menubar add cascade -label $top -menu $it -underline 0
}
foreach {label cmd} $descr {
if {$label=="--"} {$it add separator; continue}
if {[regexp {^-(.+)} $label -> label]} {
set state disabled
} else {set state normal}
if ![catch {$it index $label}] continue ;# label was there
if {[regexp {^x (.+)} $label -> label]} {
regsub -all " " $label "_" xlabel
$it add check -label $label -state $state\
-variable ::$xlabel -command $cmd
} elseif {[regexp {^R (.+)} $label -> label]} {
catch {$it add cascade -label $label -menu $it.r$label}
set radi [menu $it.r$label -tearoff 0]
foreach {varname default} $cmd break
global $varname
set $varname $default
foreach {txt cmd} [lrange $cmd 2 end] {
$radi add radio -label $txt -variable $varname -command $cmd
}
} else {
$it add command -label $label -state $state -command $cmd
}
}
}
proc menu:delete {w top label} {
if {$w=="."} {set w ""}
set it $w.menubar.m$top
catch {$it delete [$it index $label]}
}
proc menu:disable {w top args} {
if {$w=="."} {set w ""}
foreach a $args {
catch {$w.menubar.m$top entryconfigure $a -state disabled}
}
}
proc menu:enable {w top args} {
if {$w=="."} {set w ""}
foreach a $args {
catch {$w.menubar.m$top entryconfigure $a -state normal}
}
}There was a dollar sign missing on ::xlabel in the checkbox routine. I changed it to ::$xlabel. It works now. Friday, May 03, 2002 -- Ro
You might also check out: Menus Even Easier -- Larry Smith
RLH -- How do you attach the menus?
MG I just pasted the code, followed by the example above, into a wish console and it did it all for me (through the $w config -menu ... line in menu:create)...
And yet another Easy User Configurable Menus - Visual menus - YE Menus made easy - m+