Updated 2012-10-05 08:15:54 by LkpPo

this code creates a set of menus - a toolbar - from a file that can be easily edited by a user. the menus are specified in the format:
 set menu(window) {
    command "Command 1" {puts "command 1"}
    separator
    menu "Submenu 1"
        radiobutton "Radiobutton 1" rbutton1 {}
        radiobutton "Radiobutton 2" rbutton1 {::rbutton select}
    end
    checkbox "Checkbox 1" options(cbox1) {}
    tcl {
        # this is for inline tcl whose output is the syntax seen in the rest of the menu
        set r ""
        foreach x $somevar {
            lappend r [list command $x "::docommand $x"]
        }
        return [join $r]
    }
 }

# here is the code for parsing the above format

 proc makemenu {i types} {
    global prefs menu
    foreach type $types {
        if {[info exists menu($type)]} {
            menubutton $i.top.$type -text [string totitle $type] -menu $i.top.$type.menu -underline 0 -font $prefs(font,menu)
            menu $i.top.$type.menu -tearoff 0 -font $prefs(font,menu)
            menuparse $type $i.top.$type.menu $menu($type)
            pack $i.top.$type -side left
        }
    }
 }


 proc menuparse {type menu list} {
    global prefs options
    set sub -1
    set num -1
    set window .[lindex [split $menu .] 1]
    set end [llength $list]
    while {[set list [lreplace $list 0 $num]] != ""} {
        set num 0
        switch -exact -- [lindex $list 0] {
            command {
                $menu add command -label [lindex $list 1] -command [lindex $list 2]
                incr num 2
            }
            separator {
                $menu add separator
            }
            menu {
                incr sub
                $menu add cascade -label [subst [lindex $list 1]] -menu $menu.$sub
                append menu .$sub
                menu $menu -tearoff 0 -font $prefs(font,menu)
                $menu delete 0 end
                incr num
            }
            end {
                set menu [string range $menu 0 [expr [string last . $menu] - 1]]
            }
            checkbutton {
                $menu add checkbutton -label [lindex $list 1] -variable [subst [lindex $list 2]] -command [subst [lindex $list 3]]
                incr num 3
            }
            radiobutton {
                $menu add radiobutton -label [lindex $list 1] -variable [subst [lindex $list 2]] -command [subst [lindex $list 3]]
                incr num 3
            }
            tcl {
                menuparse $type $menu [menutcl $window $type [lindex $list 1]]
                incr num
            }
            default {
                Echo .0 "\[ error \] Unknown menu option \"[lindex $list 0]\" in $type menu" error default
                return
            }
        }
    }
 }


 proc menutcl {window type tcl} {
    global prefs menu options
    if {[catch {eval $tcl} err] == 1} {
        Echo .0 "\[ error \] Error in $type menu tcl command: $err" error default
        return {}
    }
    return $err
 }

this can all then be called as
 makemenu .toplevel.menubar [array names menu]

where menubar is an existing frame

and if you want to let the user change the menubar while the program is running
 foreach child [winfo children .toplevel.menubar] {
     destroy $child
 }
 makemenu .toplevel.menubar [array names menu]

which will not affect the application

This works very well with the configuration file bit from the bag of algorithms

Arts and crafts of Tcl-Tk programming