Menus made easy

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+

Category GUI

Arts and Crafts of Tcl-Tk Programming