--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/Event.tcl	Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,217 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: Event.tcl,v 1.6 2004/04/09 21:37:01 hobbs Exp $
+#
+# Event.tcl --
+#
+#	Handles the event bindings of the -command and -browsecmd options
+#	(and various of others such as -validatecmd).
+#
+# Copyright (c) 1993-1999 Ioi Kim Lam.
+# Copyright (c) 2000-2001 Tix Project Group.
+# Copyright (c) 2004 ActiveState
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+# Evaluate high-level bindings (-command, -browsecmd, etc):
+# with % subsitution or without (compatibility mode)
+#
+#
+# BUG : if a -command is intercepted by a hook, the hook must use
+#       the same record name as the issuer of the -command. For the time
+#	being, you must use the name "bind" as the record name!!!!!
+#
+#----------------------------------------------------------------------
+
+namespace eval ::tix {
+    variable event_flags ""
+    set evs [list % \# a b c d f h k m o p s t w x y A B E K N R S T W X Y]
+    foreach ev $evs {
+	lappend event_flags "%$ev"
+    }
+
+    # This is a "name stack" for storing the "bind" structures
+    #
+    # The bottom of the event stack is usually a raw event (generated by
+    # tixBind) but it may also be a programatically triggered (caused by
+    # tixEvalCmdBinding)
+    variable EVENT
+    set EVENT(nameStack)	""
+    set EVENT(stackLevel)	0
+}
+
+proc tixBind {tag event action} {
+    set cmd [linsert $::tix::event_flags 0 _tixRecordFlags $event]
+    append cmd "; $action; _tixDeleteFlags;"
+
+    bind $tag $event $cmd
+}
+
+proc tixPushEventStack {} {
+    variable ::tix::EVENT
+
+    set lastEvent [lindex $EVENT(nameStack) 0]
+    incr EVENT(stackLevel)
+    set thisEvent ::tix::_event$EVENT(stackLevel)
+
+    set EVENT(nameStack) [list $thisEvent $EVENT(nameStack)]
+
+    if {$lastEvent == ""} {
+	upvar #0 $thisEvent this
+	set this(type) <Application>
+    } else {
+	upvar #0 $lastEvent last
+	upvar #0 $thisEvent this
+
+	foreach name [array names last] {
+	    set this($name) $last($name)
+	}
+    }
+
+    return $thisEvent
+}
+
+proc tixPopEventStack {varName} {
+    variable ::tix::EVENT
+
+    if {$varName ne [lindex $EVENT(nameStack) 0]} {
+	error "unmatched tixPushEventStack and tixPopEventStack calls"
+    }
+    incr EVENT(stackLevel) -1
+    set EVENT(nameStack) [lindex $EVENT(nameStack) 1]
+    global $varName
+    unset $varName
+}
+
+
+# Events triggered by tixBind
+#
+proc _tixRecordFlags [concat event $::tix::event_flags] {
+    set thisName [tixPushEventStack]; upvar #0 $thisName this
+
+    set this(type) $event
+    foreach f $::tix::event_flags {
+	set this($f) [set $f]
+    }
+}
+
+proc _tixDeleteFlags {} {
+    variable ::tix::EVENT
+
+    tixPopEventStack [lindex $EVENT(nameStack) 0]
+}
+
+# programatically trigged events
+#
+proc tixEvalCmdBinding {w cmd {subst ""} args} {
+    global tixPriv tix
+    variable ::tix::EVENT
+
+    set thisName [tixPushEventStack]; upvar #0 $thisName this
+
+    if {$subst != ""} {
+	upvar $subst bind
+
+	if {[info exists bind(specs)]} {
+	    foreach spec $bind(specs) {
+		set this($spec) $bind($spec)
+	    }
+	}
+	if {[info exists bind(type)]} {
+	    set this(type) $bind(type)
+	}
+    }
+
+    if {[catch {
+	if {![info exists tix(-extracmdargs)]
+	    || [string is true -strict $tix(-extracmdargs)]} {
+	    # Compatibility mode
+	    set ret [uplevel \#0 $cmd $args]
+	} else {
+	    set ret [uplevel 1 $cmd]
+	}
+    } error]} {
+	if {[catch {tixCmdErrorHandler $error} error]} {
+	    # double fault: just print out 
+	    tixBuiltInCmdErrorHandler $error
+	}
+	tixPopEventStack $thisName
+	return ""
+    } else {
+	tixPopEventStack $thisName
+
+	return $ret
+    }
+}
+
+proc tixEvent {option args} {
+    global tixPriv
+    variable ::tix::EVENT
+    set varName [lindex $EVENT(nameStack) 0]
+
+    if {$varName == ""} {
+	error "tixEvent called when no event is being processed"
+    } else {
+	upvar #0 $varName event
+    }
+
+    switch -exact -- $option {
+	type {
+	    return $event(type)
+	}
+	value {
+	    if {[info exists event(%V)]} {
+		return $event(%V)
+	    } else {
+		return ""
+	    }
+	}
+	flag {
+	    set f %[lindex $args 0]
+	    if {[info exists event($f)]} {
+		return $event($f)
+	    }
+	    error "The flag \"[lindex $args 0]\" does not exist"
+	}
+	match {
+	    return [string match [lindex $args 0] $event(type)]
+	}
+	default {
+	    error "unknown option \"$option\""
+	}
+    }
+}
+
+# tixBuiltInCmdErrorHandler --
+#
+#	Default method to report command handler errors. This procedure is
+#	also called if double-fault happens (command handler causes error,
+#	then tixCmdErrorHandler causes error).
+#
+proc tixBuiltInCmdErrorHandler {errorMsg} {
+    global errorInfo tcl_platform
+    if {![info exists errorInfo]} {
+	set errorInfo "???"
+    }
+    if {$tcl_platform(platform) eq "windows"} {
+	bgerror "Tix Error: $errorMsg"
+    } else {
+	puts "Error:\n $errorMsg\n$errorInfo"
+    }
+}
+
+# tixCmdErrorHandler --
+#
+#	You can redefine this command to handle the errors that occur
+#	in the command handlers. See the programmer's documentation
+#	for details
+#
+if {![llength [info commands tixCmdErrorHandler]]} {
+    proc tixCmdErrorHandler {errorMsg} {
+	tixBuiltInCmdErrorHandler $errorMsg
+    }
+}
+