Updated 2016-02-08 01:10:08 by HJG ▲

Introduction edit

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 edit

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 edit

Questions edit

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!

Arts and crafts of Tcl-Tk programmingCategory GUI