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