Version 23 of YE Menus made easy

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

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. : ) AEC 2005-08-15: The magic code ye seeks lies in the third and fourth executable lines of the proc body of menu:add.

Arts and crafts of Tcl-Tk programming

Category GUI