[Richard Suchenwirth] 2006-12-22 - The [tk_optionMenu] offers a handy alternative to a combobox. But for a larger number of structured choices, it is sometimes better to have cascading [menu]s instead of one. Here's a quick hack for that. It follows the same simple API as [tk_optionMenu], but if an item is a list of more than one elements, it is turned into a submenu. (Add an extra layer of braces around labels that contain spaces - see example below.) Oh, and the special item "--" makes a separator. ====== proc tk_optionCascade {w varName args} { set dn [image create bitmap -data "#define i_width 7\n\#define i_height 5 static char i_bits[] = {\n0,127,62,28,8\n}"] set it [lindex $args 0] while {[llength $it]>1} {set it [lindex $it 0]} set ::$varName $it menubutton $w -menu $w.m -text $it -relief raised \ -image $dn -compound right menu $w.m -tearoff 0 tk_optionCascade_add $w.m $varName $args trace add variable ::$varName write "$w config -text \${$varName} ;\#" return $w.m } proc tk_optionCascade_add {w varName argl} { set n 0 set colbreak 0 foreach arg $argl { if {$arg eq "--"} { $w add separator } elseif {$arg eq "|"} { set colbreak 1; continue } elseif {[llength $arg] == 1} { $w add radiobutton -label [join $arg] -variable $varName } else { set child [menu $w.[incr n] -tearoff 0] $w add cascade -label [lindex $arg 0] -menu $child tk_optionCascade_add $child $varName [lrange $arg 1 end] } if $colbreak { $w entryconfigure end -columnbreak 1 set colbreak 0 } } } # Demo and testing: package require Tk tk_optionCascade .o myvar \ {color red green blue -- {other yellow magenta cyan}} \ {hue dark medium light} \ -- {"multi word example"} ok pack .o ====== [RS] 2007-02-05: added "|" to be treated as column-break, for data-driven multicolumn menus, such that e.g. ====== tk_optionCascade .x myvar northwest southwest | northeast southeast ====== shows a menu of two columns, with directions in the plausible place :) [Teo] 2008-04-13: A fairly common case when [tk_optionMenu] fails to work properly is a big list of unstructured items (e.g. a list of font families). The following tk_optionCascade2 adds cascading [menu]s for items which don't fit the screen height. ====== proc tk_optionCascade2 {path varName value args} { upvar #0 $varName v if {![info exists v]} { set v $value } set m [tk_optionMenu $path $varName $v] tk_optionCascade2_menu $m $varName [linsert $args 0 $value] return $m } proc tk_optionCascade2_menu {m varName argl} { $m delete 0 end set next [menu $m.n -tearoff 0] $m add cascade -label "More" -menu $next set index 0 set len [llength $argl] set height [winfo screenheight $m] foreach arg $argl { $m insert $index radiobutton -label $arg -variable $varName incr index update idletasks if {[winfo reqheight $m] > $height && $index < $len} { incr index -1 $m delete $index tk_optionCascade2_menu $next $varName [lrange $argl $index end] return } } $m delete end } # demo eval tk_optionCascade2 .q1 myvar2 [lsort [font families]] pack .q1 ====== ---- '''[aplsimple] - 2020-04-27 17:44:46''' Below is a bit modified ''tk_optionCascade'' widget providing three options for customizing: * ''ttk::menubutton'' options (e.g. ''-width'': if positive, sets a fixed size of widget) * a command to get options of entries dynamically * additional "static" options of entries Also, this version of ''tk_optionCascade'' amends few things: * Using a full qualified name of variable, thus fixing troubles with nested namespaces, e.g. in the following case: namespace eval t { variable myvar "red" namespace eval t { variable myvar "blue" } puts "t::myvar = $t::myvar" ... tk_optionCascade .o t::myvar $items \ ... } * Removing ''-image'' option, due to ''ttk::style theme''. * Hiding options with a second click on the menu button, due to ''ttk::menubutton''. Please: ====== proc tk_optionCascade {w vname items {mbopts ""} {precom ""} args} { # A bit modified tk_optionCascade widget made by Richard Suchenwirth. # w - widget name # vname - variable name for current selection # items - list of items # mbopts - ttk::menubutton options (e.g. "-width -4") # precom - command to get entry's options (%a presents its label) # args - additional options of entries # See also: # https://wiki.tcl-lang.org/page/tk_optionCascade set it [lindex $items 0] while {[llength $it]>1} {set it [lindex $it 0]} set $vname $it ttk::menubutton $w -menu $w.m -text $it {*}$mbopts menu $w.m -tearoff 0 tk_optionCascade_add $w.m $vname $items $precom {*}$args trace add variable $vname write "$w config -text \${$vname} ;\#" return $w.m } proc tk_optionCascade_add {w vname argl precom args} { set n [set colbreak 0] foreach arg $argl { if {$arg eq "--"} { $w add separator } elseif {$arg eq "|"} { if {[tk windowingsystem] ne "aqua"} { set colbreak 1 } continue } elseif {[llength $arg] == 1} { set label [join $arg] if {$precom eq ""} { set adds "" } else { set adds [eval [string map [list %a $label] $precom]] } $w add radiobutton -label $label -variable $vname {*}$args {*}$adds } else { set child [menu $w.[incr n] -tearoff 0] $w add cascade -label [lindex $arg 0] -menu $child tk_optionCascade_add $child $vname [lrange $arg 1 end] $precom {*}$args } if $colbreak { $w entryconfigure end -columnbreak 1 set colbreak 0 } } return } # Demo and testing: package require Tk ttk::style theme use clam set items [list {color red green blue -- {colored yellow magenta cyan | #52CB2F #FFA500 #CB2F6A | #FFC0CB #90EE90 #8B6914}} \ {hue dark medium light} -- {{multi word example}} ok] set comm { if {"%a" in {yellow magenta cyan} || ![string first "#" "%a"]} \ {set _ "-background %a -activeforeground %a"} else {set _ ""} } tk_optionCascade .o ::myvar $items "-width -4" $comm \ -command {puts "::myvar = $::myvar"} pack .o ====== A screenshot of this test: [tk_optionCascade modified] <> Example