[RBR] - Inspired by [Menus Even Easier], I decided to modify the code a bit to put it in its own namespace to avoid stepping on some common names, e.g., '''push'''.  Here is the new code, the example in [Menus Even Easier] should still work with this.

 namespace eval mm {
     # Create an entire menu hierachy from a description.  It can
     # control all functions in the hierachy, enabling them and
     # disabling them as your program changes state.  Keeps torn-off
     # menus in sync with home menu.

     namespace export mm

     variable stack ""
     variable funclist ""
     variable menulist ""
     variable indxlist ""
     variable nextwidget 0
     variable torn

 }

 namespace eval ::mm::stack {
 }

 #################################################################
 #                                                               #
 #  __ _             _                           _       _       #
 # / _\ |_ __ _  ___| | _____    /\/\   ___   __| |_   _| | ___  #
 # \ \| __/ _` |/ __| |/ / __|  /    \ / _ \ / _` | | | | |/ _ \ #
 # _\ \ || (_| | (__|   <\__ \ / /\/\ \ (_) | (_| | |_| | |  __/ #
 # \__/\__\__,_|\___|_|\_\___/ \/    \/\___/ \__,_|\__,_|_|\___| #
 #                                                               #
 #################################################################

 proc ::mm::stack::height { stack } {
     upvar $stack s
     return [ llength $s ]
 }

 proc ::mm::stack::push { stack str } {
     upvar $stack s
     lappend s $str
 }

 proc ::mm::stack::pull { stack } {
     upvar $stack s

     if { $s == "" } return ""
     set result [ lindex $s end ]
     set s [ lreplace $s end end ]
     return $result
 }

 proc ::mm::stack::peek { stack } {
     upvar $stack s
     if { $s == "" } return ""
     return [ lindex $s end ]
 }

 # returns the entire stack as a pathname using the
 # given separator.  The last argument can be "prefix",
 # "suffix" or both, and indicates whether the separator
 # will precede the pathname, follow the pathname, or
 # both, resulting in .a.b.c, a.b.c. or .a.b.c.

 proc ::mm::stack::pathname { stack { separator "." } { how prefix } } {
     upvar $stack s
     set result ""
     if { "$how" != "suffix" } {
	 foreach n $s {
	     append result $separator $n
	 }
     } else {
	 foreach n $s {
	     append result $n $separator
	 }
     }
     if { "$how" == "both" } {
	 append result $separator
     }
     return $result
 }

 proc ::mm::stack::pushpath { stack pathname { separator "." } } {
     upvar $stack s
     set s [ split $pathname $separator ]
     if { [ lindex $s 0 ] == "" } { set s [ lreplace $s 0 0 ] }
 }


 #################################################################
 #                                                               #
 #                                             _       _         #
 #   /\/\   ___ _ __  _   _    /\/\   ___   __| |_   _| | ___    #
 #  /    \ / _ \ '_ \| | | |  /    \ / _ \ / _` | | | | |/ _ \   #
 # / /\/\ \  __/ | | | |_| | / /\/\ \ (_) | (_| | |_| | |  __/   #
 # \/    \/\___|_| |_|\__,_| \/    \/\___/ \__,_|\__,_|_|\___|   #
 #                                                               #
 #################################################################

 # returns a string for the next widget name
 proc ::mm::GetName { } {
     variable nextwidget

     set result w$nextwidget
     incr nextwidget
     return $result
 }

 # scans for -foo "str" pairs and converts them
 # into variable/value pairs in the surrounding
 # scope - i.e.  -foo "str" becomes "foo" with a
 # value of "str" in the calling routine.
 proc ::mm::DoSwitches { args } {
     upvar $args arglist

     set max [ llength $arglist ]
     if { $max == 1 } {
	 # braced set of args
	 eval set arglist $arglist
	 set max [ llength $arglist ]
     }
     for { set i 0 } { $i <= $max } { } {
	 set s [ lindex $arglist $i ]
	 if { [ string index $s 0 ] == "-" } {
	     set var [ string range $s 1 end ]
	     incr i
	     if { $i < $max } {
		 set val [ lindex $arglist $i ]
		 if { [ string index $val 0 ] != "-" } {
		     uplevel 1 set $var \{$val\}
		     continue
		 }
	     }
	     uplevel 1 set $var 1
	 }
	 incr i
     }
 }

 # Removes and returns the 1st element of a list
 proc ::mm::First { args } {
     upvar $args arglist

     set rtn [ lindex $arglist 0 ]
     set arglist [ lreplace $arglist 0 0 ]
     return $rtn
 }

 # called when a menu is torn off, saves the name
 # of the torn-off menu so entries on it are con-
 # trolled like regular menu entries.
 proc ::mm::TearOffControl { parent newwidget } {
     variable torn

     if { [ info exists torn($parent) ] == 0 } {
	 set torn($parent) ""
     }
     ::mm::stack::push torn($parent) $newwidget
 }

 # returns list of menus torn off of this main one.
 proc ::mm::GetTearOffs { parent } {
     variable torn

     if { [ info exists torn($parent) ] == 1 } {
	 return $torn($parent)
     } else {
	 return ""
     }
 }

 # removes a torn-off menu that no longer exists.
 proc ::mm::DeleteTearOffs { parent w } {
     variable torn

     puts "torn(parent=>$parent) => $torn($parent)"
     set i [ lsearch -exact $torn($parent) $w ]
     puts "i => $i"
     set torn($parent) [lreplace torn($parent) $i $i]
     puts "torn(parent=>$parent) => $torn($parent)\n\n"    
 }

 proc ::mm::SetState { active widget index } {
     if { $active } {
	 $widget entryconfigure $index -state normal
     } else {
	 $widget entryconfigure $index -state disabled
     }
 }

 proc ::mm::SaveControl { widget when index } {
     variable menulist
     variable funclist
     variable indxlist

     ::mm::stack::push menulist $widget
     ::mm::stack::push funclist $when
     ::mm::stack::push indxlist $index
 }

 # the menu mgr proper
 proc ::mm::mm { keyword args } {
     variable stack
     variable menulist
     variable funclist
     variable indxlist

     if { "$keyword" == "menubar" } {
	 return ".w0"

	 # mm menu - defines a new menu
     } elseif { "$keyword" == "menu" } {
	 set label [ First args ]
	 # check to see if menu is on menubar or is cascade
	 # from pulldown and create owner accordingly
	 set name [ GetName ]
	 if { [ ::mm::stack::height stack ] == 0 } {
	     ::mm::stack::push stack $name
	     frame [ ::mm::stack::pathname stack ] -relief raised -borderwidth 3 -height 30 -width 300
	     pack  [ ::mm::stack::pathname stack ] -side left -fill x -side top
	 } else {
	     if { [ ::mm::stack::height stack ] == 1 } {
		 ::mm::stack::push stack $name
		 menubutton [ ::mm::stack::pathname stack ] -menu [ ::mm::stack::pathname stack ].menu -text "$label"
		 pack [ ::mm::stack::pathname stack ] -side left -fill x
		 ::mm::stack::push stack menu
		 menu [ ::mm::stack::pathname stack ] -tearoffcommand [ namespace code TearOffControl ]
	     } else {
		 menu [ ::mm::stack::pathname stack ].$name -tearoffcommand [namespace code TearOffControl ]
		 [ ::mm::stack::pathname stack ] add cascade -label $label -menu [ ::mm::stack::pathname stack ].$name
		 ::mm::stack::push stack $name
	     }
	 }
	 eval set body $args
	 set body [ string range $body 1 [ expr [ string length $body ] - 1 ] ]
	 eval $body
	 ::mm::stack::pull stack
	 if { [ ::mm::stack::height stack ] == 2 } {
	     ::mm::stack::pull stack
	 }
	 if { [ ::mm::stack::height stack ] == 0 } { mm update }

	 # mm func - defines a function a menu can refer to
     } elseif { "$keyword" == "func" } {
	 if { [ ::mm::stack::height stack ] < 3 } {
	     error "***FATAL: func must occur within menu"
	     exit
	 }
	 set when ""
	 set cmd ""
	 DoSwitches args
	 [ ::mm::stack::pathname stack ] add command -label $label -command $cmd
	 SaveControl [ ::mm::stack::pathname stack ] $when [ [ ::mm::stack::pathname stack ] index end ]

	 # mm toggle - insert a settable boolean in menu
     } elseif { "$keyword" == "toggle" } {
	 set when ""
	 set var ""
	 set cmd ""
	 set init 0
	 DoSwitches args
	 [ ::mm::stack::pathname stack ] add checkbutton -label $label -variable \
	     $var -command $cmd -onvalue 1 -offvalue 0 -selectcolor black
	 # The \#0 is to keep Emacs' indentation parser happy.  It
	 # incorrectly thinks the hash marks starts a comment and further
	 # doesn't count brackets inside comments.
	 uplevel \#0 set $var $init
	 SaveControl [ ::mm::stack::pathname stack ] $when [ [ ::mm::stack::pathname stack ] index end ]

	 # mm check - insert a radio selector in menu
     } elseif { "$keyword" == "check" } {
	 set when ""
	 set var ""
	 set cmd ""
	 set init 0
	 DoSwitches args
	 [ ::mm::stack::pathname stack ] add radiobutton -label $label -variable \
	     $var -command $cmd -value $label -selectcolor black
	 if { $init } {
	     uplevel \#0 set $var $label
	 }
	 SaveControl [ ::mm::stack::pathname stack ] $when [ [ ::mm::stack::pathname stack ] index end ]

	 # mm separator - inserts a horizontal rule in menu
     } elseif { "$keyword" == "separator" } {
	 [ ::mm::stack::pathname stack ] add separator

	 # mm control - puts a non-menu widget under mm state control
     } elseif { "$keyword" == "control" } {
	 set widget [ First args ]
	 set when ""
	 set cmd ""
	 DoSwitches args
	 SaveControl $widget $when ""
	 mm update

	 # mm update - updates all controlled widgets according to
	 # state control expressions current values.
     } elseif { "$keyword" == "update" } {
	 set max [ ::mm::stack::height funclist ]
	 for { set i 0 } { $i < $max } { incr i } {
	     puts $funclist
	     set this_menu [ lindex $menulist $i ]
	     set ctrl [ lindex $funclist $i ]
	     set index [ lindex $indxlist $i ]
	     set active 1
	     if { "$ctrl" != "" } {
		 set active [ uplevel #0 expr $ctrl ]
	     }
	     if { "$index" == "" } {
		 if { $active } {
		     $this_menu configure -state normal
		 } else {
		     $this_menu configure -state disabled
		 }
	     } else {
		 foreach widget $this_menu {
		     SetState $active $widget $index
		     set torn [ GetTearOffs $widget ]
		     # FIXME: If there is more than one tearoff of the
		     # *same* menu, this will fail because the list gets
		     # shifted by DeleteTearOffs and e try to delete a
		     # non-exitent index....
		     if { "$torn" != "" } {
			 foreach w $torn {
			     set result [ catch { SetState $active $w [ expr $index - 1 ] } ]
			     if { $result != 0 } {
				 DeleteTearOffs $widget $w
			     }
			 }
		     }
		 }
	     }
	 }
     }
     update
 }