Updated 2011-07-12 02:37:14 by RLE

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