**Introduction**

14Jan2004 [SMH]
Simple menu system based on [Menus made easy] by [RS]

Features:

   * Menu cascades to any depth.
   * tearoff menus (don't like 'em) are not created unless first item on menu is separator
   * Radio button not automatically in cascade - use a submenu if required
   * Radio button format changed "R varname[[=default]]" {it1 cmd1 it 2 ...}
   * 25Jan2005 [SMH] To make item use same command as the previous one, use {" [[" ]]*} - this is meant to look a bit like  'ditto' marks.  

Re: ditto: I intended to use "-" as a command  to mean that the item should share the same command
as the next item (cf [switch]). But I couldn't think of an easy way to do this. So I decided on {double quote} which breaks the if {0} comment. In the end I decided to use at least one quote and any number
of spaces - which was most easy coded with an "ARE"-style regular expression. "***: ...\s..."

**Example Menu**  

[http://www.stevehowarth.com/images/tclWiki/simpleMenu.jpg] [http://www.stevehowarth.com/images/tclWiki/simpleMenu2.jpg]



Above menu defined as follows:

 menu:create . {
    File {
            Open..       {puts open}
            --           --
            "x Check me" {puts $Check_me}
            Exit   exit
        }

    Edit {
      -- --
            Cut        {puts Cut; menu:enable . Edit Paste}
            Copy       {puts copy}
            -Paste     {puts paste}
      Advanced-> {
         "Add xx to menu" { 
             menu:add . Edit.Advanced {xx  {puts "xx"}}
             menu:enable . Edit.Advanced "remove xx"
             }
         "-remove xx" { 
             menu:delete . Edit.Advanced xx
             menu:disable . Edit.Advanced "remove xx"
         }
        "radio band SW"   {puts "Set radio band to SW"; set band SW }
      }
    }
    Radio {
      -- --
            "R band" {
              FM { puts "set band $band"}
              AM {  "    "   }
              SW {  "    "   }
             }
       Volume-> { "R vol=2" { 
                   1 {puts $vol}  
                   2    {"} 
                   10   {"} 
                   11   {"}
                }
       }
    }
    Help {
            About {tk_messageBox -message "Based on 'Menus made easy' by Richard Suchenwirth" -type ok}
    }
 }

 set files {p1.txt p2.txt p3.txt}
 foreach f $files {  menu:add . File.Reopen [list $f {puts "reopen $f"}]}


And here's the code:

 # w always identifies a toplevel item.
 # path is a path to a menu item eg "File.Reopen"

 proc menu:create {w menulist} {
    foreach {hdr items} $menulist {menu:add $w $hdr $items}
 }

 proc menu:add {w path descr} {
    set ow $w
    if {$w=="."} {set w ""}

    set it $w.menubar
    if {![winfo exists $it]} { menu $it;  $ow config -menu $it }
    
    foreach p [split $path .] {
      if {![winfo exists $it.m$p]} {
        menu $it.m$p -tearoff 0
        $it add cascade -label $p -menu $it.m$p -underline 0 
      }
      append it .m$p
    }

    set n -1
    foreach {label cmd} $descr {
      incr n
      if {$label=="--"} { 
        if {! $n} {$it configure -tearoff 1} else {$it add separator}
        continue
      }

      if {[regexp {^-(.+)} $label -> label]} {
          set state disabled
      } else {
          set state normal
      }
      if ![catch {$it index $label}] continue ;# label was there

      if {[regexp {^x (.+)} $label -> label]} {
        regsub -all " " $label "_" xlabel
        $it add check -label $label -state $state \
            -variable ::$xlabel -command $cmd
      } elseif {[regexp {^R\s+(.+)} $label -> varname]} { ;# -> Radio buttons
        if {[regexp {(.*)=(.*)} $varname  -> varname default]} {
        global $varname; set $varname $default } {global $varname}
        foreach {txt cmd} $cmd {
          if {[regexp {***:^\s*"[\s"]*$} $cmd]} {set cmd $prev} {set prev $cmd}
          $it add radio -label $txt -variable $varname -command $cmd
        }
      } elseif {[regexp {(.+)->$} $label -> label]} {  ;# Submenu
        menu:add $ow $path.$label $cmd                  ;# Added recursively
      } else {
        if {[regexp {***:^\s*"[\s"]*$} $cmd]} {set cmd $prev} {set prev $cmd}
        $it add command -label $label -state $state -command $cmd
      }
    }
 }

 proc menu:op {w path cmd index args} {
    if {$w=="."} {set w ""}
    if {$path ne "" } {set path ".m[join [split $path .] .m]"}
    catch {eval $w.menubar$path $cmd \"$index\" $args} x
 }

 proc menu:delete {w path index} {
   foreach a [split $index |] {
     menu:op $w $path delete $a
   }
 }
 proc menu:disable {w path index} {
   foreach a [split $index |] {
     menu:op $w $path entryconfigure $a -state disabled
   }
 }
 proc menu:enable {w path index} {
   foreach a [split $index |] {
     menu:op $w $path entryconfigure $a -state normal
   }
 }
----

**News**
30May2004 [SMH] Menu images at new location.

**Questions**
[RLH] 2005-08-15: Humor me I am slow at this. Could someone show "how" to attach that menu. I am learning with the Welch book and I quickly lose speed when I encounter things outside the tome.  : )
[AEC] 2005-08-15: The magic code ye seeks lies in the third and fourth executable lines of the proc body of menu:add.
[SMH] 2005-08-16:  I copied the convention of [Menus made easy] and started with an example, but to run it you have to produce the example after you've defined the required procs. Therefore move the code which precedes "And here's the code:" to the very end. If you use tclsh instead of wish, add "package require Tk" at the very top. [RLH] Bingo!

<<categories>> Arts and crafts of Tcl-Tk programming | GUI