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

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
   }
 }
----

30May2004 [SMH] Menu images at new location.

[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.  : )

----

[Arts and crafts of Tcl-Tk programming]
| [Category GUI]