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 frameand 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 applicationThis works very well with the configuration file bit from the bag of algorithms
Arts and crafts of Tcl-Tk programming