14Jan2004 SMH: Simple menu system based on Menus made easy by RS
Features:
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..."
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 } }
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!