This page is about a code which aimed to help a developper to deal with tk menu widgets.
------
<<TOC>>
------
**** Introduction ****
[FM], 2009-04-05.
Menu are tree object. Here is a code to design their trees as [nested list]. 

I choose to use a 4-length [nested list] (nl4tree) because for cascades entries, their is two kinds of data : the options for the uplevel menu itself and also the options to be set when adding the child menu.

Here is a code to make a ''nl4tree''. To use it you need the '''nl4''' ensemble command, which can be found at [nested list] page of the wiki.

**** nl4 tree package ****
----
<<TOC>>
----
======

# package require nl4;# look at [nested list] page to get the nl4 ensemble command

namespace eval nl4tree {

    proc append {tree ParentNode TreeToAppend} {
        # nl4tree append ... Ok
        upvar $tree Tree
        ::set Index [lreplace [nl4tree lindex $Tree $ParentNode] end end 2 0 0]
        ::set l [::lindex $Tree $Index]
        lappend l $TreeToAppend
        lset Tree $Index $l
    }

    proc children {tree parent} {
        # nl4tree children ... Ok
        ::set Children [list]
        lassign [nl4 index $tree] node data0 data1 children
        foreach {child} [::lindex $children] {
            if {$parent eq $node} {
                lappend Children {*}[::lindex $child 0]
            } else {
                lappend Children {*}[nl4tree children $child $parent]
            }
        }
        return $Children
    }

    proc delete {tree node} {
        # nl4tree delete ... Ok
        upvar $tree Tree
        if {$node eq [nl4tree root $Tree]} {uplevel "unset $tree"; return}
        ::set TailIndex [::lindex [::set NodeIndex [nl4tree lindex $Tree $node]] end-1]
        ::set ListNodeIndex [lreplace $NodeIndex end-1 end]
        ::set L [lreplace [::lindex $Tree $ListNodeIndex] $TailIndex $TailIndex]
        ::set ParentIndex [nl4tree lindex $Tree [::set Parent [nl4tree parent $Tree $node]]]
        ::set SubTreeIndex [lreplace $ParentIndex end end]
        lset Tree {*}$SubTreeIndex [nl4 rindice [nl4 type $Tree]] 0 0 $L
        return
    }

    proc get {tree node numdict args} {
        # nl4tree get .. Ok
        ::set index [lreplace [nl4tree lindex $tree $node] end end]
        return [dict get [nl4 index [::lindex $tree $index] [expr {$numdict+1}]] {*}$args]
    }
    proc set {tree node numdict args} {
        # nl4tree set .. Ok
        upvar $tree Tree
        ::set keys [lrange $args 0 end-1]
        ::set arg [::lindex $args end]
        ::set index [lreplace [nl4tree lindex $Tree $node] end end ]
        ::set DictIndex [::lindex [nl4 iorder [nl4 type [::lindex $Tree $index]]] [expr {$numdict+1}]]
        ::set Dict [nl4 index [::lindex $Tree $index] [expr {$numdict+1}]]
        dict set Dict {*}$keys $arg
        lset Tree {*}$index $DictIndex [list $Dict]
        return $Dict
    }
    proc insert {tree Parent index TreeToInsert} {
        # nl4tree insert ...Ok
        upvar $tree Tree
        ::set ParentIndex [lreplace [nl4tree lindex $Tree $Parent] end end 2 0 0]
        ::set l [::lindex $Tree $ParentIndex]
        if {$index < [nl4tree numchildren $Tree $Parent]} {
            lset Tree $ParentIndex [linsert $l $index $TreeToInsert]
        }        
    }

    proc keys {tree node numdict args} {
        # nl4tree keys ... Ok
        ::set index [lreplace [nl4tree lindex $tree $node] end end]
        return [dict keys [nl4 index [::lindex $tree $index] [expr {$numdict+1}]] {*}$args]
    }

    proc lindex {tree parent {index {}}} {
        # nl4tree lindex ... Ok
        lassign [nl4 index $tree] node data0 data1 children
        if {$parent eq $node} {
            return [list {*}$index 0]
        }
        ::set j 0
        foreach {child} [::lindex $children] {
            ::set {childIndex} [list {*}$index 2 0 0 $j]
            if {[::set p [nl4tree lindex $child $parent $childIndex]] ne ""} {
                return $p
            }
            incr j
        }
        return        
    }
    proc glob {tree pattern {index {}}} {
        # nl4tree glob ... Ok
        lassign [nl4 index $tree] node data0 data1 children
        if {[string match $pattern $node]} {
            lappend L $node
        }
        ::set j 0
        foreach {child} [::lindex $children] {
            ::set {childIndex} [list {*}$index 2 0 0 $j]
            lappend L {*}[nl4tree glob $child $pattern $childIndex]
            incr j
        }
        if {[info exist L]} {
            return $L
        }
    }
    proc node {tree args} {
        # nl4tree node ... Ok
        ::set i 0
        foreach i $args {
            lappend Index 2 0 0 $i
            incr i
        }
        lappend Index 0
        ::lindex $tree {*}$Index
    }

    proc numchildren {tree node} {
        # nl4tree numchildren ... Ok
        ::set Index [lreplace [nl4tree lindex $tree $node] end end]
        llength [nl4 index [::lindex $tree $Index] 3]
    }

    proc parent {tree parent {Parent {}}} {
        # nl4tree parent ... Ok
        lassign [nl4 index $tree] node data0 data1 children
        if {$parent eq $node} {
            return $Parent
        }
        foreach {child} [::lindex $children] {
            if {[::set p [nl4tree parent $child $parent $node]] ne ""} {
                return $p
            }
        }
        return        
    }

    proc root {tree} {
        # nl4tree root ... Ok
        return [::lindex $tree 0]        
    }
    namespace export *
    namespace ensemble create
}

package provide nl4tree 0.1
======
**** treeMenu package ****
----
<<TOC>>
----
======
# source nl4tree.tcl;# you'll find the nl4tree ensemble command just above

namespace eval treeMenu {
    # create menu / cascade
    proc cascade {D0 D1 args} {
        if {[llength $args] != 0} {
            menu [::set N .menu[incr ::numMenu]] -tearoff false {*}$D0
            return [nl4 south $N $D0 $D1 [list $args]]
        } else {
            return [nl4 south $N $D0 $D1]
        }
    }

    # command entry
    proc command {args} {
        ::set N .command[incr ::numCommand]
        return [nl4 south $N {} [dict create {*}$args]]
    }

    # separator entry
    proc separator {args} {
        ::set N .separator[incr ::numSeparator]
        return [nl4 south $N {} {}]
    }

    # checkbutton entry
    proc checkbutton {args} {
        ::set N .checkbutton[incr ::numCheckButton]
        return [nl4 south $N {} [dict create {*}$args]]
    }
    
    # radiobutton entry
    proc radiobutton {args} {
        ::set N .radiobutton[incr ::numRadioButton]
        return [nl4 south $N {} [dict create {*}$args]]
    }

    # Build the menu
    variable TreeMenu
    proc set {var tree {node {}}} {
        variable TreeMenu
        if {$node eq {}} {
            ::set TreeMenu($var,script) $tree
            ::set tree [uplevel $tree]
            ::set TreeMenu($var,tree) $tree
            ::set node [nl4tree root $tree]           
        }
        foreach n [nl4tree children $tree $node] {
            if {[string match .menu* $n]} {
                $node add cascade -menu $n {*}[nl4tree get $tree $n 1]
            } elseif {[string match .command* $n]} {
                $node add command {*}[::set options [nl4tree get $tree $n 1]]
                if {[dict exist $options -accelerator]} {
                    ::set Accelerator [string map {Ctrl Control + -} [dict get $options -accelerator]]
                    if {! (([string index $Accelerator 0] eq "<") && ([string index $Accelerator 0] eq ">"))} {
                        ::set Accelerator <$Accelerator>
                    }
                    bind . $Accelerator [subst {
                        $node invoke [$node index [dict get $options -label]]
                    }]
                }
            } elseif {[string match .separator* $n]} {
                $node add separator {*}[nl4tree get $tree $n 1]
            } elseif {[string match .checkbutton* $n]} {
                $node add checkbutton {*}[nl4tree get $tree $n 1]
            } elseif {[string match .radiobutton* $n]} {
                $node add radiobutton {*}[nl4tree get $tree $n 1]
            }
            
            ::treeMenu set $var $tree $n
        }
        return $node
    }
    proc update {var widget} {
        # basic : destruction / reconstruction
        variable TreeMenu
        destroy {*}[nl4tree glob $TreeMenu($var,tree) .menu*]
        $widget conf -menu [uplevel [list ::treeMenu set $var $TreeMenu($var,script)]]
    }
    namespace export *
    namespace ensemble create
}

# package provide treeMenu 0.1

======
**** Here's an exemple, so you can feel the way it works. ****
----
<<TOC>>
----
======
# package require treeMenu (See above)
# using some shorthand

interp alias {} + {} treeMenu cascade
interp alias {} ! {} treeMenu command
interp alias {} - {} treeMenu separator
interp alias {} x {} treeMenu checkbutton
interp alias {} ° {} treeMenu radio

# Use some alternatives languages for menu label

proc translate {label lang} {
    return [dict get [dict create \
                          Fichier [dict create en File fr Fichier] \
                          Ouvrir [dict create en Open fr Ouvrir] \
                          Nouveau [dict create en New fr Nouveau] \
                          Exporter [dict create en Export fr Exporter]\
                          Enregistrer [dict create en Save fr Enregistrer]\
                          "Enregistrer sous..." [dict create en "Save as..." fr "Enregistrer sous..."]\
                          Editer [dict create en Edit fr Editer] \
                          Fermer [dict create en Close fr Fermer] \
                          Quitter [dict create en Quit fr Quitter]\
                          Copier [dict create en Copy fr Copier]\
                          Coller [dict create en Paste fr Coller]\
                          Couper [dict create en Cut fr Couper]\
                          "en PDF" [dict create en "as PDF" fr "en PDF"]\
                          "en DVI" [dict create en "as DVI" fr "en DVI"]\
                          "en Postscript" [dict create en "as Postscript" fr "en Postscript"]\
                          "Cas" [dict create en Check fr "Cas"]\
                          "Options" [dict create en Options fr "Options"]\
                          "Anglais" [dict create en "English" fr "Anglais"]\
                          "Français" [dict create en "French" fr "Français"]\
                          "Comme nouveau" [dict create en "As new file" fr "Comme nouveau"]\
                          "Comme un calque" [dict create en "As new layer" fr "Comme un calque"]\
                          "Verrouiller" [dict create en "Press to lock file" fr "Cliquer pour verrouiller"]\
                          "Déverrouiller" [dict create en "Press to unlock file" fr "Cliquer pour déverrouiller"]\
                         ] $label $lang]
}

# use state variables (fileopen : if there is a file open, lock : to protect the file of any change)
set fileopen 0
set lock 0
# variable to config the langage (you can change it in options menu)
set lang fr
# style of the menu
set Style [list -bg DarkOrange4  -fg white -activebackground DarkOliveGreen  -activeforeground yellow -font \
               [set font [font create -family Helvetica -size 12]]]

# Create the menu on the . Widget
. conf -menu [treeMenu set Menu {
    + $Style {} \
        [+ $Style [list \
                       -label [translate "Fichier" $lang] \
                       -underline 0 ] \
             [!   -label [translate "Nouveau" $lang] \
                  -underline 0 \
                  -accelerator Ctrl+n \
                  -image [image create photo -data {
                      R0lGODlhEAAQAMZYAIiKg4iKhYqLg5ORe6CdeamkacW5TdPDO9HFYO3UAO3UAe3UAu3UBO3UBe3V
                      BO3VB+3VCe3VCujUJe7WCu7XEfDaIPPdIvPdI/ThP/fiNvTjW/XkV/rmRfrmRvblYPblYfrnR/Dk
                      iu7klvvoS+7lj/voTPvoTe/lj+bizezkqenjvOzkqujjw+fjye7mm+zlrOTj2eTj2uPj3ePj3uPj
                      4ePj4uPj4+fk2+Tk5OXk5OTl4eXl5e3nvunm1ubm5urn1Ofn5+ro3Ojo6Ovo5enp5+rp6erp6uvr
                      6+zs7Pjxr/32wvz55vz65vz65/365vz67P375/376v376/377f389P39/f7+/P7+/v//////////
                      ////////////////////////////////////////////////////////////////////////////
                      /////////////////////////////////////////////////////////////////////////yH5
                      BAEKAH8ALAAAAAAQABAAAAergH9/AYQBAAMFBgcSF4KCAVeRV09JGxUKChQWjpBIR0M8EAsJU1MJ
                      Cg6PV0dFQS4NTU6yTkwOHYNXRkQ/IQxMs7QOILhCQD0nGAtQsksKGSO4QD43LxoMVkxMTQ4cJrg+
                      OzotJA9RDAxSDyWqOTg2MywiER8eEwicVzb67ygqKylKCODbp4+GjBgwqAgYSFBfjRpVAjBsqO+K
                      RFUU91nEJ6mjpIuDCokcKSgQADs=
                  }]\
                  -compound left \
                  -command {
                      set fileopen 1
                      treeMenu update Menu .
                  }] \
             [!   -label [translate "Ouvrir" $lang] \
                  -underline 0 \
                  -accelerator Ctrl-o \
                  -image [image create photo -data {
                      R0lGODlhEAAQAMZCAExOSk1PS05QTU9RTVBSTlVXU1dZVVhaVmJkYGRmXmZoY2lrZ2psaG1vZXt9
                      a4GEcIeJgYqNeIyPe4+Rfo+SfpCSg5KUgZiajJmbhpqch5qdiJydkJ2fkaKkk6OklaOllqeplqmq
                      mqqumq+wma6wnq+wn7CxmrGym7CyoLGxrbKzprO1o7m6rLu9qr6/rr6/r76+vL/Arr/Ar8DBr8DB
                      tcHDssPEs8PEt8PFtcnKu8rMvsvNvs/Qws/RwtDRw9DRxNHSxO7u7P//////////////////////
                      ////////////////////////////////////////////////////////////////////////////
                      ////////////////////////////////////////////////////////////////////////////
                      /////////////////////////////////////////////////////////////////////////yH5
                      BAEKAH8ALAAAAAAQABAAAAemgAwFg4MLf4eIiAU1OI0sBYmRBS0aGRglhJkFCn8FKxQUExYhHR4f
                      px8ckJ6gCZqDDaqdnxQFQre4QgWyBSgRErZBwsK6F6skERG2MMzMuhWrIA8PwcNBz6siDg62KQMA
                      4OABBwcFCAHoARs3QEA8Ozo5EIM+PPb2NiMm+/s/gz0nAgoceGIEjUEuZsRYOGOGjIcLX6jYRICA
                      gIsYBVS0aCCSR4+BAAA7
                  }] \
                  -compound left \
                  -command {
                      set fileopen 1
                      tk_getOpenFile
                      treeMenu update Menu .
                  }] \
             [- ------------------------------------------ -]\
             [+ $Style [list \
                            -label [translate "Exporter" $lang] \
                            -state [expr {$fileopen ? "normal" : "disable"}] \
                            -underline 0] \
                  [!   -label [translate "en PDF" $lang]  \
                       -command {
                           tk_getSaveFile
                       }] \
                  [!   -label [translate "en DVI" $lang] \
                       -command {
                           tk_getSaveFile
                       }] \
                  [!   -label [translate "en Postscript" $lang] \
                       -command {
                           tk_getSaveFile
                       }] \
                 ]\
             [- ----------------------------------------- -]\
             [!   -label [translate "Enregistrer" $lang] \
                  -state [expr {$fileopen==1 && $lock == 0 ? "normal" : "disable"}]\
                  -accelerator {Ctrl+s} \
                  -image [image create photo -data {
                      R0lGODlhEAAQAKUnACBKh1VXU85cAGF6kmF6k117mWJ7kmN7kmJ8lGN8lGB+nGmMsHCeznGeznKf
                      znKfz46pzJS227Kyspi43PyvPrm5ubm6urq6ur+/v8LCwsXFxb7S6tbW1sjZ7tfX1+Hh4eLi4uPj
                      4+bm5ufn5/T09Pn5+f7+/v//////////////////////////////////////////////////////
                      /////////////////////////////////////////////yH5BAEKAD8ALAAAAAAQABAAAAaAQIBQ
                      QCwahcJNh8JsOjeb5KNErVofUcBmCup6uyWs1EQqm81i7cPkabvbpPSWfD7L16a8Xn9/+P+AdwsI
                      hIUICxF3ChcaGh8jHhYFDBFZWwONAQEgGhUEDZVSBo6ajRifoQAQEwYfIqUZEqhZqgchHBe5FRUJ
                      DhNRP0Kaw8RIAEEAOw==
                  }]\
                  -compound left \
                  -command {
                      tk_getSaveFile
                  }] \
             [!   -label [translate "Enregistrer sous..." $lang] \
                  -state [expr {$fileopen ? "normal" : "disable"}] \
                  -image [image create photo -data {
                      R0lGODlhEAAQAKU7AAAAAExCJiBKh1VXU2tXNnBbOY9ZArdaAM5cAGF6kmF6k117mWJ7kmN7kmJ8
                      lGN8lGB+nKCDVWmMsKOFVaSHV3CeznGeznKfznKfz46pzMKritKsas+tcZS227KyssSwkZi43Pyv
                      Prm5ubm6urq6usi9rL+/v8LCwsXFxb7S6t/Vw9bW1sjZ7tfX1+PZx+Hh4eLi4uPj4+bm5ufn5+7q
                      xu/rx/Pz8/T09Pn5+fz8/P7+/v///////////////////yH5BAEKAD8ALAAAAAAQABAAAAadQIEQ
                      QSwaDAeEUJhihZ5PA41jCKVSTAxuizPUNhGDC4MVpLQwmHdDMXxwlvJZd7sVNBODqh7P6loGAQQG
                      JS0tNmR+NwB6dY6JZhg6k5SUOZBnGJqbnJgYEg6hog4SHZ4QJCgoLzMtIwsVHXIYCaoDAzAoIgoW
                      slkMq7eqJry+AhkgDC8ywicexWXHDTErJNYiIg8XIFg/Qrfg4UsCQQA7
                  }] -compound left \
                  -command {
                      tk_getSaveFile
                  }] \
             [!   -label [translate "Fermer" $lang] \
                  -state [expr {$fileopen ? "normal" : "disable"}] \
                  -command {
                      tk_messageBox -message "Closing"
                      set fileopen 0
                      set lock 0
                      treeMenu update Menu .
                  }] \
             [- ---------------------------------------- -]\
             [!   -label [translate "Quitter" $lang] -accelerator {Ctrl+q} \
                  -image [image create photo -data {
                      R0lGODlhEAAQAKUzAAcPAA0cABMoAKQAABgtBrQAABgzAMwAAC40NiI+CCFBBitODSpPBy9WDTJZ
                      EDZbGDleGe8pKTpiFzhmDjtlGD5kHltbWjxsE0FuGT9wFUNuH0R1GUZ0I0t6Imxsakt+H05+JVB+
                      KlB/K3Z5enl5d/uCgqSkoq2tq7e3tbm5t729u8DAvcHBvtDQzdPT0NTU0d7e3ODg3uLi4P//////
                      /////////////////////////////////////////////yH5BAEKAD8ALAAAAAAQABAAAAaDwJ9w
                      SCwaEcik8ihzrU4yBECAIA4GiOYKFQ0YqsNBaQBzsVJRgqJ6vZbGrXM0wWC/34exyhRdNOwHgYFj
                      JBYIDhNsEQWMjBEDHlEPF4oRlgWPcggQGWxtlgMvmhIYYEIDjzKiMlEUG6Y/VwgxrCMIFRwfsEJZ
                      thodICEiuz9KxsRGRUEAOw==
                  }]  -compound left  -command {
                      tk_messageBox -message [translate "Quitter" $lang]
                  }] \
            ]\
        [+ $Style [list \
                       -label [translate "Editer" $lang] \
                       -state [expr {$fileopen ? "normal" : "disable"}]] \
             [!   -label [translate "Couper" $lang] \
                  -accelerator Ctrl+x \
                  -image [image create photo -data {
                      R0lGODlhEAAQAIQZAFVXU2VnY3R1coGCf42Oi5iZlqipp66sp7Gup7+7sb6/vcfEu8jHwsrKyczK
                      xs/KwdHOxNXTytjW0dza0dzb1uPh3OPi3OTi3evp5f///////////////////////////yH5BAEK
                      AB8ALAAAAAAQABAAAAVJ4CeOZFkCpzmiJMCe1AtMb1sV4wDVq8MEHwAGwRsJJIQPIZJUBS8HgCVR
                      JAUWgEf15HKKXC4FwNBNBRufBou3Xn3Nsjd37q2HAAA7
                  }] \
                  -compound left \
                  -command {
                      tk_messageBox -message "Coupé"
                  }] \
             [!   -label [translate "Copier" $lang] \
                  -accelerator Ctrl+c \
                  -image [image create photo -data {
                      R0lGODlhEAAQAMIEAIiKhbu8uLq9tu7u7P///////////////yH5BAEKAAcALAAAAAAQABAAAANE
                      eLC891CRSSeIDxDBO7mYNozkh0mdB0biGDRNtnFaRV3toKWcudMEUglX+aVMikZQOECyZscVJDc8
                      GQUj59R2OyVhoAQAOw==
                  }] \
                  -compound left \
                  -command {
                      tk_messageBox -message "Copié"
                  }] \
             [!   -label [translate "Coller" $lang] \
                  -state [expr {$lock ? "disable" : "normal"}] \
                  -accelerator Ctrl+v \
                  -image [image create photo -data {
                      R0lGODlhEAAQAMZFAC0mGiwtLDstFy40No9ZAot2Unt5cIiDc4iKhZyTf6KbjaCinqGkoKOloaWm
                      o6aopKeopaippqmrp6qrqKusqausqq2uq7+8s+m5bs7Lwc/Mwc7Pys/RzdHTztbTyNLUz9TW0tXX
                      0tjY2NnY19fZ1dna19ra2Nrb2Nvb29vd2dze2t3e297f3N/h3d/h3uDi3u/gx+Hi3+Lj3+Pj4+Pk
                      4uTl4ubn5efo5efo5uvo3Ovo3enp5+jq6Orr6Ovr6evs6uzt6+7v7e/v7fDx7/Pz8f//////////
                      ////////////////////////////////////////////////////////////////////////////
                      ////////////////////////////////////////////////////////////////////////////
                      /////////////////////////////////////////////////////////////////////////yH5
                      BAEKAH8ALAAAAAAQABAAAAeegH+CggOFg4eCBIoAKDMiAooEhwQwMAYBIxcmAQqVkokwGAM5HhoZ
                      OgMYMJ9/lBgFhbEFqqyuGBgJCLq7vLYYCEXBwsIIvsAbHB8gJCUpRcWht8AdCwwNDg8uz8ZFISQn
                      KiwxNNvRv0UlDhAREhQ45bfnKy0yNTY7PvDSRS8TFRY9gAjRd67GDR4/ggwhUq4SDGDDhiFoFekA
                      r4sIAgEAOw==
                  }] \
                  -compound left \
                  -command {
                      tk_messageBox -message "Collé"
                  }] \
             \
             [- --------------Separator--------------------------- -]\
             [+ $Style [dict create \
                            -label [translate "Coller" $lang]... \
                            -state [expr {$lock ? "disable" : "normal"}]]\
                  \
                  [!   -label [translate "Comme un calque" $lang] \
                       -command {
                           tk_messageBox -message "Collé comme un calque"
                       }]\
                  [!   -label [translate "Comme nouveau" $lang]\
                       -command {
                           tk_messageBox -message "Coller comme nouveau"
                       }]\             
             ]\
            ] \
        [+ $Style [dict create \
                       -label [translate "Options" $lang] \
                       -underline 0] \
             \
             [x   -label [translate [expr {$lock ? "Déverrouiller" : "Verrouiller"}] $lang ]\
                  -state [expr  {$fileopen ? "normal" : "disable"}]\
                  -variable ::lock \
                  -onvalue 1 -offvalue 0 \
                  -command {
                      treeMenu update Menu .
                  }]\
             [- ---------Separator----------------------------------- -]\
             [° -label [translate Anglais $lang] -variable ::lang -value en -command {
                 treeMenu update Menu .
             }]\
             [° -label [translate Français $lang] -variable ::lang -value fr -command {
                 treeMenu update Menu .
             }]\
]}]

======
Fully configurable, style control, langage handling, state handling, accelerator handling, readable, tree aspect. It's marvelous, isn't it ?
----
**** Reaction, ideas, ...****
----
<<TOC>>
----
----
!!!!!!
%| enter categories here |%
!!!!!!