# 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
}
}