# Tk 8 added the -title option to menu widgets ====== package require Tk if {[package vcompare [package provide Tk] 8] < 0} { rename menu Tk4.2_menu proc menu {args} { set cmd [uplevel [list Tk4.2_menu [lindex $args 0]]] rename $cmd Tk4.2_$cmd proc $cmd {option args} { set myName [lindex [info level 0] 0] switch -glob -- $option { cg* { if {[string first $option cget] != 0} { return [uplevel [list Tk4.2_$myName $option] $args] } if {[llength $args] == 1 && [string match -title [lindex $args 0]]} { return "" } else { uplevel [list Tk4.2_$myName $option] $args } } co* { if {[string first $option configure] != 0} { return [uplevel [list Tk4.2_$myName $option] $args] } switch -exact -- [llength $args] { 0 { set options [uplevel [list Tk4.2_$myName configure]] lappend options {-title title Title {} {}} return [lsort $options] } 1 { if {[string match -title [lindex $args 0]]} { return {-title title Title {} {}} } else { uplevel [list Tk4.2_$myName configure] $args } } default { set bg [Tk4.2_$myName cget -bg] if {[llength $args] % 2} { set odd [lindex $args end] set args [lreplace $args end end] } set passArgs [list -bg $bg] foreach {opt val} $args { if {[string compare -title $opt]} { lappend passArgs $opt $val } } if {[info exists odd] && [string compare -title $odd]} { uplevel [list Tk4.2_$myName configure] \ $passArgs [list $odd] } elseif {[info exists odd]} { uplevel [list Tk4.2_$myName configure] \ $passArgs return -code error \ "value for \"-title\" missing" } else { uplevel [list Tk4.2_$myName configure] \ $passArgs } } } } default { uplevel [list Tk4.2_$myName $option] $args } } } uplevel [list $cmd configure] [lrange $args 1 end] return $cmd } } ====== <> Porting | GUI