diff -r 000000000000 -r ae805ac0140d python-2.5.2/win32/tcl/tix8.4/OptMenu.tcl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/OptMenu.tcl	Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,394 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: OptMenu.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
+#
+# OptMenu.tcl --
+#
+#	This file implements the TixOptionMenu widget.
+#
+# Copyright (c) 1993-1999 Ioi Kim Lam.
+# Copyright (c) 2000-2001 Tix Project Group.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixOptionMenu {
+    -classname TixOptionMenu
+    -superclass tixLabelWidget
+    -method {
+	add delete disable enable entrycget entryconfigure entries
+    }
+    -flag {
+	-command -disablecallback -dynamicgeometry -value -variable
+	-validatecmd -state
+    }
+    -forcecall {
+	-variable -state
+    }
+    -configspec {
+	{-command command Command ""}
+	{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+	{-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
+	{-state state State normal}
+	{-value value Value ""}
+	{-validatecmd validateCmd ValidateCmd ""}
+	{-variable variable Variable ""}
+    }
+    -default {
+	{.highlightThickness			0}
+	{.takeFocus				0}
+	{.frame.menubutton.relief		raised}
+	{.frame.menubutton.borderWidth		2}
+	{.frame.menubutton.anchor		w}
+	{.frame.menubutton.highlightThickness	2}
+	{.frame.menubutton.takeFocus		1}
+    }
+}
+
+proc tixOptionMenu:InitWidgetRec {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w InitWidgetRec
+ 
+    set data(nItems)	0
+    set data(items)     ""
+    set data(posted)	0
+    set data(varInited)	0
+    set data(maxWidth)  0
+}
+
+proc tixOptionMenu:ConstructFramedWidget {w frame} {
+    upvar #0 $w data
+
+    tixChainMethod $w ConstructFramedWidget $frame
+
+    set data(w:menubutton) [menubutton $frame.menubutton -indicatoron 1]
+    set data(w:menu)       [menu $frame.menubutton.menu -tearoff 0]
+    pack $data(w:menubutton) -side left -expand yes -fill both
+
+    $data(w:menubutton) config -menu $data(w:menu)
+
+    bind $data(w:menubutton) <Up>   [bind Menubutton <space>]
+    bind $data(w:menubutton) <Down> [bind Menubutton <space>]
+
+    tixSetMegaWidget $data(w:menubutton) $w
+}
+
+proc tixOptionMenu:SetBindings {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w SetBindings
+}
+
+#----------------------------------------------------------------------
+# Private methods
+#----------------------------------------------------------------------
+proc tixOptionMenu:Invoke {w name} {
+    upvar #0 $w data
+
+    if {"$data(-state)" == "normal"} {
+	tixOptionMenu:SetValue $w $name
+    }
+}
+
+proc tixOptionMenu:SetValue {w value {noUpdate 0}} {
+    upvar #0 $w data
+
+    if {$data(-validatecmd) != ""} {
+	set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
+    }
+
+    set name $value
+
+    if {$name == "" || [info exists data(varInited)]} {
+	# variable may contain a bogus value
+	if {![info exists data($name,index)]} {
+	    set data(-value) ""
+	    tixVariable:UpdateVariable $w
+	    $data(w:menubutton) config -text ""
+	    return
+	}
+    }
+
+    if {[info exists data($name,index)]} {
+       $data(w:menubutton) config -text $data($name,label)
+
+       set data(-value) $value
+
+       if {! $noUpdate} {
+	   tixVariable:UpdateVariable $w
+       }
+
+       if {$data(-command) != "" && !$data(-disablecallback)} {
+	   if {![info exists data(varInited)]} {
+	       set bind(specs) ""
+	       tixEvalCmdBinding $w $data(-command) bind $value
+	   }
+       }
+    } else {
+	error "item \"$value\" does not exist"
+    }
+}
+
+proc tixOptionMenu:SetMaxWidth {w} {
+    upvar #0 $w data
+
+    foreach name $data(items) {
+	set len [string length $data($name,label)]
+	if {$data(maxWidth) < $len} {
+	    set data(maxWidth) $len
+	}
+    }
+
+    if {$data(maxWidth) > 0} {
+	$data(w:menubutton) config -width $data(maxWidth)
+    }
+}
+
+#----------------------------------------------------------------------
+# Configuration
+#----------------------------------------------------------------------
+proc tixOptionMenu:config-state {w value} {
+    upvar #0 $w data
+
+    if {![info exists data(w:label)]} {
+	return
+    }
+
+    if {$value == "normal"} {
+	catch {
+	    $data(w:label) config -fg \
+		[$data(w:menubutton) cget -foreground]
+	}
+	$data(w:menubutton) config -state $value
+    } else {
+	catch {
+	    $data(w:label) config -fg \
+		[$data(w:menubutton) cget -disabledforeground]
+	}
+	$data(w:menubutton) config -state $value
+    }
+}
+
+proc tixOptionMenu:config-value {w value} {
+    upvar #0 $w data
+
+    tixOptionMenu:SetValue $w $value
+
+    # This will tell the Intrinsics: "Please use this value"
+    # because "value" might be altered by SetValues
+    #
+    return $data(-value)
+}
+
+proc tixOptionMenu:config-variable {w arg} {
+    upvar #0 $w data
+
+    if {[tixVariable:ConfigVariable $w $arg]} {
+       # The value of data(-value) is changed if tixVariable:ConfigVariable 
+       # returns true
+       tixOptionMenu:SetValue $w $data(-value) 1
+    }
+    catch {
+	unset data(varInited)
+    }
+    set data(-variable) $arg
+}
+
+#----------------------------------------------------------------------
+# Public Methdos
+#----------------------------------------------------------------------
+proc tixOptionMenu:add {w type name args} {
+    upvar #0 $w data
+
+    if {[info exists data($name,index)]} {
+	error "item $name already exists in the option menu $w"
+    }
+
+    case $type {
+	"command" {
+	    set validOptions {
+		-command -label
+	    }
+	    set opt(-command)		""
+	    set opt(-label)		$name
+
+	    tixHandleOptions -nounknown opt $validOptions $args
+
+	    if {$opt(-command)	!= ""} {
+		error "option -command cannot be specified"
+	    }
+
+	    # Create a new item inside the menu
+	    #
+	    eval $data(w:menu) add command $args \
+		[list -label $opt(-label) \
+		-command "tixOptionMenu:Invoke $w \{$name\}"]
+	    set index $data(nItems)
+
+	    # Store info about this item
+	    #
+	    set data($index,name) $name
+	    set data($name,type) cmd
+	    set data($name,label) $opt(-label)
+	    set data($name,index) $index
+
+	    if {$index == 0} {
+		$data(w:menubutton) config -text $data($name,label)
+		tixOptionMenu:SetValue $w $name
+	    }
+
+	    incr data(nItems)
+	    lappend data(items) $name
+
+	    if $data(-dynamicgeometry) {
+		tixOptionMenu:SetMaxWidth $w
+	    }
+	}
+	"separator" {
+	    $data(w:menu) add separator
+
+	    set index $data(nItems)
+	    # Store info about this item
+	    #
+	    set data($index,name) $name
+	    set data($name,type) sep
+	    set data($name,label) ""
+	    set data($name,index) $index
+
+	    incr data(nItems)
+	    lappend data(items) $name
+	}
+	default {
+	    error "only types \"separator\" and \"command\" are allowed"
+	}
+    }
+
+    return ""
+}
+
+proc tixOptionMenu:delete {w item} {
+    upvar #0 $w data
+
+    if {![info exists data($item,index)]} {
+	error "item $item does not exist in $w"
+    }
+
+    # Rehash the item list
+    set newItems ""
+    set oldIndex 0
+    set newIndex 0
+    foreach name $data(items) {
+	if {$item == $name} {
+	    unset data($name,label)
+	    unset data($name,index)
+	    unset data($name,type)
+	    $data(w:menu) delete $oldIndex
+	} else {
+	    set data($name,index)    $newIndex
+	    set data($newIndex,name) $name
+	    incr newIndex
+	    lappend newItems $name
+	}
+	incr oldIndex
+    }
+    incr oldIndex -1; unset data($oldIndex,name)
+    set data(nItems) $newIndex
+    set data(items) $newItems
+
+    if {$data(-value) == $item} {
+	set newVal ""
+	foreach item $data(items) {
+	    if {$data($item,type) == "cmd"} {
+		set newVal $item
+	    }
+	}
+	tixOptionMenu:SetValue $w $newVal
+    }
+
+    return ""
+}
+
+
+proc tixOptionMenu:disable {w item} {
+    upvar #0 $w data
+
+    if {![info exists data($item,index)]} {
+	error "item $item does not exist in $w"
+    } else {
+	catch {$data(w:menu) entryconfig $data($item,index) -state disabled}
+    }
+}
+
+proc tixOptionMenu:enable {w item} {
+    upvar #0 $w data
+
+    if {![info exists data($item,index)]} {
+	error "item $item does not exist in $w"
+    } else {
+	catch {$data(w:menu) entryconfig $data($item,index) -state normal}
+    }
+}
+
+proc tixOptionMenu:entryconfigure {w item args} {
+    upvar #0 $w data
+
+    if {![info exists data($item,index)]} {
+	error "item $item does not exist in $w"
+    } else {
+	return [eval $data(w:menu) entryconfig $data($item,index) $args]
+    }
+}
+
+proc tixOptionMenu:entrycget {w item arg} {
+    upvar #0 $w data
+
+    if {![info exists data($item,index)]} {
+	error "item $item does not exist in $w"
+    } else {
+	return [$data(w:menu) entrycget $data($item,index) $arg]
+    }
+}
+
+proc tixOptionMenu:entries {w} {
+    upvar #0 $w data
+
+    return $data(items)
+}
+
+
+proc tixOptionMenu:Destructor {w} {
+
+    tixVariable:DeleteVariable $w
+
+    # Chain this to the superclass
+    #
+    tixChainMethod $w Destructor
+}
+
+#----------------------------------------------------------------------
+# Obsolete
+# These have been replaced by new commands in Tk 4.0
+#
+proc tixOptionMenu:Post {w} {
+    upvar #0 $w data
+
+    set rootx [winfo rootx $data(w:frame)]
+    set rooty [winfo rooty $data(w:frame)]
+
+    # adjust for the border of the menu and frame
+    #
+    incr rootx [lindex [$data(w:menu)  config -border] 4]
+    incr rooty [lindex [$data(w:frame) config -border] 4]
+    incr rooty [lindex [$data(w:menu)  config -border] 4]
+
+    set value $data(-value)
+    set y [$data(w:menu) yposition $data($value,index)]
+
+    $data(w:menu) post $rootx [expr $rooty - $y]
+    $data(w:menu) activate $data($value,index)
+    grab -global $data(w:menubutton)
+    set data(posted) 1
+}