proc L args {
if {[. cget -menu]==""} {
. config -menu [menu .m]
}
set name [join $args]
.m add cascade -label $name -menu [menu .m.m$name -tearoff 0]
interp alias {} | {} addsubmenu .m.m$name
}
proc addsubmenu {menu args} {
set name [join [lrange $args 0 end-1]]
set cmd [lindex $args end]
if {[lindex $cmd 0]=="|"} {
set subsub [menu $menu.m[clock clicks] -tearoff 0]
$menu add cascade -label $name -menu $subsub
interp alias {} | {} addsubmenu $subsub
eval $cmd
interp alias {} | {} addsubmenu $menu
} elseif [regexp {^[-]+} $args] {
$menu add separator
} else {
$menu add command -label $name -command $cmd
}
}#-------------------------- Sample code, which also shows one cascaded submenu: L File
| Open openFile
| Save {saveAs known}
| Save As.. saveAs
| ---
| Quit exit
L Edit
| Cut doCut
| Copy {
| foo {puts foo}
| bar {puts bar}
| grill {puts grill}
}
| Paste doPasteSee also m+ for a very simple solution without cascading.
Category GUI - Arts and crafts of Tcl-Tk programming

