Initial revision

1 files changed, 4533 insertions, 0 deletions

diff --git a/generic/tkBind.c b/generic/tkBind.c
new file mode 100644
index 0000000..bb37b00
--- /dev/null
+++ b/generic/tkBind.c
@@ -0,0 +1,4533 @@
+/* 
+ * tkBind.c --
+ *
+ *	This file provides procedures that associate Tcl commands
+ *	with X events or sequences of X events.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkBind.c 1.133 97/07/01 17:59:53
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * File structure:
+ *
+ * Structure definitions and static variables.
+ *
+ * Init/Free this package.
+ *
+ * Tcl "bind" command (actually located in tkCmds.c).
+ * "bind" command implementation.
+ * "bind" implementation helpers.
+ *
+ * Tcl "event" command.
+ * "event" command implementation.
+ * "event" implementation helpers.
+ *
+ * Package-specific common helpers.
+ *
+ * Non-package-specific helpers.
+ */
+
+
+/*
+ * The following union is used to hold the detail information from an
+ * XEvent (including Tk's XVirtualEvent extension).
+ */
+typedef union {
+    KeySym	keySym;	    /* KeySym that corresponds to xkey.keycode. */
+    int		button;	    /* Button that was pressed (xbutton.button). */
+    Tk_Uid	name;	    /* Tk_Uid of virtual event. */
+    ClientData	clientData; /* Used when type of Detail is unknown, and to
+			     * ensure that all bytes of Detail are initialized
+			     * when this structure is used in a hash key. */
+} Detail;
+
+/*
+ * The structure below represents a binding table.  A binding table
+ * represents a domain in which event bindings may occur.  It includes
+ * a space of objects relative to which events occur (usually windows,
+ * but not always), a history of recent events in the domain, and
+ * a set of mappings that associate particular Tcl commands with sequences
+ * of events in the domain.  Multiple binding tables may exist at once,
+ * either because there are multiple applications open, or because there
+ * are multiple domains within an application with separate event
+ * bindings for each (for example, each canvas widget has a separate
+ * binding table for associating events with the items in the canvas).
+ *
+ * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
+ * below 30.  To see this, consider a triple mouse button click while
+ * the Shift key is down (and auto-repeating).  There may be as many
+ * as 3 auto-repeat events after each mouse button press or release
+ * (see the first large comment block within Tk_BindEvent for more on
+ * this), for a total of 20 events to cover the three button presses
+ * and two intervening releases.  If you reduce EVENT_BUFFER_SIZE too
+ * much, shift multi-clicks will be lost.
+ * 
+ */
+
+#define EVENT_BUFFER_SIZE 30
+typedef struct BindingTable {
+    XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
+					 * (higher indices are for more recent
+					 * events). */
+    Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym,
+					 * button, Tk_Uid, or 0) for each
+					 * entry in eventRing. */
+    int curEvent;			/* Index in eventRing of most recent
+					 * event.  Newer events have higher
+					 * indices. */
+    Tcl_HashTable patternTable;		/* Used to map from an event to a
+					 * list of patterns that may match that
+					 * event.  Keys are PatternTableKey
+					 * structs, values are (PatSeq *). */
+    Tcl_HashTable objectTable;		/* Used to map from an object to a
+					 * list of patterns associated with
+					 * that object.  Keys are ClientData,
+					 * values are (PatSeq *). */
+    Tcl_Interp *interp;			/* Interpreter in which commands are
+					 * executed. */
+} BindingTable;
+
+/*
+ * The following structure represents virtual event table.  A virtual event
+ * table provides a way to map from platform-specific physical events such
+ * as button clicks or key presses to virtual events such as <<Paste>>,
+ * <<Close>>, or <<ScrollWindow>>.
+ *
+ * A virtual event is usually never part of the event stream, but instead is
+ * synthesized inline by matching low-level events.  However, a virtual
+ * event may be generated by platform-specific code or by Tcl scripts.  In
+ * that case, no lookup of the virtual event will need to be done using
+ * this table, because the virtual event is actually in the event stream.
+ */
+
+typedef struct VirtualEventTable {
+    Tcl_HashTable patternTable;     /* Used to map from a physical event to
+				     * a list of patterns that may match that
+				     * event.  Keys are PatternTableKey
+				     * structs, values are (PatSeq *). */
+    Tcl_HashTable nameTable;	    /* Used to map a virtual event name to
+				     * the array of physical events that can
+				     * trigger it.  Keys are the Tk_Uid names
+				     * of the virtual events, values are
+				     * PhysicalsOwned structs. */
+} VirtualEventTable;
+
+/*
+ * The following structure is used as a key in a patternTable for both 
+ * binding tables and a virtual event tables.
+ *
+ * In a binding table, the object field corresponds to the binding tag
+ * for the widget whose bindings are being accessed.
+ *
+ * In a virtual event table, the object field is always NULL.  Virtual
+ * events are a global definiton and are not tied to a particular
+ * binding tag.
+ *
+ * The same key is used for both types of pattern tables so that the 
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+typedef struct PatternTableKey {
+    ClientData object;		/* For binding table, identifies the binding
+				 * tag of the object (or class of objects)
+				 * relative to which the event occurred.
+				 * For virtual event table, always NULL. */
+    int type;			/* Type of event (from X). */
+    Detail detail;		/* Additional information, such as keysym,
+				 * button, Tk_Uid, or 0 if nothing
+				 * additional. */
+} PatternTableKey;
+
+/*
+ * The following structure defines a pattern, which is matched against X
+ * events as part of the process of converting X events into Tcl commands.
+ */
+
+typedef struct Pattern {
+    int eventType;		/* Type of X event, e.g. ButtonPress. */
+    int needMods;		/* Mask of modifiers that must be
+				 * present (0 means no modifiers are
+				 * required). */
+    Detail detail;		/* Additional information that must
+				 * match event.  Normally this is 0,
+				 * meaning no additional information
+				 * must match.  For KeyPress and
+				 * KeyRelease events, a keySym may
+				 * be specified to select a
+				 * particular keystroke (0 means any
+				 * keystrokes).  For button events,
+				 * specifies a particular button (0
+				 * means any buttons are OK).  For virtual
+				 * events, specifies the Tk_Uid of the
+				 * virtual event name (never 0). */
+} Pattern;
+
+/*
+ * The following structure defines a pattern sequence, which consists of one
+ * or more patterns.  In order to trigger, a pattern sequence must match
+ * the most recent X events (first pattern to most recent event, next
+ * pattern to next event, and so on).  It is used as the hash value in a
+ * patternTable for both binding tables and virtual event tables.
+ *
+ * In a binding table, it is the sequence of physical events that make up
+ * a binding for an object.
+ * 
+ * In a virtual event table, it is the sequence of physical events that
+ * define a virtual event.
+ *
+ * The same structure is used for both types of pattern tables so that the 
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+
+typedef struct PatSeq {
+    int numPats;		/* Number of patterns in sequence (usually
+				 * 1). */
+    TkBindEvalProc *eventProc;	/* The procedure that will be invoked on
+				 * the clientData when this pattern sequence
+				 * matches. */
+    TkBindFreeProc *freeProc;	/* The procedure that will be invoked to
+				 * release the clientData when this pattern
+				 * sequence is freed. */
+    ClientData clientData;	/* Arbitray data passed to eventProc and
+				 * freeProc when sequence matches. */
+    int flags;			/* Miscellaneous flag values; see below for
+				 * definitions. */
+    int refCount;		/* Number of times that this binding is in
+				 * the midst of executing.  If greater than 1,
+				 * then a recursive invocation is happening.
+				 * Only when this is zero can the binding
+				 * actually be freed. */
+    struct PatSeq *nextSeqPtr;  /* Next in list of all pattern sequences
+				 * that have the same initial pattern.  NULL
+				 * means end of list. */
+    Tcl_HashEntry *hPtr;	/* Pointer to hash table entry for the
+				 * initial pattern.  This is the head of the
+				 * list of which nextSeqPtr forms a part. */
+    struct VirtualOwners *voPtr;/* In a binding table, always NULL.  In a
+				 * virtual event table, identifies the array
+				 * of virtual events that can be triggered by
+				 * this event. */
+    struct PatSeq *nextObjPtr;  /* In a binding table, next in list of all
+				 * pattern sequences for the same object (NULL
+				 * for end of list).  Needed to implement
+				 * Tk_DeleteAllBindings.  In a virtual event
+				 * table, always NULL. */
+    Pattern pats[1];		/* Array of "numPats" patterns.  Only one
+				 * element is declared here but in actuality
+				 * enough space will be allocated for "numPats"
+				 * patterns.  To match, pats[0] must match
+				 * event n, pats[1] must match event n-1, etc.
+				 */
+} PatSeq;
+
+/*
+ * Flag values for PatSeq structures:
+ *
+ * PAT_NEARBY		1 means that all of the events matching
+ *			this sequence must occur with nearby X
+ *			and Y mouse coordinates and close in time.
+ *			This is typically used to restrict multiple
+ *			button presses.
+ * MARKED_DELETED	1 means that this binding has been marked as deleted
+ *			and removed from the binding table, but its memory
+ *			could not be released because it was already queued for
+ *			execution.  When the binding is actually about to be
+ *			executed, this flag will be checked and the binding
+ *			skipped if set.
+ */
+
+#define PAT_NEARBY		0x1
+#define MARKED_DELETED		0x2
+
+/*
+ * Constants that define how close together two events must be
+ * in milliseconds or pixels to meet the PAT_NEARBY constraint:
+ */
+
+#define NEARBY_PIXELS		5
+#define NEARBY_MS		500
+
+
+/*
+ * The following structure keeps track of all the virtual events that are
+ * associated with a particular physical event.  It is pointed to by the
+ * voPtr field in a PatSeq in the patternTable of a  virtual event table.
+ */
+
+typedef struct VirtualOwners {
+    int numOwners;		    /* Number of virtual events to trigger. */
+    Tcl_HashEntry *owners[1];	    /* Array of pointers to entries in
+				     * nameTable.  Enough space will
+				     * actually be allocated for numOwners
+				     * hash entries. */
+} VirtualOwners;
+
+/*
+ * The following structure is used in the nameTable of a virtual event
+ * table to associate a virtual event with all the physical events that can
+ * trigger it.
+ */
+typedef struct PhysicalsOwned {
+    int numOwned;		    /* Number of physical events owned. */
+    PatSeq *patSeqs[1];		    /* Array of pointers to physical event
+				     * patterns.  Enough space will actually
+				     * be allocated to hold numOwned. */
+} PhysicalsOwned;
+
+/*
+ * One of the following structures exists for each interpreter.  This
+ * structure keeps track of the current display and screen in the
+ * interpreter, so that a script can be invoked whenever the display/screen
+ * changes (the script does things like point tkPriv at a display-specific
+ * structure).
+ */
+
+typedef struct {
+    TkDisplay *curDispPtr;	/* Display for last binding command invoked
+				 * in this application. */
+    int curScreenIndex;		/* Index of screen for last binding command. */
+    int bindingDepth;		/* Number of active instances of Tk_BindEvent
+				 * in this application. */
+} ScreenInfo;
+
+/*
+ * The following structure is used to keep track of all the C bindings that
+ * are awaiting invocation and whether the window they refer to has been
+ * destroyed.  If the window is destroyed, then all pending callbacks for
+ * that window will be cancelled.  The Tcl bindings will still all be
+ * invoked, however.  
+ */
+
+typedef struct PendingBinding {
+    struct PendingBinding *nextPtr;
+				/* Next in chain of pending bindings, in
+				 * case a recursive binding evaluation is in
+				 * progress. */
+    Tk_Window tkwin;		/* The window that the following bindings
+				 * depend upon. */
+    int deleted;		/* Set to non-zero by window cleanup code
+				 * if tkwin is deleted. */
+    PatSeq *matchArray[5];	/* Array of pending C bindings.  The actual
+				 * size of this depends on how many C bindings
+				 * matched the event passed to Tk_BindEvent.
+				 * THIS FIELD MUST BE THE LAST IN THE
+				 * STRUCTURE. */
+} PendingBinding;
+
+/*
+ * The following structure keeps track of all the information local to
+ * the binding package on a per interpreter basis.
+ */
+
+typedef struct BindInfo {
+    VirtualEventTable virtualEventTable;
+				/* The virtual events that exist in this
+				 * interpreter. */
+    ScreenInfo screenInfo;	/* Keeps track of the current display and
+				 * screen, so it can be restored after
+				 * a binding has executed. */
+    PendingBinding *pendingList;/* The list of pending C bindings, kept in
+				 * case a C or Tcl binding causes the target
+				 * window to be deleted. */
+} BindInfo;
+    
+/*
+ * In X11R4 and earlier versions, XStringToKeysym is ridiculously
+ * slow.  The data structure and hash table below, along with the
+ * code that uses them, implement a fast mapping from strings to
+ * keysyms.  In X11R5 and later releases XStringToKeysym is plenty
+ * fast so this stuff isn't needed.  The #define REDO_KEYSYM_LOOKUP
+ * is normally undefined, so that XStringToKeysym gets used.  It
+ * can be set in the Makefile to enable the use of the hash table
+ * below.
+ */
+
+#ifdef REDO_KEYSYM_LOOKUP
+typedef struct {
+    char *name;				/* Name of keysym. */
+    KeySym value;			/* Numeric identifier for keysym. */
+} KeySymInfo;
+static KeySymInfo keyArray[] = {
+#ifndef lint
+#include "ks_names.h"
+#endif
+    {(char *) NULL, 0}
+};
+static Tcl_HashTable keySymTable;	/* keyArray hashed by keysym value. */
+static Tcl_HashTable nameTable;		/* keyArray hashed by keysym name. */
+#endif /* REDO_KEYSYM_LOOKUP */
+
+/*
+ * Set to non-zero when the package-wide static variables have been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * A hash table is kept to map from the string names of event
+ * modifiers to information about those modifiers.  The structure
+ * for storing this information, and the hash table built at
+ * initialization time, are defined below.
+ */
+
+typedef struct {
+    char *name;			/* Name of modifier. */
+    int mask;			/* Button/modifier mask value,							 * such as Button1Mask. */
+    int flags;			/* Various flags;  see below for
+				 * definitions. */
+} ModInfo;
+
+/*
+ * Flags for ModInfo structures:
+ *
+ * DOUBLE -		Non-zero means duplicate this event,
+ *			e.g. for double-clicks.
+ * TRIPLE -		Non-zero means triplicate this event,
+ *			e.g. for triple-clicks.
+ */
+
+#define DOUBLE		1
+#define TRIPLE		2
+
+/*
+ * The following special modifier mask bits are defined, to indicate
+ * logical modifiers such as Meta and Alt that may float among the
+ * actual modifier bits.
+ */
+
+#define META_MASK	(AnyModifier<<1)
+#define ALT_MASK	(AnyModifier<<2)
+
+static ModInfo modArray[] = {
+    {"Control",		ControlMask,	0},
+    {"Shift",		ShiftMask,	0},
+    {"Lock",		LockMask,	0},
+    {"Meta",		META_MASK,	0},
+    {"M",		META_MASK,	0},
+    {"Alt",		ALT_MASK,	0},
+    {"B1",		Button1Mask,	0},
+    {"Button1",		Button1Mask,	0},
+    {"B2",		Button2Mask,	0},
+    {"Button2",		Button2Mask,	0},
+    {"B3",		Button3Mask,	0},
+    {"Button3",		Button3Mask,	0},
+    {"B4",		Button4Mask,	0},
+    {"Button4",		Button4Mask,	0},
+    {"B5",		Button5Mask,	0},
+    {"Button5",		Button5Mask,	0},
+    {"Mod1",		Mod1Mask,	0},
+    {"M1",		Mod1Mask,	0},
+    {"Command",		Mod1Mask,	0},
+    {"Mod2",		Mod2Mask,	0},
+    {"M2",		Mod2Mask,	0},
+    {"Option",		Mod2Mask,	0},
+    {"Mod3",		Mod3Mask,	0},
+    {"M3",		Mod3Mask,	0},
+    {"Mod4",		Mod4Mask,	0},
+    {"M4",		Mod4Mask,	0},
+    {"Mod5",		Mod5Mask,	0},
+    {"M5",		Mod5Mask,	0},
+    {"Double",		0,		DOUBLE},
+    {"Triple",		0,		TRIPLE},
+    {"Any",		0,		0},	/* Ignored: historical relic. */
+    {NULL,		0,		0}
+};
+static Tcl_HashTable modTable;
+
+/*
+ * This module also keeps a hash table mapping from event names
+ * to information about those events.  The structure, an array
+ * to use to initialize the hash table, and the hash table are
+ * all defined below.
+ */
+
+typedef struct {
+    char *name;			/* Name of event. */
+    int type;			/* Event type for X, such as
+				 * ButtonPress. */
+    int eventMask;		/* Mask bits (for XSelectInput)
+				 * for this event type. */
+} EventInfo;
+
+/*
+ * Note:  some of the masks below are an OR-ed combination of
+ * several masks.  This is necessary because X doesn't report
+ * up events unless you also ask for down events.  Also, X
+ * doesn't report button state in motion events unless you've
+ * asked about button events.
+ */
+
+static EventInfo eventArray[] = {
+    {"Key",		KeyPress,		KeyPressMask},
+    {"KeyPress",	KeyPress,		KeyPressMask},
+    {"KeyRelease",	KeyRelease,		KeyPressMask|KeyReleaseMask},
+    {"Button",		ButtonPress,		ButtonPressMask},
+    {"ButtonPress",	ButtonPress,		ButtonPressMask},
+    {"ButtonRelease",	ButtonRelease,
+	    ButtonPressMask|ButtonReleaseMask},
+    {"Motion",		MotionNotify,
+	    ButtonPressMask|PointerMotionMask},
+    {"Enter",		EnterNotify,		EnterWindowMask},
+    {"Leave",		LeaveNotify,		LeaveWindowMask},
+    {"FocusIn",		FocusIn,		FocusChangeMask},
+    {"FocusOut",	FocusOut,		FocusChangeMask},
+    {"Expose",		Expose,			ExposureMask},
+    {"Visibility",	VisibilityNotify,	VisibilityChangeMask},
+    {"Destroy",		DestroyNotify,		StructureNotifyMask},
+    {"Unmap",		UnmapNotify,		StructureNotifyMask},
+    {"Map",		MapNotify,		StructureNotifyMask},
+    {"Reparent",	ReparentNotify,		StructureNotifyMask},
+    {"Configure",	ConfigureNotify,	StructureNotifyMask},
+    {"Gravity",		GravityNotify,		StructureNotifyMask},
+    {"Circulate",	CirculateNotify,	StructureNotifyMask},
+    {"Property",	PropertyNotify,		PropertyChangeMask},
+    {"Colormap",	ColormapNotify,		ColormapChangeMask},
+    {"Activate",	ActivateNotify,		ActivateMask},
+    {"Deactivate",	DeactivateNotify,	ActivateMask},
+    {(char *) NULL,	0,			0}
+};
+static Tcl_HashTable eventTable;
+
+/*
+ * The defines and table below are used to classify events into
+ * various groups.  The reason for this is that logically identical
+ * fields (e.g. "state") appear at different places in different
+ * types of events.  The classification masks can be used to figure
+ * out quickly where to extract information from events.
+ */
+
+#define KEY			0x1
+#define BUTTON			0x2
+#define MOTION			0x4
+#define CROSSING		0x8
+#define FOCUS			0x10
+#define EXPOSE			0x20
+#define VISIBILITY		0x40
+#define CREATE			0x80
+#define DESTROY			0x100
+#define UNMAP			0x200
+#define MAP			0x400
+#define REPARENT		0x800
+#define CONFIG			0x1000
+#define GRAVITY			0x2000
+#define CIRC			0x4000
+#define PROP			0x8000
+#define COLORMAP		0x10000
+#define VIRTUAL			0x20000
+#define ACTIVATE		0x40000
+
+#define KEY_BUTTON_MOTION_VIRTUAL	(KEY|BUTTON|MOTION|VIRTUAL)
+
+static int flagArray[TK_LASTEVENT] = {
+   /* Not used */		0,
+   /* Not used */		0,
+   /* KeyPress */		KEY,
+   /* KeyRelease */		KEY,
+   /* ButtonPress */		BUTTON,
+   /* ButtonRelease */		BUTTON,
+   /* MotionNotify */		MOTION,
+   /* EnterNotify */		CROSSING,
+   /* LeaveNotify */		CROSSING,
+   /* FocusIn */		FOCUS,
+   /* FocusOut */		FOCUS,
+   /* KeymapNotify */		0,
+   /* Expose */			EXPOSE,
+   /* GraphicsExpose */		EXPOSE,
+   /* NoExpose */		0,
+   /* VisibilityNotify */	VISIBILITY,
+   /* CreateNotify */		CREATE,
+   /* DestroyNotify */		DESTROY,
+   /* UnmapNotify */		UNMAP,
+   /* MapNotify */		MAP,
+   /* MapRequest */		0,
+   /* ReparentNotify */		REPARENT,
+   /* ConfigureNotify */	CONFIG,
+   /* ConfigureRequest */	0,
+   /* GravityNotify */		GRAVITY,
+   /* ResizeRequest */		0,
+   /* CirculateNotify */	CIRC,
+   /* CirculateRequest */	0,
+   /* PropertyNotify */		PROP,
+   /* SelectionClear */		0,
+   /* SelectionRequest */	0,
+   /* SelectionNotify */	0,
+   /* ColormapNotify */		COLORMAP,
+   /* ClientMessage */		0,
+   /* MappingNotify */		0,
+   /* VirtualEvent */		VIRTUAL,
+   /* Activate */		ACTIVATE,	    
+   /* Deactivate */		ACTIVATE
+};
+
+/*
+ * The following tables are used as a two-way map between X's internal
+ * numeric values for fields in an XEvent and the strings used in Tcl.  The
+ * tables are used both when constructing an XEvent from user input and
+ * when providing data from an XEvent to the user.
+ */
+
+static TkStateMap notifyMode[] = {
+    {NotifyNormal,		"NotifyNormal"},
+    {NotifyGrab,		"NotifyGrab"},
+    {NotifyUngrab,		"NotifyUngrab"},
+    {NotifyWhileGrabbed,	"NotifyWhileGrabbed"},
+    {-1, NULL}
+};
+
+static TkStateMap notifyDetail[] = {
+    {NotifyAncestor,		"NotifyAncestor"},
+    {NotifyVirtual,		"NotifyVirtual"},
+    {NotifyInferior,		"NotifyInferior"},
+    {NotifyNonlinear,		"NotifyNonlinear"},
+    {NotifyNonlinearVirtual,	"NotifyNonlinearVirtual"},
+    {NotifyPointer,		"NotifyPointer"},
+    {NotifyPointerRoot,		"NotifyPointerRoot"},
+    {NotifyDetailNone,		"NotifyDetailNone"},
+    {-1, NULL}
+};
+
+static TkStateMap circPlace[] = {
+    {PlaceOnTop,		"PlaceOnTop"},
+    {PlaceOnBottom,		"PlaceOnBottom"},
+    {-1, NULL}
+};
+
+static TkStateMap visNotify[] = {
+    {VisibilityUnobscured,	    "VisibilityUnobscured"},
+    {VisibilityPartiallyObscured,   "VisibilityPartiallyObscured"},
+    {VisibilityFullyObscured,	    "VisibilityFullyObscured"},
+    {-1, NULL}
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static void		ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *dispName, int screenIndex));
+static int		CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+			    VirtualEventTable *vetPtr, char *virtString,
+			    char *eventString));
+static int		DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+			    VirtualEventTable *vetPtr, char *virtString,
+			    char *eventString));
+static void		DeleteVirtualEventTable _ANSI_ARGS_((
+			    VirtualEventTable *vetPtr));
+static void		ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
+			    char *before, XEvent *eventPtr, KeySym keySym,
+			    Tcl_DString *dsPtr));
+static void		FreeTclBinding _ANSI_ARGS_((ClientData clientData));
+static PatSeq *		FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_HashTable *patternTablePtr, ClientData object,
+			    char *eventString, int create, int allowVirtual,
+			    unsigned long *maskPtr));
+static void		GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
+			    VirtualEventTable *vetPtr));
+static char *		GetField _ANSI_ARGS_((char *p, char *copy, int size));
+static KeySym		GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
+			    XEvent *eventPtr));
+static void		GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
+			    Tcl_DString *dsPtr));
+static int		GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+			    VirtualEventTable *vetPtr, char *virtString));
+static Tk_Uid		GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
+			    char *virtString));
+static int		HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window main, int argc, char **argv));
+static void		InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
+static void		InitVirtualEventTable _ANSI_ARGS_((
+			    VirtualEventTable *vetPtr));
+static PatSeq *		MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
+			    BindingTable *bindPtr, PatSeq *psPtr,
+			    PatSeq *bestPtr, ClientData *objectPtr,
+			    PatSeq **sourcePtrPtr));
+static int		ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
+			    char **eventStringPtr, Pattern *patPtr,
+			    unsigned long *eventMaskPtr));
+
+/*
+ * The following define is used as a short circuit for the callback
+ * procedure to evaluate a TclBinding.  The actual evaluation of the
+ * binding is handled inline, because special things have to be done
+ * with a Tcl binding before evaluation time.
+ */
+
+#define EvalTclBinding	((TkBindEvalProc *) 1)
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindInit --
+ *
+ *	This procedure is called when an application is created.  It
+ *	initializes all the structures used by bindings and virtual
+ *	events.  It must be called before any other functions in this
+ *	file are called.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindInit(mainPtr)
+    TkMainInfo *mainPtr;	/* The newly created application. */
+{
+    BindInfo *bindInfoPtr;
+
+    if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
+	panic("TkBindInit: virtual events can't be supported");
+    }
+
+    /*
+     * Initialize the static data structures used by the binding package.
+     * They are only initialized once, no matter how many interps are
+     * created.
+     */
+
+    if (!initialized) {
+	Tcl_HashEntry *hPtr;
+	ModInfo *modPtr;
+	EventInfo *eiPtr;
+	int dummy;
+
+#ifdef REDO_KEYSYM_LOOKUP
+	KeySymInfo *kPtr;
+
+	Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
+	Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
+	for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
+	    hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
+	    Tcl_SetHashValue(hPtr, kPtr->value);
+	    hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
+		    &dummy);
+	    Tcl_SetHashValue(hPtr, kPtr->name);
+	}
+#endif /* REDO_KEYSYM_LOOKUP */
+
+	Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
+	for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
+	    hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
+	    Tcl_SetHashValue(hPtr, modPtr);
+	}
+    
+	Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
+	for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+	    hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
+	    Tcl_SetHashValue(hPtr, eiPtr);
+	}
+	initialized = 1;
+    }
+
+    mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
+
+    bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
+    InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
+    bindInfoPtr->screenInfo.curDispPtr = NULL;
+    bindInfoPtr->screenInfo.curScreenIndex = -1;
+    bindInfoPtr->screenInfo.bindingDepth = 0;
+    bindInfoPtr->pendingList = NULL;
+    mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
+
+    TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindFree --
+ *
+ *	This procedure is called when an application is deleted.  It
+ *	deletes all the structures used by bindings and virtual events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindFree(mainPtr)
+    TkMainInfo *mainPtr;	/* The newly created application. */
+{
+    BindInfo *bindInfoPtr;
+    
+    Tk_DeleteBindingTable(mainPtr->bindingTable);
+    mainPtr->bindingTable = NULL;
+
+    bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
+    DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+    mainPtr->bindInfo = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBindingTable --
+ *
+ *	Set up a new domain in which event bindings may be created.
+ *
+ * Results:
+ *	The return value is a token for the new table, which must
+ *	be passed to procedures like Tk_CreatBinding.
+ *
+ * Side effects:
+ *	Memory is allocated for the new table.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_BindingTable
+Tk_CreateBindingTable(interp)
+    Tcl_Interp *interp;		/* Interpreter to associate with the binding
+				 * table:  commands are executed in this
+				 * interpreter. */
+{
+    BindingTable *bindPtr;
+    int i;
+
+    /*
+     * Create and initialize a new binding table.
+     */
+
+    bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
+    for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
+	bindPtr->eventRing[i].type = -1;
+    }
+    bindPtr->curEvent = 0;
+    Tcl_InitHashTable(&bindPtr->patternTable,
+	    sizeof(PatternTableKey)/sizeof(int));
+    Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
+    bindPtr->interp = interp;
+    return (Tk_BindingTable) bindPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBindingTable --
+ *
+ *	Destroy a binding table and free up all its memory.
+ *	The caller should not use bindingTable again after
+ *	this procedure returns.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteBindingTable(bindingTable)
+    Tk_BindingTable bindingTable;	/* Token for the binding table to
+					 * destroy. */
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr, *nextPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+
+    /*
+     * Find and delete all of the patterns associated with the binding
+     * table.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+		psPtr != NULL; psPtr = nextPtr) {
+	    nextPtr = psPtr->nextSeqPtr;
+	    psPtr->flags |= MARKED_DELETED;
+	    if (psPtr->refCount == 0) {
+		if (psPtr->freeProc != NULL) {
+		    (*psPtr->freeProc)(psPtr->clientData);
+		}
+		ckfree((char *) psPtr);
+	    }
+	}
+    }
+
+    /*
+     * Clean up the rest of the information associated with the
+     * binding table.
+     */
+
+    Tcl_DeleteHashTable(&bindPtr->patternTable);
+    Tcl_DeleteHashTable(&bindPtr->objectTable);
+    ckfree((char *) bindPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBinding --
+ *
+ *	Add a binding to a binding table, so that future calls to
+ *	Tk_BindEvent may execute the command in the binding.
+ *
+ * Results:
+ *	The return value is 0 if an error occurred while setting
+ *	up the binding.  In this case, an error message will be
+ *	left in interp->result.  If all went well then the return
+ *	value is a mask of the event types that must be made
+ *	available to Tk_BindEvent in order to properly detect when
+ *	this binding triggers.  This value can be used to determine
+ *	what events to select for in a window, for example.
+ *
+ * Side effects:
+ *	An existing binding on the same event sequence may be
+ *	replaced.  
+ *	The new binding may cause future calls to Tk_BindEvent to
+ *	behave differently than they did previously.
+ *
+ *--------------------------------------------------------------
+ */
+
+unsigned long
+Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    Tk_BindingTable bindingTable;
+				/* Table in which to create binding. */
+    ClientData object;		/* Token for object with which binding is
+				 * associated. */
+    char *eventString;		/* String describing event sequence that
+				 * triggers binding. */
+    char *command;		/* Contains Tcl command to execute when
+				 * binding triggers. */
+    int append;			/* 0 means replace any existing binding for
+				 * eventString; 1 means append to that
+				 * binding.  If the existing binding is for a
+				 * callback function and not a Tcl command
+				 * string, the existing binding will always be
+				 * replaced. */
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr;
+    unsigned long eventMask;
+    char *new, *old;
+
+    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+	    1, 1, &eventMask);
+    if (psPtr == NULL) {
+	return 0;
+    }
+    if (psPtr->eventProc == NULL) {
+	int new;
+	Tcl_HashEntry *hPtr;
+	
+	/*
+	 * This pattern sequence was just created.
+	 * Link the pattern into the list associated with the object, so
+	 * that if the object goes away, these bindings will all
+	 * automatically be deleted.
+	 */
+
+	hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+		&new);
+	if (new) {
+	    psPtr->nextObjPtr = NULL;
+	} else {
+	    psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+	}
+	Tcl_SetHashValue(hPtr, psPtr);
+    } else if (psPtr->eventProc != EvalTclBinding) {
+	/*
+	 * Free existing procedural binding.
+	 */
+
+	if (psPtr->freeProc != NULL) {
+	    (*psPtr->freeProc)(psPtr->clientData);
+	}
+	psPtr->clientData = NULL;
+	append = 0;
+    }
+
+    old = (char *) psPtr->clientData;
+    if ((append != 0) && (old != NULL)) {
+	int length;
+
+	length = strlen(old) + strlen(command) + 2;
+	new = (char *) ckalloc((unsigned) length);
+	sprintf(new, "%s\n%s", old, command);
+    } else {
+	new = (char *) ckalloc((unsigned) strlen(command) + 1);
+	strcpy(new, command);
+    }
+    if (old != NULL) {
+	ckfree(old);
+    }
+    psPtr->eventProc = EvalTclBinding;
+    psPtr->freeProc = FreeTclBinding;
+    psPtr->clientData = (ClientData) new;
+    return eventMask;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkCreateBindingProcedure --
+ *
+ *	Add a C binding to a binding table, so that future calls to
+ *	Tk_BindEvent may callback the procedure in the binding.
+ *
+ * Results:
+ *	The return value is 0 if an error occurred while setting
+ *	up the binding.  In this case, an error message will be
+ *	left in interp->result.  If all went well then the return
+ *	value is a mask of the event types that must be made
+ *	available to Tk_BindEvent in order to properly detect when
+ *	this binding triggers.  This value can be used to determine
+ *	what events to select for in a window, for example.
+ *
+ * Side effects:
+ *	Any existing binding on the same event sequence will be
+ *	replaced.  
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned long
+TkCreateBindingProcedure(interp, bindingTable, object, eventString,
+	eventProc, freeProc, clientData)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    Tk_BindingTable bindingTable;
+				/* Table in which to create binding. */
+    ClientData object;		/* Token for object with which binding is
+				 * associated. */
+    char *eventString;		/* String describing event sequence that
+				 * triggers binding. */
+    TkBindEvalProc *eventProc;	/* Procedure to invoke when binding
+				 * triggers.  Must not be NULL. */
+    TkBindFreeProc *freeProc;	/* Procedure to invoke when binding is
+				 * freed.  May be NULL for no procedure. */
+    ClientData clientData;	/* Arbitrary ClientData to pass to eventProc
+				 * and freeProc. */
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr;
+    unsigned long eventMask;
+
+    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+	    1, 1, &eventMask);
+    if (psPtr == NULL) {
+	return 0;
+    }
+    if (psPtr->eventProc == NULL) {
+	int new;
+	Tcl_HashEntry *hPtr;
+	
+	/*
+	 * This pattern sequence was just created.
+	 * Link the pattern into the list associated with the object, so
+	 * that if the object goes away, these bindings will all
+	 * automatically be deleted.
+	 */
+
+	hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+		&new);
+	if (new) {
+	    psPtr->nextObjPtr = NULL;
+	} else {
+	    psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+	}
+	Tcl_SetHashValue(hPtr, psPtr);
+    } else {
+
+	/*
+	 * Free existing callback.
+	 */
+
+	if (psPtr->freeProc != NULL) {
+	    (*psPtr->freeProc)(psPtr->clientData);
+	}
+    }
+
+    psPtr->eventProc = eventProc;
+    psPtr->freeProc = freeProc;
+    psPtr->clientData = clientData;
+    return eventMask;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBinding --
+ *
+ *	Remove an event binding from a binding table.
+ *
+ * Results:
+ *	The result is a standard Tcl return value.  If an error
+ *	occurs then interp->result will contain an error message.
+ *
+ * Side effects:
+ *	The binding given by object and eventString is removed
+ *	from bindingTable.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_DeleteBinding(interp, bindingTable, object, eventString)
+    Tcl_Interp *interp;			/* Used for error reporting. */
+    Tk_BindingTable bindingTable;	/* Table in which to delete binding. */
+    ClientData object;			/* Token for object with which binding
+					 * is associated. */
+    char *eventString;			/* String describing event sequence
+					 * that triggers binding. */
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr, *prevPtr;
+    unsigned long eventMask;
+    Tcl_HashEntry *hPtr;
+
+    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+	    0, 1, &eventMask);
+    if (psPtr == NULL) {
+	Tcl_ResetResult(interp);
+	return TCL_OK;
+    }
+
+    /*
+     * Unlink the binding from the list for its object, then from the
+     * list for its pattern.
+     */
+
+    hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+    if (hPtr == NULL) {
+	panic("Tk_DeleteBinding couldn't find object table entry");
+    }
+    prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+    if (prevPtr == psPtr) {
+	Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
+    } else {
+	for ( ; ; prevPtr = prevPtr->nextObjPtr) {
+	    if (prevPtr == NULL) {
+		panic("Tk_DeleteBinding couldn't find on object list");
+	    }
+	    if (prevPtr->nextObjPtr == psPtr) {
+		prevPtr->nextObjPtr = psPtr->nextObjPtr;
+		break;
+	    }
+	}
+    }
+    prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+    if (prevPtr == psPtr) {
+	if (psPtr->nextSeqPtr == NULL) {
+	    Tcl_DeleteHashEntry(psPtr->hPtr);
+	} else {
+	    Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+	}
+    } else {
+	for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+	    if (prevPtr == NULL) {
+		panic("Tk_DeleteBinding couldn't find on hash chain");
+	    }
+	    if (prevPtr->nextSeqPtr == psPtr) {
+		prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+		break;
+	    }
+	}
+    }
+
+    psPtr->flags |= MARKED_DELETED;
+    if (psPtr->refCount == 0) {
+	if (psPtr->freeProc != NULL) {
+	    (*psPtr->freeProc)(psPtr->clientData);
+	}
+	ckfree((char *) psPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetBinding --
+ *
+ *	Return the command associated with a given event string.
+ *
+ * Results:
+ *	The return value is a pointer to the command string
+ *	associated with eventString for object in the domain
+ *	given by bindingTable.  If there is no binding for
+ *	eventString, or if eventString is improperly formed,
+ *	then NULL is returned and an error message is left in
+ *	interp->result.  The return value is semi-static:  it
+ *	will persist until the binding is changed or deleted.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_GetBinding(interp, bindingTable, object, eventString)
+    Tcl_Interp *interp;			/* Interpreter for error reporting. */
+    Tk_BindingTable bindingTable;	/* Table in which to look for
+					 * binding. */
+    ClientData object;			/* Token for object with which binding
+					 * is associated. */
+    char *eventString;			/* String describing event sequence
+					 * that triggers binding. */
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr;
+    unsigned long eventMask;
+
+    psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+	    0, 1, &eventMask);
+    if (psPtr == NULL) {
+	return NULL;
+    }
+    if (psPtr->eventProc == EvalTclBinding) {
+	return (char *) psPtr->clientData;
+    }
+    return "";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAllBindings --
+ *
+ *	Return a list of event strings for all the bindings
+ *	associated with a given object.
+ *
+ * Results:
+ *	There is no return value.  Interp->result is modified to
+ *	hold a Tcl list with one entry for each binding associated
+ *	with object in bindingTable.  Each entry in the list
+ *	contains the event string associated with one binding.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GetAllBindings(interp, bindingTable, object)
+    Tcl_Interp *interp;			/* Interpreter returning result or
+					 * error. */
+    Tk_BindingTable bindingTable;	/* Table in which to look for
+					 * bindings. */
+    ClientData object;			/* Token for object. */
+
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_DString ds;
+
+    hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+    if (hPtr == NULL) {
+	return;
+    }
+    Tcl_DStringInit(&ds);
+    for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+	    psPtr = psPtr->nextObjPtr) {
+	/* 
+	 * For each binding, output information about each of the
+	 * patterns in its sequence.
+	 */
+	 
+	Tcl_DStringSetLength(&ds, 0);
+	GetPatternString(psPtr, &ds);
+	Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+    }
+    Tcl_DStringFree(&ds);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteAllBindings --
+ *
+ *	Remove all bindings associated with a given object in a
+ *	given binding table.
+ *
+ * Results:
+ *	All bindings associated with object are removed from
+ *	bindingTable.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteAllBindings(bindingTable, object)
+    Tk_BindingTable bindingTable;	/* Table in which to delete
+					 * bindings. */
+    ClientData object;			/* Token for object. */
+{
+    BindingTable *bindPtr = (BindingTable *) bindingTable;
+    PatSeq *psPtr, *prevPtr;
+    PatSeq *nextPtr;
+    Tcl_HashEntry *hPtr;
+
+    hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+    if (hPtr == NULL) {
+	return;
+    }
+    for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+	    psPtr = nextPtr) {
+	nextPtr  = psPtr->nextObjPtr;
+
+	/*
+	 * Be sure to remove each binding from its hash chain in the
+	 * pattern table.  If this is the last pattern in the chain,
+	 * then delete the hash entry too.
+	 */
+
+	prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+	if (prevPtr == psPtr) {
+	    if (psPtr->nextSeqPtr == NULL) {
+		Tcl_DeleteHashEntry(psPtr->hPtr);
+	    } else {
+		Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+	    }
+	} else {
+	    for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+		if (prevPtr == NULL) {
+		    panic("Tk_DeleteAllBindings couldn't find on hash chain");
+		}
+		if (prevPtr->nextSeqPtr == psPtr) {
+		    prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+		    break;
+		}
+	    }
+	}
+	psPtr->flags |= MARKED_DELETED;
+
+	if (psPtr->refCount == 0) {
+	    if (psPtr->freeProc != NULL) {
+		(*psPtr->freeProc)(psPtr->clientData);
+	    }
+	    ckfree((char *) psPtr);
+	}
+    }
+    Tcl_DeleteHashEntry(hPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_BindEvent --
+ *
+ *	This procedure is invoked to process an X event.  The
+ *	event is added to those recorded for the binding table.
+ *	Then each of the objects at *objectPtr is checked in
+ *	order to see if it has a binding that matches the recent
+ *	events.  If so, the most specific binding is invoked for
+ *	each object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on the command associated with the matching binding.
+ *
+ *	All Tcl bindings scripts for each object are accumulated before
+ *	the first binding is evaluated.  If the action of a Tcl binding
+ *	is to change or delete a binding, or delete the window associated
+ *	with the binding, all the original Tcl binding scripts will still
+ *	fire.  Contrast this with C binding procedures.  If a pending C
+ *	binding (one that hasn't fired yet, but is queued to be fired for
+ *	this window) is deleted, it will not be called, and if it is
+ *	changed, then the new binding procedure will be called.  If the
+ *	window itself is deleted, no further C binding procedures will be
+ *	called for this window.  When both Tcl binding scripts and C binding
+ *	procedures are interleaved, the above rules still apply. 
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
+    Tk_BindingTable bindingTable;	/* Table in which to look for
+					 * bindings. */
+    XEvent *eventPtr;			/* What actually happened. */
+    Tk_Window tkwin;			/* Window on display where event
+					 * occurred (needed in order to
+					 * locate display information). */
+    int numObjects;			/* Number of objects at *objectPtr. */
+    ClientData *objectPtr;		/* Array of one or more objects
+					 * to check for a matching binding. */
+{
+    BindingTable *bindPtr;
+    TkDisplay *dispPtr;
+    BindInfo *bindInfoPtr;
+    TkDisplay *oldDispPtr;
+    ScreenInfo *screenPtr;
+    XEvent *ringPtr;
+    PatSeq *vMatchDetailList, *vMatchNoDetailList;
+    int flags, oldScreen, i, deferModal;
+    unsigned int matchCount, matchSpace;
+    Tcl_Interp *interp;
+    Tcl_DString scripts, savedResult;
+    Detail detail;
+    char *p, *end;
+    PendingBinding *pendingPtr;
+    PendingBinding staticPending;
+    TkWindow *winPtr = (TkWindow *)tkwin;
+    PatternTableKey key;
+
+    /*
+     * Ignore events on windows that don't have names: these are windows
+     * like wrapper windows that shouldn't be visible to the
+     * application.
+     */
+
+    if (winPtr->pathName == NULL) {
+	return;
+    }
+
+    /*
+     * Ignore the event completely if it is an Enter, Leave, FocusIn,
+     * or FocusOut event with detail NotifyInferior.  The reason for
+     * ignoring these events is that we don't want transitions between
+     * a window and its children to visible to bindings on the parent:
+     * this would cause problems for mega-widgets, since the internal
+     * structure of a mega-widget isn't supposed to be visible to
+     * people watching the parent.
+     */
+
+    if ((eventPtr->type == EnterNotify)  || (eventPtr->type == LeaveNotify)) {
+	if (eventPtr->xcrossing.detail == NotifyInferior) {
+	    return;
+	}
+    }
+    if ((eventPtr->type == FocusIn)  || (eventPtr->type == FocusOut)) {
+	if (eventPtr->xfocus.detail == NotifyInferior) {
+	    return;
+	}
+    }
+
+    bindPtr = (BindingTable *) bindingTable;
+    dispPtr = ((TkWindow *) tkwin)->dispPtr;
+    bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+
+    /*
+     * Add the new event to the ring of saved events for the
+     * binding table.  Two tricky points:
+     *
+     * 1. Combine consecutive MotionNotify events.  Do this by putting
+     *    the new event *on top* of the previous event.
+     * 2. If a modifier key is held down, it auto-repeats to generate
+     *    continuous KeyPress and KeyRelease events.  These can flush
+     *    the event ring so that valuable information is lost (such
+     *    as repeated button clicks).  To handle this, check for the
+     *    special case of a modifier KeyPress arriving when the previous
+     *    two events are a KeyRelease and KeyPress of the same key.
+     *    If this happens, mark the most recent event (the KeyRelease)
+     *    invalid and put the new event on top of the event before that
+     *    (the KeyPress).
+     */
+
+    if ((eventPtr->type == MotionNotify)
+	    && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
+	/*
+	 * Don't advance the ring pointer.
+	 */
+    } else if (eventPtr->type == KeyPress) {
+	int i;
+	for (i = 0; ; i++) {
+	    if (i >= dispPtr->numModKeyCodes) {
+		goto advanceRingPointer;
+	    }
+	    if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+		break;
+	    }
+	}
+	ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+	if ((ringPtr->type != KeyRelease)
+		|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+	    goto advanceRingPointer;
+	}
+	if (bindPtr->curEvent <= 0) {
+	    i = EVENT_BUFFER_SIZE - 1;
+	} else {
+	    i = bindPtr->curEvent - 1;
+	}
+	ringPtr = &bindPtr->eventRing[i];
+	if ((ringPtr->type != KeyPress)
+		|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+	    goto advanceRingPointer;
+	}
+	bindPtr->eventRing[bindPtr->curEvent].type = -1;
+	bindPtr->curEvent = i;
+    } else {
+	advanceRingPointer:
+	bindPtr->curEvent++;
+	if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
+	    bindPtr->curEvent = 0;
+	}
+    }
+    ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+    memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
+    detail.clientData = 0;
+    flags = flagArray[ringPtr->type];
+    if (flags & KEY) {
+	detail.keySym = GetKeySym(dispPtr, ringPtr);
+	if (detail.keySym == NoSymbol) {
+	    detail.keySym = 0;
+	}
+    } else if (flags & BUTTON) {
+	detail.button = ringPtr->xbutton.button;
+    } else if (flags & VIRTUAL) {
+	detail.name = ((XVirtualEvent *) ringPtr)->name;
+    }
+    bindPtr->detailRing[bindPtr->curEvent] = detail;
+
+    /*
+     * Find out if there are any virtual events that correspond to this
+     * physical event (or sequence of physical events).
+     */
+
+    vMatchDetailList = NULL;
+    vMatchNoDetailList = NULL;
+    memset(&key, 0, sizeof(key));
+
+    if (ringPtr->type != VirtualEvent) {
+	Tcl_HashTable *veptPtr;
+	Tcl_HashEntry *hPtr;
+
+	veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
+
+        key.object  = NULL;
+	key.type    = ringPtr->type;
+	key.detail  = detail;
+
+	hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+	if (hPtr != NULL) {
+	    vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+	}
+
+	if (key.detail.clientData != 0) {
+	    key.detail.clientData = 0;
+	    hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+	    if (hPtr != NULL) {
+	        vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+	    }
+	}
+    }
+
+    /*
+     * Loop over all the binding tags, finding the binding script or
+     * callback for each one.  Append all of the binding scripts, with
+     * %-sequences expanded, to "scripts", with null characters separating
+     * the scripts for each object.  Append all the callbacks to the array
+     * of pending callbacks.  
+     */
+	       
+    pendingPtr = &staticPending;
+    matchCount = 0;
+    matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
+    Tcl_DStringInit(&scripts);
+
+    for ( ; numObjects > 0; numObjects--, objectPtr++) {
+	PatSeq *matchPtr, *sourcePtr;
+	Tcl_HashEntry *hPtr;
+
+	matchPtr = NULL;
+	sourcePtr = NULL;
+
+	/*
+	 * Match the new event against those recorded in the pattern table,
+	 * saving the longest matching pattern.  For events with details
+	 * (button and key events), look for a binding for the specific
+	 * key or button.  First see if the event matches a physical event
+	 * that the object is interested in, then look for a virtual event.
+	 */
+
+	key.object = *objectPtr;
+	key.type = ringPtr->type;
+	key.detail = detail;
+	hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+	if (hPtr != NULL) {
+	    matchPtr = MatchPatterns(dispPtr, bindPtr, 
+		    (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+		    &sourcePtr);
+	}
+
+	if (vMatchDetailList != NULL) {
+	    matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
+		    matchPtr, objectPtr, &sourcePtr);
+	}
+
+	/*
+	 * If no match was found, look for a binding for all keys or buttons
+	 * (detail of 0).  Again, first match on a virtual event.
+	 */
+
+	if ((detail.clientData != 0) && (matchPtr == NULL)) {
+	    key.detail.clientData = 0;
+	    hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+	    if (hPtr != NULL) {
+		matchPtr = MatchPatterns(dispPtr, bindPtr,
+			(PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+			&sourcePtr);
+	    }
+
+	    if (vMatchNoDetailList != NULL) {
+	        matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
+			matchPtr, objectPtr, &sourcePtr);
+	    }
+
+	}
+    
+	if (matchPtr != NULL) {
+	    if (sourcePtr->eventProc == NULL) {
+		panic("Tk_BindEvent: missing command");
+	    }
+	    if (sourcePtr->eventProc == EvalTclBinding) {
+		ExpandPercents(winPtr, (char *) sourcePtr->clientData,
+			eventPtr, detail.keySym, &scripts);
+	    } else {
+		if (matchCount >= matchSpace) {
+		    PendingBinding *new;
+		    unsigned int oldSize, newSize;
+		    
+		    oldSize = sizeof(staticPending)
+			- sizeof(staticPending.matchArray)
+			+ matchSpace * sizeof(PatSeq*);
+		    matchSpace *= 2;
+		    newSize = sizeof(staticPending)
+			- sizeof(staticPending.matchArray)
+			+ matchSpace * sizeof(PatSeq*);
+		    new = (PendingBinding *) ckalloc(newSize);
+		    memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
+		    if (pendingPtr != &staticPending) {
+			ckfree((char *) pendingPtr);
+		    }
+		    pendingPtr = new;
+		}
+		sourcePtr->refCount++;
+		pendingPtr->matchArray[matchCount] = sourcePtr;
+		matchCount++;
+	    }
+	    /*
+	     * A "" is added to the scripts string to separate the
+	     * various scripts that should be invoked.
+	     */
+
+	    Tcl_DStringAppend(&scripts, "", 1);
+	}
+    }
+    if (Tcl_DStringLength(&scripts) == 0) {
+	return;
+    }
+
+    /*
+     * Now go back through and evaluate the binding for each object,
+     * in order, dealing with "break" and "continue" exceptions
+     * appropriately.
+     *
+     * There are two tricks here:
+     * 1. Bindings can be invoked from in the middle of Tcl commands,
+     *    where interp->result is significant (for example, a widget
+     *    might be deleted because of an error in creating it, so the
+     *    result contains an error message that is eventually going to
+     *    be returned by the creating command).  To preserve the result,
+     *    we save it in a dynamic string.
+     * 2. The binding's action can potentially delete the binding,
+     *    so bindPtr may not point to anything valid once the action
+     *    completes.  Thus we have to save bindPtr->interp in a
+     *    local variable in order to restore the result.
+     */
+
+    interp = bindPtr->interp;
+    Tcl_DStringInit(&savedResult);
+
+    /*
+     * Save information about the current screen, then invoke a script
+     * if the screen has changed.
+     */
+
+    Tcl_DStringGetResult(interp, &savedResult);
+    screenPtr = &bindInfoPtr->screenInfo;
+    oldDispPtr = screenPtr->curDispPtr;
+    oldScreen = screenPtr->curScreenIndex;
+    if ((dispPtr != screenPtr->curDispPtr)
+	    || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
+	screenPtr->curDispPtr = dispPtr;
+	screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
+	ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
+    }
+
+    if (matchCount > 0) {
+	pendingPtr->nextPtr = bindInfoPtr->pendingList;
+	pendingPtr->tkwin = tkwin;
+	pendingPtr->deleted = 0;
+	bindInfoPtr->pendingList = pendingPtr;
+    }
+    
+    /*
+     * Save the current value of the TK_DEFER_MODAL flag so we can
+     * restore it at the end of the loop.  Clear the flag so we can
+     * detect any recursive requests for a modal loop.
+     */
+
+    flags = winPtr->flags;
+    winPtr->flags &= ~TK_DEFER_MODAL;
+
+    p = Tcl_DStringValue(&scripts);
+    end = p + Tcl_DStringLength(&scripts);
+    i = 0;
+
+    while (p < end) {
+	int code;
+	
+	screenPtr->bindingDepth++;
+	Tcl_AllowExceptions(interp);
+
+	if (*p == '\0') {
+	    PatSeq *psPtr;
+	    
+	    psPtr = pendingPtr->matchArray[i];
+	    i++;
+	    code = TCL_OK;
+	    if ((pendingPtr->deleted == 0)
+		    && ((psPtr->flags & MARKED_DELETED) == 0)) {
+		code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
+			tkwin, detail.keySym);
+	    }
+	    psPtr->refCount--;
+	    if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
+		if (psPtr->freeProc != NULL) {
+		    (*psPtr->freeProc)(psPtr->clientData);
+		}
+		ckfree((char *) psPtr);
+	    }
+	} else {
+	    code = Tcl_GlobalEval(interp, p);
+	    p += strlen(p);
+	}
+	p++;
+	screenPtr->bindingDepth--;
+	if (code != TCL_OK) {
+	    if (code == TCL_CONTINUE) {
+		/*
+		 * Do nothing:  just go on to the next command.
+		 */
+	    } else if (code == TCL_BREAK) {
+		break;
+	    } else {
+		Tcl_AddErrorInfo(interp, "\n    (command bound to event)");
+		Tcl_BackgroundError(interp);
+		break;
+	    }
+	}
+    }
+
+    if (matchCount > 0 && !pendingPtr->deleted) {
+	/*
+	 * Restore the original modal flag value and invoke the modal loop
+	 * if needed.
+	 */
+
+	deferModal = winPtr->flags & TK_DEFER_MODAL;
+	winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL) 
+	    | (flags & TK_DEFER_MODAL);
+	if (deferModal) {
+	    (*winPtr->classProcsPtr->modalProc)(tkwin, eventPtr);
+	}
+    }
+
+    if ((screenPtr->bindingDepth != 0) &&
+            ((oldDispPtr != screenPtr->curDispPtr)
+                    || (oldScreen != screenPtr->curScreenIndex))) {
+
+	/*
+	 * Some other binding script is currently executing, but its
+	 * screen is no longer current.  Change the current display
+	 * back again.
+	 */
+
+	screenPtr->curDispPtr = oldDispPtr;
+	screenPtr->curScreenIndex = oldScreen;
+	ChangeScreen(interp, oldDispPtr->name, oldScreen);
+    }
+    Tcl_DStringResult(interp, &savedResult);
+    Tcl_DStringFree(&scripts);
+
+    if (matchCount > 0) {
+	PendingBinding **curPtrPtr;
+
+	for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
+	    if (*curPtrPtr == pendingPtr) {
+		*curPtrPtr = pendingPtr->nextPtr;
+		break;
+	    }
+	    curPtrPtr = &(*curPtrPtr)->nextPtr;
+	}
+	if (pendingPtr != &staticPending) {
+	    ckfree((char *) pendingPtr);
+	}
+    }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindDeadWindow --
+ *
+ *	This procedure is invoked when it is determined that a window is
+ *	dead.  It cleans up bind-related information about the window
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Any pending C bindings for this window are cancelled.
+ *
+ *---------------------------------------------------------------------------
+ */
+ 
+void
+TkBindDeadWindow(winPtr)
+    TkWindow *winPtr;		/* The window that is being deleted. */
+{
+    BindInfo *bindInfoPtr;
+    PendingBinding *curPtr;
+
+    bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+    curPtr = bindInfoPtr->pendingList;
+    while (curPtr != NULL) {
+	if (curPtr->tkwin == (Tk_Window) winPtr) {
+	    curPtr->deleted = 1;
+	}
+	curPtr = curPtr->nextPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchPatterns --
+ *
+ *      Given a list of pattern sequences and a list of recent events,
+ *      return the pattern sequence that best matches the event list,
+ *	if there is one.
+ *
+ *	This procedure is used in two different ways.  In the simplest
+ *	use, "object" is NULL and psPtr is a list of pattern sequences,
+ *	each of which corresponds to a binding.  In this case, the
+ *	procedure finds the pattern sequences that match the event list
+ *	and returns the most specific of those, if there is more than one.
+ *
+ *	In the second case, psPtr is a list of pattern sequences, each
+ *	of which corresponds to a definition for a virtual binding.
+ *	In order for one of these sequences to "match", it must match
+ *	the events (as above) but in addition there must be a binding
+ *	for its associated virtual event on the current object.  The
+ *	"object" argument indicates which object the binding must be for.
+ *
+ * Results:
+ *      The return value is NULL if bestPtr is NULL and no pattern matches
+ *	the recent events from bindPtr.  Otherwise the return value is
+ *	the most specific pattern sequence among bestPtr and all those
+ *	at psPtr that match the event list and object.  If a pattern
+ *	sequence other than bestPtr is returned, then *bestCommandPtr
+ *	is filled in with a pointer to the command from the best sequence.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+static PatSeq *
+MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
+    TkDisplay *dispPtr;		/* Display from which the event came. */
+    BindingTable *bindPtr;	/* Information about binding table, such as
+				 * ring of recent events. */
+    PatSeq *psPtr;		/* List of pattern sequences. */
+    PatSeq *bestPtr; 		/* The best match seen so far, from a
+				 * previous call to this procedure.  NULL
+				 * means no prior best match. */
+    ClientData *objectPtr;	/* If NULL, the sequences at psPtr
+				 * correspond to "normal" bindings.  If
+				 * non-NULL, the sequences at psPtr correspond
+				 * to virtual bindings; in order to match each
+				 * sequence must correspond to a virtual
+				 * binding for which a binding exists for
+				 * object in bindPtr. */
+    PatSeq **sourcePtrPtr;	/* Filled with the pattern sequence that
+				 * contains the eventProc and clientData
+				 * associated with the best match.  If this
+				 * differs from the return value, it is the
+				 * virtual event that most closely matched the
+				 * return value (a physical event).  Not
+				 * modified unless a result other than bestPtr
+				 * is returned. */
+{
+    PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
+
+    bestSourcePtr = *sourcePtrPtr;
+
+    /*
+     * Iterate over all the pattern sequences.
+     */
+
+    for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
+	XEvent *eventPtr;
+	Pattern *patPtr;
+	Window window;
+	Detail *detailPtr;
+	int patCount, ringCount, flags, state;
+	int modMask;
+
+	/*
+	 * Iterate over all the patterns in a sequence to be
+	 * sure that they all match.
+	 */
+
+	eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
+	detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
+	window = eventPtr->xany.window;
+	patPtr = psPtr->pats;
+	patCount = psPtr->numPats;
+	ringCount = EVENT_BUFFER_SIZE;
+	while (patCount > 0) {
+	    if (ringCount <= 0) {
+		goto nextSequence;
+	    }
+	    if (eventPtr->xany.type != patPtr->eventType) {
+		/*
+		 * Most of the event types are considered superfluous
+		 * in that they are ignored if they occur in the middle
+		 * of a pattern sequence and have mismatching types.  The
+		 * only ones that cannot be ignored are ButtonPress and
+		 * ButtonRelease events (if the next event in the pattern
+		 * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
+		 * events (if the next pattern event is a ButtonPress or
+		 * ButtonRelease).  Here are some tricky cases to consider:
+		 * 1. Double-Button or Double-Key events.
+		 * 2. Double-ButtonRelease or Double-KeyRelease events.
+		 * 3. The arrival of various events like Enter and Leave
+		 *    and FocusIn and GraphicsExpose between two button
+		 *    presses or key presses.
+		 * 4. Modifier keys like Shift and Control shouldn't
+		 *    generate conflicts with button events.
+		 */
+
+		if ((patPtr->eventType == KeyPress)
+			|| (patPtr->eventType == KeyRelease)) {
+		    if ((eventPtr->xany.type == ButtonPress)
+			    || (eventPtr->xany.type == ButtonRelease)) {
+			goto nextSequence;
+		    }
+		} else if ((patPtr->eventType == ButtonPress)
+			|| (patPtr->eventType == ButtonRelease)) {
+		    if ((eventPtr->xany.type == KeyPress)
+			    || (eventPtr->xany.type == KeyRelease)) {
+			int i;
+
+			/*
+			 * Ignore key events if they are modifier keys.
+			 */
+
+			for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+			    if (dispPtr->modKeyCodes[i]
+				    == eventPtr->xkey.keycode) {
+				/*
+				 * This key is a modifier key, so ignore it.
+				 */
+				goto nextEvent;
+			    }
+			}
+			goto nextSequence;
+		    }
+		}
+		goto nextEvent;
+	    }
+	    if (eventPtr->xany.window != window) {
+		goto nextSequence;
+	    }
+
+	    /*
+	     * Note: it's important for the keysym check to go before
+	     * the modifier check, so we can ignore unwanted modifier
+	     * keys before choking on the modifier check.
+	     */
+
+	    if ((patPtr->detail.clientData != 0)
+		    && (patPtr->detail.clientData != detailPtr->clientData)) {
+		/*
+		 * The detail appears not to match.  However, if the event
+		 * is a KeyPress for a modifier key then just ignore the
+		 * event.  Otherwise event sequences like "aD" never match
+		 * because the shift key goes down between the "a" and the
+		 * "D".
+		 */
+
+		if (eventPtr->xany.type == KeyPress) {
+		    int i;
+
+		    for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+			if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+			    goto nextEvent;
+			}
+		    }
+		}
+		goto nextSequence;
+	    }
+	    flags = flagArray[eventPtr->type];
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+		state = eventPtr->xkey.state;
+	    } else if (flags & CROSSING) {
+		state = eventPtr->xcrossing.state;
+	    } else {
+		state = 0;
+	    }
+	    if (patPtr->needMods != 0) {
+		modMask = patPtr->needMods;
+		if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
+		    modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
+		}
+		if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
+		    modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
+		}
+		if ((state & modMask) != modMask) {
+		    goto nextSequence;
+		}
+	    }
+	    if (psPtr->flags & PAT_NEARBY) {
+		XEvent *firstPtr;
+		int timeDiff;
+
+		firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
+		timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
+		if ((firstPtr->xkey.x_root
+			    < (eventPtr->xkey.x_root - NEARBY_PIXELS))
+			|| (firstPtr->xkey.x_root
+			    > (eventPtr->xkey.x_root + NEARBY_PIXELS))
+			|| (firstPtr->xkey.y_root
+			    < (eventPtr->xkey.y_root - NEARBY_PIXELS))
+			|| (firstPtr->xkey.y_root
+			    > (eventPtr->xkey.y_root + NEARBY_PIXELS))
+			|| (timeDiff > NEARBY_MS)) {
+		    goto nextSequence;
+		}
+	    }
+	    patPtr++;
+	    patCount--;
+	    nextEvent:
+	    if (eventPtr == bindPtr->eventRing) {
+		eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
+		detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
+	    } else {
+		eventPtr--;
+		detailPtr--;
+	    }
+	    ringCount--;
+	}
+
+	matchPtr = psPtr;
+	sourcePtr = psPtr;
+
+	if (objectPtr != NULL) {
+	    int iVirt;
+	    VirtualOwners *voPtr;
+	    PatternTableKey key;
+
+	    /*
+	     * The sequence matches the physical constraints.
+	     * Is this object interested in any of the virtual events
+	     * that correspond to this sequence?  
+	     */
+
+	    voPtr = psPtr->voPtr;
+
+	    memset(&key, 0, sizeof(key));
+	    key.object = *objectPtr;
+	    key.type = VirtualEvent;
+	    key.detail.clientData = 0;
+
+	    for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+	        Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
+
+	        key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
+			hPtr);
+		hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
+			(char *) &key);
+		if (hPtr != NULL) {
+
+		    /*
+		     * This tag is interested in this virtual event and its
+		     * corresponding physical event is a good match with the
+		     * virtual event's definition.
+		     */
+
+		    PatSeq *virtMatchPtr;
+
+		    virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+		    if ((virtMatchPtr->numPats != 1)
+			    || (virtMatchPtr->nextSeqPtr != NULL)) {
+			panic("MatchPattern: badly constructed virtual event");
+		    }
+		    sourcePtr = virtMatchPtr;
+		    goto match;
+		}
+	    }
+
+	    /*
+	     * The physical event matches a virtual event's definition, but
+	     * the tag isn't interested in it.
+	     */
+	    goto nextSequence;
+	}
+	match:
+
+	/*
+	 * This sequence matches.  If we've already got another match,
+	 * pick whichever is most specific.  Detail is most important,
+	 * then needMods.
+	 */
+
+	if (bestPtr != NULL) {
+	    Pattern *patPtr2;
+	    int i;
+
+	    if (matchPtr->numPats != bestPtr->numPats) {
+		if (bestPtr->numPats > matchPtr->numPats) {
+		    goto nextSequence;
+		} else {
+		    goto newBest;
+		}
+	    }
+	    for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
+		    i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
+		if (patPtr->detail.clientData != patPtr2->detail.clientData) {
+		    if (patPtr->detail.clientData == 0) {
+			goto nextSequence;
+		    } else {
+			goto newBest;
+		    }
+		}
+		if (patPtr->needMods != patPtr2->needMods) {
+		    if ((patPtr->needMods & patPtr2->needMods)
+			    == patPtr->needMods) {
+			goto nextSequence;
+		    } else if ((patPtr->needMods & patPtr2->needMods)
+			    == patPtr2->needMods) {
+			goto newBest;
+		    }
+		}
+	    }
+	    /*
+	     * Tie goes to current best pattern.
+	     *
+	     * (1) For virtual vs. virtual, the least recently defined
+	     * virtual wins, because virtuals are examined in order of
+	     * definition.  This order is _not_ guaranteed in the
+	     * documentation.
+	     *
+	     * (2) For virtual vs. physical, the physical wins because all
+	     * the physicals are examined before the virtuals.  This order
+	     * is guaranteed in the documentation.
+	     *
+	     * (3) For physical vs. physical pattern, the most recently
+	     * defined physical wins, because physicals are examined in
+	     * reverse order of definition.  This order is guaranteed in
+	     * the documentation.
+	     */
+
+	    goto nextSequence;	
+	}
+	newBest:
+	bestPtr = matchPtr;
+	bestSourcePtr = sourcePtr;
+
+	nextSequence: continue;
+    }
+
+    *sourcePtrPtr = bestSourcePtr;
+    return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ *
+ *	Given a command and an event, produce a new command
+ *	by replacing % constructs in the original command
+ *	with information from the X event.
+ *
+ * Results:
+ *	The new expanded command is appended to the dynamic string
+ *	given by dsPtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
+    TkWindow *winPtr;		/* Window where event occurred:  needed to
+				 * get input context. */
+    char *before;		/* Command containing percent expressions
+				 * to be replaced. */
+    XEvent *eventPtr;		/* X event containing information to be
+				 * used in % replacements. */
+    KeySym keySym;		/* KeySym: only relevant for KeyPress and
+				 * KeyRelease events). */
+    Tcl_DString *dsPtr;		/* Dynamic string in which to append new
+				 * command. */
+{
+    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
+				 * list element. */
+    int number, flags, length;
+#define NUM_SIZE 40
+    char *string;
+    char numStorage[NUM_SIZE+1];
+
+    if (eventPtr->type < TK_LASTEVENT) {
+	flags = flagArray[eventPtr->type];
+    } else {
+	flags = 0;
+    }
+    while (1) {
+	/*
+	 * Find everything up to the next % character and append it
+	 * to the result string.
+	 */
+
+	for (string = before; (*string != 0) && (*string != '%'); string++) {
+	    /* Empty loop body. */
+	}
+	if (string != before) {
+	    Tcl_DStringAppend(dsPtr, before, string-before);
+	    before = string;
+	}
+	if (*before == 0) {
+	    break;
+	}
+
+	/*
+	 * There's a percent sequence here.  Process it.
+	 */
+
+	number = 0;
+	string = "??";
+	switch (before[1]) {
+	    case '#':
+		number = eventPtr->xany.serial;
+		goto doNumber;
+	    case 'a':
+		TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+		string = numStorage;
+		goto doString;
+	    case 'b':
+		number = eventPtr->xbutton.button;
+		goto doNumber;
+	    case 'c':
+		if (flags & EXPOSE) {
+		    number = eventPtr->xexpose.count;
+		}
+		goto doNumber;
+	    case 'd':
+		if (flags & (CROSSING|FOCUS)) {
+		    if (flags & FOCUS) {
+			number = eventPtr->xfocus.detail;
+		    } else {
+			number = eventPtr->xcrossing.detail;
+		    }
+		    string = TkFindStateString(notifyDetail, number);
+		}
+		goto doString;
+	    case 'f':
+		number = eventPtr->xcrossing.focus;
+		goto doNumber;
+	    case 'h':
+		if (flags & EXPOSE) {
+		    number = eventPtr->xexpose.height;
+		} else if (flags & (CONFIG)) {
+		    number = eventPtr->xconfigure.height;
+		}
+		goto doNumber;
+	    case 'k':
+		number = eventPtr->xkey.keycode;
+		goto doNumber;
+	    case 'm':
+		if (flags & CROSSING) {
+		    number = eventPtr->xcrossing.mode;
+		} else if (flags & FOCUS) {
+		    number = eventPtr->xfocus.mode;
+		}
+		string = TkFindStateString(notifyMode, number);
+		goto doString;
+	    case 'o':
+		if (flags & CREATE) {
+		    number = eventPtr->xcreatewindow.override_redirect;
+		} else if (flags & MAP) {
+		    number = eventPtr->xmap.override_redirect;
+		} else if (flags & REPARENT) {
+		    number = eventPtr->xreparent.override_redirect;
+		} else if (flags & CONFIG) {
+		    number = eventPtr->xconfigure.override_redirect;
+		}
+		goto doNumber;
+	    case 'p':
+		string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
+		goto doString;
+	    case 's':
+		if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+		    number = eventPtr->xkey.state;
+		} else if (flags & CROSSING) {
+		    number = eventPtr->xcrossing.state;
+		} else if (flags & VISIBILITY) {
+		    string = TkFindStateString(visNotify,
+			    eventPtr->xvisibility.state);
+		    goto doString;
+		}
+		goto doNumber;
+	    case 't':
+		if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+		    number = (int) eventPtr->xkey.time;
+		} else if (flags & CROSSING) {
+		    number = (int) eventPtr->xcrossing.time;
+		} else if (flags & PROP) {
+		    number = (int) eventPtr->xproperty.time;
+		}
+		goto doNumber;
+	    case 'v':
+		number = eventPtr->xconfigurerequest.value_mask;
+		goto doNumber;
+	    case 'w':
+		if (flags & EXPOSE) {
+		    number = eventPtr->xexpose.width;
+		} else if (flags & CONFIG) {
+		    number = eventPtr->xconfigure.width;
+		}
+		goto doNumber;
+	    case 'x':
+		if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+		    number = eventPtr->xkey.x;
+		} else if (flags & CROSSING) {
+		    number = eventPtr->xcrossing.x;
+		} else if (flags & EXPOSE) {
+		    number = eventPtr->xexpose.x;
+		} else if (flags & (CREATE|CONFIG|GRAVITY)) {
+		    number = eventPtr->xcreatewindow.x;
+		} else if (flags & REPARENT) {
+		    number = eventPtr->xreparent.x;
+		}
+		goto doNumber;
+	    case 'y':
+		if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+		    number = eventPtr->xkey.y;
+		} else if (flags & EXPOSE) {
+		    number = eventPtr->xexpose.y;
+		} else if (flags & (CREATE|CONFIG|GRAVITY)) {
+		    number = eventPtr->xcreatewindow.y;
+		} else if (flags & REPARENT) {
+		    number = eventPtr->xreparent.y;
+		} else if (flags & CROSSING) {
+		    number = eventPtr->xcrossing.y;
+
+		}
+		goto doNumber;
+	    case 'A':
+		if (flags & KEY) {
+		    int numChars;
+
+		    /*
+		     * If we're using input methods and this is a keypress
+		     * event, invoke XmbTkFindStateString.  Otherwise just use
+		     * the older XTkFindStateString.
+		     */
+
+#ifdef TK_USE_INPUT_METHODS
+		    Status status;
+		    if ((winPtr->inputContext != NULL)
+			    && (eventPtr->type == KeyPress)) {
+                        numChars = XmbLookupString(winPtr->inputContext,
+                                &eventPtr->xkey, numStorage, NUM_SIZE,
+                                (KeySym *) NULL, &status);
+			if ((status != XLookupChars)
+				&& (status != XLookupBoth)) {
+			    numChars = 0;
+			}
+                    } else {
+                        numChars = XLookupString(&eventPtr->xkey, numStorage,
+                                NUM_SIZE, (KeySym *) NULL,
+                                (XComposeStatus *) NULL);
+		    }
+#else /* TK_USE_INPUT_METHODS */
+		    numChars = XLookupString(&eventPtr->xkey, numStorage,
+			    NUM_SIZE, (KeySym *) NULL,
+			    (XComposeStatus *) NULL);
+#endif /* TK_USE_INPUT_METHODS */
+		    numStorage[numChars] = '\0';
+		    string = numStorage;
+		}
+		goto doString;
+	    case 'B':
+		number = eventPtr->xcreatewindow.border_width;
+		goto doNumber;
+	    case 'E':
+		number = (int) eventPtr->xany.send_event;
+		goto doNumber;
+	    case 'K':
+		if (flags & KEY) {
+		    char *name;
+
+		    name = TkKeysymToString(keySym);
+		    if (name != NULL) {
+			string = name;
+		    }
+		}
+		goto doString;
+	    case 'N':
+		number = (int) keySym;
+		goto doNumber;
+	    case 'R':
+		TkpPrintWindowId(numStorage, eventPtr->xkey.root);
+		string = numStorage;
+		goto doString;
+            case 'S':
+		TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
+		string = numStorage;
+		goto doString;
+	    case 'T':
+		number = eventPtr->type;
+		goto doNumber;
+	    case 'W': {
+		Tk_Window tkwin;
+
+		tkwin = Tk_IdToWindow(eventPtr->xany.display,
+			eventPtr->xany.window);
+		if (tkwin != NULL) {
+		    string = Tk_PathName(tkwin);
+		} else {
+		    string = "??";
+		}
+		goto doString;
+	    }
+	    case 'X': {
+		Tk_Window tkwin;
+		int x, y;
+		int width, height;
+
+		number = eventPtr->xkey.x_root;
+		tkwin = Tk_IdToWindow(eventPtr->xany.display,
+			eventPtr->xany.window);
+		if (tkwin != NULL) {
+		    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+		    number -= x;
+		}
+		goto doNumber;
+	    }
+	    case 'Y': {
+		Tk_Window tkwin;
+		int x, y;
+		int width, height;
+
+		number = eventPtr->xkey.y_root;
+		tkwin = Tk_IdToWindow(eventPtr->xany.display,
+			eventPtr->xany.window);
+		if (tkwin != NULL) {
+		    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+		    number -= y;
+		}
+		goto doNumber;
+	    }
+	    default:
+		numStorage[0] = before[1];
+		numStorage[1] = '\0';
+		string = numStorage;
+		goto doString;
+	}
+
+	doNumber:
+	sprintf(numStorage, "%d", number);
+	string = numStorage;
+
+	doString:
+	spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
+	length = Tcl_DStringLength(dsPtr);
+	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+	spaceNeeded = Tcl_ConvertElement(string,
+		Tcl_DStringValue(dsPtr) + length,
+		cvtFlags | TCL_DONT_USE_BRACES);
+	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+	before += 2;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeScreen --
+ *
+ *	This procedure is invoked whenever the current screen changes
+ *	in an application.  It invokes a Tcl procedure named
+ *	"tkScreenChanged", passing it the screen name as argument.
+ *	tkScreenChanged does things like making the tkPriv variable
+ *	point to an array for the current display.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on what tkScreenChanged does.  If an error occurs
+ *	them tkError will be invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeScreen(interp, dispName, screenIndex)
+    Tcl_Interp *interp;			/* Interpreter in which to invoke
+					 * command. */
+    char *dispName;			/* Name of new display. */
+    int screenIndex;			/* Index of new screen. */
+{
+    Tcl_DString cmd;
+    int code;
+    char screen[30];
+
+    Tcl_DStringInit(&cmd);
+    Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
+    Tcl_DStringAppend(&cmd, dispName, -1);
+    sprintf(screen, ".%d", screenIndex);
+    Tcl_DStringAppend(&cmd, screen, -1);
+    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));
+    if (code != TCL_OK) {
+	Tcl_AddErrorInfo(interp,
+		"\n    (changing screen in event binding)");
+	Tcl_BackgroundError(interp);
+    }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_EventCmd --
+ *
+ *	This procedure is invoked to process the "event" Tcl command.
+ *	It is used to define and generate events.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_EventCmd(clientData, interp, argc, argv)
+    ClientData clientData;	/* Main window associated with
+				 * interpreter. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
+{
+    int i;
+    size_t length;
+    char *option;
+    Tk_Window tkwin;
+    VirtualEventTable *vetPtr;
+    TkBindInfo bindInfo;
+
+    if (argc < 2) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option ?arg1?\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    option = argv[1];
+    length = strlen(option);
+    if (length == 0) {
+	goto badopt;
+    }
+
+    tkwin = (Tk_Window) clientData;
+    bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
+    vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
+
+    if (strncmp(option, "add", length) == 0) {
+	if (argc < 4) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " add virtual sequence ?sequence ...?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	for (i = 3; i < argc; i++) {
+	    if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i])
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+    } else if (strncmp(option, "delete", length) == 0) {
+	if (argc < 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " delete virtual ?sequence sequence ...?\"",
+		    (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (argc == 3) {
+	    return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL);
+	}
+	for (i = 3; i < argc; i++) {
+	    if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i])
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+    } else if (strncmp(option, "generate", length) == 0) {
+	if (argc < 4) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " generate window event ?options?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2);
+    } else if (strncmp(option, "info", length) == 0) {
+	if (argc == 2) {
+	    GetAllVirtualEvents(interp, vetPtr);
+	    return TCL_OK;
+	} else if (argc == 3) {	
+	    return GetVirtualEvent(interp, vetPtr, argv[2]);
+	} else {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " info ?virtual?\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    } else {
+	badopt:
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": should be add, delete, generate, info", (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitVirtualEventTable --
+ *
+ *	Given storage for a virtual event table, set up the fields to
+ *	prepare a new domain in which virtual events may be defined.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	*vetPtr is now initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitVirtualEventTable(vetPtr)
+    VirtualEventTable *vetPtr;	/* Pointer to virtual event table.  Memory
+				 * is supplied by the caller. */
+{
+    Tcl_InitHashTable(&vetPtr->patternTable,
+	    sizeof(PatternTableKey) / sizeof(int));
+    Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DeleteVirtualEventTable --
+ *
+ *	Delete the contents of a virtual event table.  The caller is
+ *	responsible for freeing any memory used by the table itself.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DeleteVirtualEventTable(vetPtr)
+    VirtualEventTable *vetPtr;	/* The virtual event table to delete. */
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    PatSeq *psPtr, *nextPtr;
+
+    hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
+    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+	for ( ; psPtr != NULL; psPtr = nextPtr) {
+	    nextPtr = psPtr->nextSeqPtr;
+	    ckfree((char *) psPtr->voPtr);
+	    ckfree((char *) psPtr);
+	}
+    }
+    Tcl_DeleteHashTable(&vetPtr->patternTable);
+
+    hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+        ckfree((char *) Tcl_GetHashValue(hPtr));
+    }
+    Tcl_DeleteHashTable(&vetPtr->nameTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateVirtualEvent --
+ *
+ *	Add a new definition for a virtual event.  If the virtual event
+ *	is already defined, the new definition augments those that
+ *	already exist.
+ *
+ * Results:
+ *	The return value is TCL_ERROR if an error occured while
+ *	creating the virtual binding.  In this case, an error message
+ *	will be left in interp->result.  If all went well then the return
+ *	value is TCL_OK.
+ *
+ * Side effects:
+ *	The virtual event may cause future calls to Tk_BindEvent to
+ *	behave differently than they did previously.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateVirtualEvent(interp, vetPtr, virtString, eventString)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    VirtualEventTable *vetPtr;/* Table in which to augment virtual event. */
+    char *virtString;		/* Name of new virtual event. */
+    char *eventString;		/* String describing physical event that
+				 * triggers virtual event. */
+{
+    PatSeq *psPtr;
+    int dummy;
+    Tcl_HashEntry *vhPtr;
+    unsigned long eventMask;
+    PhysicalsOwned *poPtr;
+    VirtualOwners *voPtr;
+    Tk_Uid virtUid;
+    
+    virtUid = GetVirtualEventUid(interp, virtString);
+    if (virtUid == NULL) {
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find/create physical event
+     */
+
+    psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
+	    1, 0, &eventMask);
+    if (psPtr == NULL) {
+        return TCL_ERROR;
+    }
+
+    /*
+     * Find/create virtual event.
+     */
+
+    vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
+
+    /*
+     * Make virtual event own the physical event.
+     */
+
+    poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+    if (poPtr == NULL) {
+	poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
+	poPtr->numOwned = 0;
+    } else {
+        /*
+	 * See if this virtual event is already defined for this physical
+	 * event and just return if it is.
+	 */
+
+	int i;
+	for (i = 0; i < poPtr->numOwned; i++) {
+	    if (poPtr->patSeqs[i] == psPtr) {
+	        return TCL_OK;
+	    }
+	}
+	poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
+		sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
+    }	
+    Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
+    poPtr->patSeqs[poPtr->numOwned] = psPtr;
+    poPtr->numOwned++;
+
+    /*
+     * Make physical event so it can trigger the virtual event.
+     */
+
+    voPtr = psPtr->voPtr;
+    if (voPtr == NULL) {
+        voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
+	voPtr->numOwners = 0;
+    } else {
+        voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
+		sizeof(VirtualOwners)
+		+ voPtr->numOwners * sizeof(Tcl_HashEntry *));
+    }
+    psPtr->voPtr = voPtr;
+    voPtr->owners[voPtr->numOwners] = vhPtr;
+    voPtr->numOwners++;
+
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteVirtualEvent --
+ *
+ *	Remove the definition of a given virtual event.  If the 
+ *	event string is NULL, all definitions of the virtual event
+ *	will be removed.  Otherwise, just the specified definition
+ *	of the virtual event will be removed.
+ *
+ * Results:
+ *	The result is a standard Tcl return value.  If an error
+ *	occurs then interp->result will contain an error message.
+ *	It is not an error to attempt to delete a virtual event that
+ *	does not exist or a definition that does not exist.
+ *
+ * Side effects:
+ *	The virtual event given by virtString may be removed from the
+ *	virtual event table.  
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    VirtualEventTable *vetPtr;/* Table in which to delete event. */
+    char *virtString;		/* String describing event sequence that
+				 * triggers binding. */
+    char *eventString;		/* The event sequence that should be deleted,
+				 * or NULL to delete all event sequences for
+				 * the entire virtual event. */
+{
+    int iPhys;
+    Tk_Uid virtUid;
+    Tcl_HashEntry *vhPtr;
+    PhysicalsOwned *poPtr;
+    PatSeq *eventPSPtr;
+
+    virtUid = GetVirtualEventUid(interp, virtString);
+    if (virtUid == NULL) {
+        return TCL_ERROR;
+    }
+    
+    vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+    if (vhPtr == NULL) {
+        return TCL_OK;
+    }
+    poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+
+    eventPSPtr = NULL;
+    if (eventString != NULL) {
+	unsigned long eventMask;
+
+	/*
+	 * Delete only the specific physical event associated with the
+	 * virtual event.  If the physical event doesn't already exist, or
+	 * the virtual event doesn't own that physical event, return w/o
+	 * doing anything.
+	 */
+
+	eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
+		eventString, 0, 0, &eventMask);
+	if (eventPSPtr == NULL) {
+	    return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK;
+	}
+    }
+
+    for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
+	PatSeq *psPtr = poPtr->patSeqs[iPhys];
+	if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
+	    int iVirt;
+	    VirtualOwners *voPtr;
+	    
+	    /*
+	     * Remove association between this physical event and the given
+	     * virtual event that it triggers.
+	     */
+
+	    voPtr = psPtr->voPtr;
+	    for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+		if (voPtr->owners[iVirt] == vhPtr) {
+		    break;
+		}
+	    }
+	    if (iVirt == voPtr->numOwners) {
+		panic("DeleteVirtualEvent: couldn't find owner");
+	    }
+	    voPtr->numOwners--;
+	    if (voPtr->numOwners == 0) {
+		/*
+		 * Removed last reference to this physical event, so
+		 * remove it from physical->virtual map.
+		 */
+		PatSeq *prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+		if (prevPtr == psPtr) {
+		    if (psPtr->nextSeqPtr == NULL) {
+			Tcl_DeleteHashEntry(psPtr->hPtr);
+		    } else {
+			Tcl_SetHashValue(psPtr->hPtr,
+				psPtr->nextSeqPtr);
+		    }
+		} else {
+		    for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+			if (prevPtr == NULL) {
+			    panic("Tk_DeleteVirtualEvent couldn't find on hash chain");
+			}
+			if (prevPtr->nextSeqPtr == psPtr) {
+			    prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+			    break;
+			}
+		    }
+		}
+		ckfree((char *) psPtr->voPtr);
+		ckfree((char *) psPtr);
+	    } else {
+		/*
+		 * This physical event still triggers some other virtual
+		 * event(s).  Consolidate the list of virtual owners for
+		 * this physical event so it no longer triggers the
+		 * given virtual event.
+		 */
+		voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
+	    }
+
+	    /*
+	     * Now delete the virtual event's reference to the physical
+	     * event.
+	     */
+
+	    poPtr->numOwned--;
+	    if (eventPSPtr != NULL && poPtr->numOwned != 0) {
+	        /*
+		 * Just deleting this one physical event.  Consolidate list
+		 * of owned physical events and return.
+		 */
+
+		poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
+		return TCL_OK;
+	    }
+	}
+    }
+
+    if (poPtr->numOwned == 0) {
+	/*
+	 * All the physical events for this virtual event were deleted,
+	 * either because there was only one associated physical event or
+	 * because the caller was deleting the entire virtual event.  Now
+	 * the virtual event itself should be deleted.
+	 */
+
+	ckfree((char *) poPtr);
+	Tcl_DeleteHashEntry(vhPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetVirtualEvent --
+ *
+ *	Return the list of physical events that can invoke the
+ *	given virtual event.
+ *
+ * Results:
+ *	The return value is TCL_OK and interp->result is filled with the
+ *	string representation of the physical events associated with the
+ *	virtual event; if there are no physical events for the given virtual
+ *	event, interp->result is filled with and empty string.  If the
+ *	virtual event string is improperly formed, then TCL_ERROR is
+ *	returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetVirtualEvent(interp, vetPtr, virtString)
+    Tcl_Interp *interp;		/* Interpreter for reporting. */
+    VirtualEventTable *vetPtr;/* Table in which to look for event. */
+    char *virtString;		/* String describing virtual event. */
+{
+    Tcl_HashEntry *vhPtr;
+    Tcl_DString ds;
+    int iPhys;
+    PhysicalsOwned *poPtr;
+    Tk_Uid virtUid;
+
+    virtUid = GetVirtualEventUid(interp, virtString);
+    if (virtUid == NULL) {
+        return TCL_ERROR;
+    }
+
+    vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+    if (vhPtr == NULL) {
+        return TCL_OK;
+    }
+
+    Tcl_DStringInit(&ds);
+
+    poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+    for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
+	Tcl_DStringSetLength(&ds, 0);
+	GetPatternString(poPtr->patSeqs[iPhys], &ds);
+	Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+    }
+    Tcl_DStringFree(&ds);
+
+    return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetAllVirtualEvents --
+ *
+ *	Return a list that contains the names of all the virtual
+ *	event defined.
+ *
+ * Results:
+ *	There is no return value.  Interp->result is modified to
+ *	hold a Tcl list with one entry for each virtual event in 
+ *	nameTable.  
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GetAllVirtualEvents(interp, vetPtr)
+    Tcl_Interp *interp;		/* Interpreter returning result. */
+    VirtualEventTable *vetPtr;/* Table containing events. */
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_DString ds;
+
+    Tcl_DStringInit(&ds);
+
+    hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	Tcl_DStringSetLength(&ds, 0);	
+	Tcl_DStringAppend(&ds, "<<", 2);
+	Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
+	Tcl_DStringAppend(&ds, ">>", 2);
+        Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+    }
+
+    Tcl_DStringFree(&ds);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HandleEventGenerate --
+ *
+ *	Helper function for the "event generate" command.  Generate and
+ *	process an XEvent, constructed from information parsed from the
+ *	event description string and its optional arguments.
+ *
+ *	argv[0] contains name of the target window.
+ *	argv[1] contains pattern string for one event (e.g, <Control-v>).
+ *	argv[2..argc-1] contains -field/option pairs for specifying
+ *		        additional detail in the generated event.
+ *
+ *	Either virtual or physical events can be generated this way.
+ *	The event description string must contain the specification
+ *	for only one event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When constructing the event, 
+ *	 event.xany.serial is filled with the current X serial number.
+ *	 event.xany.window is filled with the target window.
+ *	 event.xany.display is filled with the target window's display.
+ *	Any other fields in eventPtr which are not specified by the pattern
+ *	string or the optional arguments, are set to 0.
+ *
+ *	The event may be handled sychronously or asynchronously, depending
+ *	on the value specified by the optional "-when" option.  The
+ *	default setting is synchronous.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
+HandleEventGenerate(interp, main, argc, argv)
+    Tcl_Interp *interp;	    /* Interp for error messages and name lookup. */
+    Tk_Window main;	    /* Main window associated with interp. */
+    int argc;		    /* Number of arguments. */
+    char **argv;	    /* Argument strings. */
+{
+    Pattern pat;
+    Tk_Window tkwin;
+    char *p;
+    unsigned long eventMask;
+    int count, i, state, flags, synch;
+    Tcl_QueuePosition pos;
+    XEvent event;    
+
+    if (argv[0][0] == '.') {
+	tkwin = Tk_NameToWindow(interp, argv[0], main);
+	if (tkwin == NULL) {
+	    return TCL_ERROR;
+	}
+    } else {
+	if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) {
+	    Tcl_AppendResult(interp, "bad window name/identifier \"",
+		    argv[0], "\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	tkwin = Tk_IdToWindow(Tk_Display(main), (Window) i);
+	if ((tkwin == NULL) || (((TkWindow *) main)->mainPtr
+		!= ((TkWindow *) tkwin)->mainPtr)) {
+	    Tcl_AppendResult(interp, "window id \"", argv[0],
+		    "\" doesn't exist in this application", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    p = argv[1];
+    count = ParseEventDescription(interp, &p, &pat, &eventMask);
+    if (count == 0) {
+	return TCL_ERROR;
+    }
+    if (count != 1) {
+	interp->result = "Double or Triple modifier not allowed";
+	return TCL_ERROR;
+    }
+    if (*p != '\0') {
+	interp->result = "only one event specification allowed";
+	return TCL_ERROR;
+    }
+    if (argc & 1) {
+        Tcl_AppendResult(interp, "value for \"", argv[argc - 1],
+		"\" missing", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    memset((VOID *) &event, 0, sizeof(event));
+    event.xany.type = pat.eventType;
+    event.xany.serial = NextRequest(Tk_Display(tkwin));
+    event.xany.send_event = False;
+    event.xany.window = Tk_WindowId(tkwin);
+    event.xany.display = Tk_Display(tkwin);
+
+    flags = flagArray[event.xany.type];
+    if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+	event.xkey.state = pat.needMods;
+	if (flags & KEY) {
+	    /*
+	     * When mapping from a keysym to a keycode, need information about
+	     * the modifier state that should be used so that when they call 
+	     * XKeycodeToKeysym	taking into account the xkey.state, they will
+	     * get back the original keysym.  
+	     */
+
+	    if (pat.detail.keySym == NoSymbol) {
+	        event.xkey.keycode = 0;
+	    } else {
+		event.xkey.keycode = XKeysymToKeycode(event.xany.display,
+			pat.detail.keySym);
+	    }
+	    if (event.xkey.keycode != 0) {
+		for (state = 0; state < 4; state++) {
+		    if (XKeycodeToKeysym(event.xany.display,
+			    event.xkey.keycode, state) == pat.detail.keySym) {
+			if (state & 1) {
+			    event.xkey.state |= ShiftMask;
+			}
+			if (state & 2) {
+			    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 
+			    event.xkey.state |= dispPtr->modeModMask;
+			}
+			break;
+		    }
+		}
+	    }
+	} else if (flags & BUTTON) {
+	    event.xbutton.button = pat.detail.button;
+	} else if (flags & VIRTUAL) {
+	    ((XVirtualEvent *) &event)->name = pat.detail.name;
+	}
+    }
+    if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
+	event.xcreatewindow.window = event.xany.window;
+    }
+
+    /*
+     * Process the remaining arguments to fill in additional fields
+     * of the event.
+     */
+
+    synch = 1;
+    pos = TCL_QUEUE_TAIL;
+    for (i = 2; i < argc; i += 2) {
+	char *field, *value;
+	Tk_Window tkwin2;
+	int number;
+	KeySym keysym;
+	
+	field = argv[i];
+	value = argv[i+1];
+
+	if (strcmp(field, "-when") == 0) {
+	    if (strcmp(value, "now") == 0) {
+		synch = 1;
+	    } else if (strcmp(value, "head") == 0) {
+		pos = TCL_QUEUE_HEAD;
+		synch = 0;
+	    } else if (strcmp(value, "mark") == 0) {
+		pos = TCL_QUEUE_MARK;
+		synch = 0;
+	    } else if (strcmp(value, "tail") == 0) {
+		pos = TCL_QUEUE_TAIL;
+		synch = 0;
+	    } else {
+		Tcl_AppendResult(interp, "bad position \"", value,
+			"\": should be now, head, mark, tail", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	} else if (strcmp(field, "-above") == 0) {
+	    if (value[0] == '.') {
+		tkwin2 = Tk_NameToWindow(interp, value, main);
+		if (tkwin2 == NULL) {
+		    return TCL_ERROR;
+		}
+		number = Tk_WindowId(tkwin2);
+	    } else if (TkpScanWindowId(interp, value, &number)
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & CONFIG) {
+		event.xconfigure.above = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-borderwidth") == 0) {
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (CREATE|CONFIG)) {
+		event.xcreatewindow.border_width = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-button") == 0) {
+	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & BUTTON) {
+	        event.xbutton.button = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-count") == 0) {
+	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & EXPOSE) {
+		event.xexpose.count = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-detail") == 0) {
+	    number = TkFindStateNum(interp, field, notifyDetail, value);
+	    if (number < 0) {
+		return TCL_ERROR;
+	    }
+	    if (flags & FOCUS) {
+		event.xfocus.detail = number;
+	    } else if (flags & CROSSING) {
+		event.xcrossing.detail = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-focus") == 0) {
+	    if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & CROSSING) {
+		event.xcrossing.focus = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-height") == 0) {
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & EXPOSE) {
+		 event.xexpose.height = number;
+	    } else if (flags & CONFIG) {
+		event.xconfigure.height = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-keycode") == 0) {
+	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & KEY) {
+	        event.xkey.keycode = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-keysym") == 0) {
+	    keysym = TkStringToKeysym(value);
+	    if (keysym == NoSymbol) {
+		Tcl_AppendResult(interp, "unknown keysym \"", value,
+			"\"", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    /*
+	     * When mapping from a keysym to a keycode, need information about
+	     * the modifier state that should be used so that when they call 
+	     * XKeycodeToKeysym	taking into account the xkey.state, they will
+	     * get back the original keysym.  
+	     */
+
+	    number = XKeysymToKeycode(event.xany.display, keysym);
+	    if (number == 0) {
+		Tcl_AppendResult(interp, "no keycode for keysym \"", value,
+			"\"", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    for (state = 0; state < 4; state++) {
+		if (XKeycodeToKeysym(event.xany.display, (unsigned) number,
+			state) == keysym) {
+		    if (state & 1) {
+			event.xkey.state |= ShiftMask;
+		    }
+		    if (state & 2) {
+			TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 
+			event.xkey.state |= dispPtr->modeModMask;
+		    }
+		    break;
+		}
+	    }	    
+	    if (flags & KEY) {
+		event.xkey.keycode = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-mode") == 0) {
+	    number = TkFindStateNum(interp, field, notifyMode, value);
+	    if (number < 0) {
+		return TCL_ERROR;
+	    }
+	    if (flags & CROSSING) {
+		event.xcrossing.mode = number;
+	    } else if (flags & FOCUS) {
+		event.xfocus.mode = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-override") == 0) {
+	    if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & CREATE) {
+		event.xcreatewindow.override_redirect = number;
+	    } else if (flags & MAP) {
+		event.xmap.override_redirect = number;
+	    } else if (flags & REPARENT) {
+		event.xreparent.override_redirect = number;
+	    } else if (flags & CONFIG) {
+		event.xconfigure.override_redirect = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-place") == 0) {
+	    number = TkFindStateNum(interp, field, circPlace, value);
+	    if (number < 0) {
+		return TCL_ERROR;
+	    }
+	    if (flags & CIRC) {
+		event.xcirculate.place = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-root") == 0) {
+	    if (value[0] == '.') {
+		tkwin2 = Tk_NameToWindow(interp, value, main);
+		if (tkwin2 == NULL) {
+		    return TCL_ERROR;
+		}
+		number = Tk_WindowId(tkwin2);
+	    } else if (TkpScanWindowId(interp, value, &number)
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		event.xkey.root = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-rootx") == 0) {
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		event.xkey.x_root = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-rooty") == 0) {
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		event.xkey.y_root = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-sendevent") == 0) {
+	    if (isdigit(UCHAR(value[0]))) {
+		/*
+		 * Allow arbitrary integer values for the field; they
+		 * are needed by a few of the tests in the Tk test suite.
+		 */
+
+		if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } else {
+		if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
+	    event.xany.send_event = number;
+	} else if (strcmp(field, "-serial") == 0) {
+	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    event.xany.serial = number;
+	} else if (strcmp(field, "-state") == 0) {
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+		    event.xkey.state = number;
+		} else {
+		    event.xcrossing.state = number;
+		}
+	    } else if (flags & VISIBILITY) {
+		number = TkFindStateNum(interp, field, visNotify, value);
+		if (number < 0) {
+		    return TCL_ERROR;
+		}
+		event.xvisibility.state = number;
+	    } else {
+		goto badopt;
+	    }	    
+	} else if (strcmp(field, "-subwindow") == 0) {
+	    if (value[0] == '.') {
+		tkwin2 = Tk_NameToWindow(interp, value, main);
+		if (tkwin2 == NULL) {
+		    return TCL_ERROR;
+		}
+		number = Tk_WindowId(tkwin2);
+	    } else if (TkpScanWindowId(interp, value, &number)
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		event.xkey.subwindow = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-time") == 0) {
+	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		event.xkey.time = (Time) number;
+	    } else if (flags & PROP) {
+		event.xproperty.time = (Time) number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-width") == 0) {
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & EXPOSE) {
+		event.xexpose.width = number;
+	    } else if (flags & (CREATE|CONFIG)) {
+		event.xcreatewindow.width = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-window") == 0) {
+	    if (value[0] == '.') {
+		tkwin2 = Tk_NameToWindow(interp, value, main);
+		if (tkwin2 == NULL) {
+		    return TCL_ERROR;
+		}
+		number = Tk_WindowId(tkwin2);
+	    } else if (TkpScanWindowId(interp, value, &number)
+		    != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
+		    |GRAVITY|CIRC)) {
+		event.xcreatewindow.window = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-x") == 0) {
+	    int rootX, rootY;
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tk_GetRootCoords(tkwin, &rootX, &rootY);
+	    rootX += number;
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {	
+		event.xkey.x = number;
+		event.xkey.x_root = rootX;
+	    } else if (flags & EXPOSE) {
+		event.xexpose.x = number;
+	    } else if (flags & (CREATE|CONFIG|GRAVITY)) { 
+		event.xcreatewindow.x = number;
+	    } else if (flags & REPARENT) {		
+		event.xreparent.x = number;
+	    } else {
+		goto badopt;
+	    }
+	} else if (strcmp(field, "-y") == 0) {
+	    int rootX, rootY;
+	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tk_GetRootCoords(tkwin, &rootX, &rootY);
+	    rootY += number;
+	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+		event.xkey.y = number;
+		event.xkey.y_root = rootY;
+	    } else if (flags & EXPOSE) {
+		event.xexpose.y = number;
+	    } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+		event.xcreatewindow.y = number;
+	    } else if (flags & REPARENT) {
+		event.xreparent.y = number;
+	    } else {
+		goto badopt;
+	    }
+	} else {
+	    badopt:
+	    Tcl_AppendResult(interp, "bad option to ", argv[1],
+		    " event: \"", field, "\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    if (synch != 0) {
+	Tk_HandleEvent(&event);
+    } else {
+	Tk_QueueWindowEvent(&event, pos);
+    }
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetVirtualEventUid --
+ *
+ *	Determine if the given string is in the proper format for a
+ *	virtual event.
+ *
+ * Results:
+ *	The return value is NULL if the virtual event string was
+ *	not in the proper format.  In this case, an error message
+ *	will be left in interp->result.  Otherwise the return
+ *	value is a Tk_Uid that represents the virtual event.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-------------------------------------------------------------------------
+ */
+static Tk_Uid
+GetVirtualEventUid(interp, virtString)
+    Tcl_Interp *interp;
+    char *virtString;
+{
+    Tk_Uid uid;
+    int length;
+
+    length = strlen(virtString);
+
+    if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
+	    virtString[length - 2] != '>' || virtString[length - 1] != '>') {
+        Tcl_AppendResult(interp, "virtual event \"", virtString,
+		"\" is badly formed", (char *) NULL);
+        return NULL;
+    }
+    virtString[length - 2] = '\0';
+    uid = Tk_GetUid(virtString + 2);
+    virtString[length - 2] = '>';
+
+    return uid;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSequence --
+ *
+ *	Find the entry in the pattern table that corresponds to a
+ *	particular pattern string, and return a pointer to that
+ *	entry.
+ *
+ * Results:
+ *	The return value is normally a pointer to the PatSeq
+ *	in patternTable that corresponds to eventString.  If an error
+ *	was found while parsing eventString, or if "create" is 0 and
+ *	no pattern sequence previously existed, then NULL is returned
+ *	and interp->result contains a message describing the problem.
+ *	If no pattern sequence previously existed for eventString, then
+ *	a new one is created with a NULL command field.  In a successful
+ *	return, *maskPtr is filled in with a mask of the event types
+ *	on which the pattern sequence depends.
+ *
+ * Side effects:
+ *	A new pattern sequence may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static PatSeq *
+FindSequence(interp, patternTablePtr, object, eventString, create,
+	allowVirtual, maskPtr)
+    Tcl_Interp *interp;		/* Interpreter to use for error
+				 * reporting. */
+    Tcl_HashTable *patternTablePtr; /* Table to use for lookup. */
+    ClientData object;		/* For binding table, token for object with
+				 * which binding is associated.
+				 * For virtual event table, NULL. */
+    char *eventString;		/* String description of pattern to
+				 * match on.  See user documentation
+				 * for details. */
+    int create;			/* 0 means don't create the entry if
+				 * it doesn't already exist.   Non-zero
+				 * means create. */
+    int allowVirtual;		/* 0 means that virtual events are not
+				 * allowed in the sequence.  Non-zero
+				 * otherwise. */
+    unsigned long *maskPtr;	/* *maskPtr is filled in with the event
+				 * types on which this pattern sequence
+				 * depends. */
+{
+
+    Pattern pats[EVENT_BUFFER_SIZE];
+    int numPats, virtualFound;
+    char *p;
+    Pattern *patPtr;
+    PatSeq *psPtr;
+    Tcl_HashEntry *hPtr;
+    int flags, count, new;
+    size_t sequenceSize;
+    unsigned long eventMask;
+    PatternTableKey key;
+
+    /*
+     *-------------------------------------------------------------
+     * Step 1: parse the pattern string to produce an array
+     * of Patterns.  The array is generated backwards, so
+     * that the lowest-indexed pattern corresponds to the last
+     * event that must occur.
+     *-------------------------------------------------------------
+     */
+
+    p = eventString;
+    flags = 0;
+    eventMask = 0;
+    virtualFound = 0;
+
+    patPtr = &pats[EVENT_BUFFER_SIZE-1];
+    for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
+	while (isspace(UCHAR(*p))) {
+	    p++;
+	}
+	if (*p == '\0') {
+	    break;
+	}
+
+	count = ParseEventDescription(interp, &p, patPtr, &eventMask);
+	if (count == 0) {
+	    return NULL;
+	}
+
+	if (eventMask & VirtualEventMask) {
+	    if (allowVirtual == 0) {
+		interp->result =
+			"virtual event not allowed in definition of another virtual event";
+		return NULL;
+	    }
+	    virtualFound = 1;
+	}
+
+	/*
+	 * Replicate events for DOUBLE and TRIPLE.
+	 */
+
+	if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+	    flags |= PAT_NEARBY;
+	    patPtr[-1] = patPtr[0];
+	    patPtr--;
+	    numPats++;
+	    if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
+		patPtr[-1] = patPtr[0];
+		patPtr--;
+		numPats++;
+	    }
+	}
+    }
+
+    /*
+     *-------------------------------------------------------------
+     * Step 2: find the sequence in the binding table if it exists,
+     * and add a new sequence to the table if it doesn't.
+     *-------------------------------------------------------------
+     */
+
+    if (numPats == 0) {
+	interp->result = "no events specified in binding";
+	return NULL;
+    }
+    if ((numPats > 1) && (virtualFound != 0)) {
+        interp->result = "virtual events may not be composed";
+	return NULL;
+    }
+    
+    patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
+    memset(&key, 0, sizeof(key));
+    key.object = object;
+    key.type = patPtr->eventType;
+    key.detail = patPtr->detail;
+    hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &new);
+    sequenceSize = numPats*sizeof(Pattern);
+    if (!new) {
+	for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+		psPtr = psPtr->nextSeqPtr) {
+	    if ((numPats == psPtr->numPats)
+		    && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
+		    && (memcmp((char *) patPtr, (char *) psPtr->pats,
+		    sequenceSize) == 0)) {
+		goto done;
+	    }
+	}
+    }
+    if (!create) {
+	if (new) {
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+	return NULL;
+    }
+    psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
+	    + (numPats-1)*sizeof(Pattern)));
+    psPtr->numPats = numPats;
+    psPtr->eventProc = NULL;
+    psPtr->freeProc = NULL;
+    psPtr->clientData = NULL;
+    psPtr->flags = flags;
+    psPtr->refCount = 0;
+    psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+    psPtr->hPtr = hPtr;
+    psPtr->voPtr = NULL;
+    psPtr->nextObjPtr = NULL;
+    Tcl_SetHashValue(hPtr, psPtr);
+
+    memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
+
+    done:
+    *maskPtr = eventMask;
+    return psPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseEventDescription --
+ *
+ *	Fill Pattern buffer with information about event from
+ *	event string.
+ *
+ * Results:
+ *	Leaves error message in interp and returns 0 if there was an
+ *	error due to a badly formed event string.  Returns 1 if proper
+ *	event was specified, 2 if Double modifier was used in event
+ *	string, or 3 if Triple was used.
+ *
+ * Side effects:
+ *	On exit, eventStringPtr points to rest of event string (after the
+ *	closing '>', so that this procedure can be called repeatedly to
+ *	parse all the events in the entire sequence.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseEventDescription(interp, eventStringPtr, patPtr,
+	eventMaskPtr)
+    Tcl_Interp *interp;		/* For error messages. */
+    char **eventStringPtr;	/* On input, holds a pointer to start of
+				 * event string.  On exit, gets pointer to
+				 * rest of string after parsed event. */
+    Pattern *patPtr;		/* Filled with the pattern parsed from the
+				 * event string. */
+    unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */
+				 
+{
+    char *p;
+    unsigned long eventMask;
+    int count, eventFlags;
+#define FIELD_SIZE 48
+    char field[FIELD_SIZE];
+    Tcl_HashEntry *hPtr;
+
+    p = *eventStringPtr;
+
+    patPtr->eventType = -1;
+    patPtr->needMods = 0;
+    patPtr->detail.clientData = 0;
+
+    eventMask = 0;
+    count = 1;
+    
+    /*
+     * Handle simple ASCII characters.
+     */
+
+    if (*p != '<') {
+	char string[2];
+
+	patPtr->eventType = KeyPress;
+	eventMask = KeyPressMask;
+	string[0] = *p;
+	string[1] = 0;
+	patPtr->detail.keySym = TkStringToKeysym(string);
+	if (patPtr->detail.keySym == NoSymbol) {
+	    if (isprint(UCHAR(*p))) {
+		patPtr->detail.keySym = *p;
+	    } else {
+		sprintf(interp->result,
+			"bad ASCII character 0x%x", (unsigned char) *p);
+		return 0;
+	    }
+	}
+	p++;
+	goto end;
+    }
+
+    /*
+     * A fancier event description.  This can be either a virtual event
+     * or a physical event.
+     *
+     * A virtual event description consists of:
+     *
+     * 1. double open angle brackets.
+     * 2. virtual event name.
+     * 3. double close angle brackets.
+     *
+     * A physical event description consists of:
+     *
+     * 1. open angle bracket.
+     * 2. any number of modifiers, each followed by spaces
+     *    or dashes.
+     * 3. an optional event name.
+     * 4. an option button or keysym name.  Either this or
+     *    item 3 *must* be present;  if both are present
+     *    then they are separated by spaces or dashes.
+     * 5. a close angle bracket.
+     */
+
+    p++;
+    if (*p == '<') {
+	/*
+	 * This is a virtual event: soak up all the characters up to
+	 * the next '>'.
+	 */
+
+	char *field = p + 1;	    
+	p = strchr(field, '>');
+	if (p == field) {
+	    interp->result = "virtual event \"<<>>\" is badly formed";
+	    return 0;
+	}	    
+	if ((p == NULL) || (p[1] != '>')) {
+	    interp->result = "missing \">\" in virtual binding";
+	    return 0;
+	}
+	*p = '\0';
+	patPtr->eventType = VirtualEvent;
+	eventMask = VirtualEventMask;
+	patPtr->detail.name = Tk_GetUid(field);
+	*p = '>';
+
+	p += 2;
+	goto end;
+    }
+
+    while (1) {
+	ModInfo *modPtr;
+	p = GetField(p, field, FIELD_SIZE);
+	if (*p == '>') {
+	    /*
+	     * This solves the problem of, e.g., <Control-M> being
+	     * misinterpreted as Control + Meta + missing keysym
+	     * instead of Control + KeyPress + M.
+	     */
+	     break;
+	}
+	hPtr = Tcl_FindHashEntry(&modTable, field);
+	if (hPtr == NULL) {
+	    break;
+	}
+	modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
+	patPtr->needMods |= modPtr->mask;
+	if (modPtr->flags & (DOUBLE|TRIPLE)) {
+	    if (modPtr->flags & DOUBLE) {
+		count = 2;
+	    } else {
+		count = 3;
+	    }
+	}
+	while ((*p == '-') || isspace(UCHAR(*p))) {
+	    p++;
+	}
+    }
+
+    eventFlags = 0;
+    hPtr = Tcl_FindHashEntry(&eventTable, field);
+    if (hPtr != NULL) {
+	EventInfo *eiPtr;
+	eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
+
+	patPtr->eventType = eiPtr->type;
+	eventFlags = flagArray[eiPtr->type];
+	eventMask = eiPtr->eventMask;
+	while ((*p == '-') || isspace(UCHAR(*p))) {
+	    p++;
+	}
+	p = GetField(p, field, FIELD_SIZE);
+    }
+    if (*field != '\0') {
+	if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
+	    if (eventFlags == 0) {
+		patPtr->eventType = ButtonPress;
+		eventMask = ButtonPressMask;
+	    } else if (eventFlags & KEY) {
+		goto getKeysym;
+	    } else if ((eventFlags & BUTTON) == 0) {
+		Tcl_AppendResult(interp, "specified button \"", field,
+			"\" for non-button event", (char *) NULL);
+		return 0;
+	    }
+	    patPtr->detail.button = (*field - '0');
+	} else {
+	    getKeysym:
+	    patPtr->detail.keySym = TkStringToKeysym(field);
+	    if (patPtr->detail.keySym == NoSymbol) {
+		Tcl_AppendResult(interp, "bad event type or keysym \"",
+			field, "\"", (char *) NULL);
+		return 0;
+	    }
+	    if (eventFlags == 0) {
+		patPtr->eventType = KeyPress;
+		eventMask = KeyPressMask;
+	    } else if ((eventFlags & KEY) == 0) {
+		Tcl_AppendResult(interp, "specified keysym \"", field,
+			"\" for non-key event", (char *) NULL);
+		return 0;
+	    }
+	}
+    } else if (eventFlags == 0) {
+	interp->result = "no event type or button # or keysym";
+	return 0;
+    }
+
+    while ((*p == '-') || isspace(UCHAR(*p))) {
+	p++;
+    }
+    if (*p != '>') {
+	while (*p != '\0') {
+	    p++;
+	    if (*p == '>') {
+		interp->result = "extra characters after detail in binding";
+		return 0;
+	    }
+	}
+	interp->result = "missing \">\" in binding";
+	return 0;
+    }
+    p++;
+
+end:
+    *eventStringPtr = p;
+    *eventMaskPtr |= eventMask;
+    return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetField --
+ *
+ *	Used to parse pattern descriptions.  Copies up to
+ *	size characters from p to copy, stopping at end of
+ *	string, space, "-", ">", or whenever size is
+ *	exceeded.
+ *
+ * Results:
+ *	The return value is a pointer to the character just
+ *	after the last one copied (usually "-" or space or
+ *	">", but could be anything if size was exceeded).
+ *	Also places NULL-terminated string (up to size
+ *	character, including NULL), at copy.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetField(p, copy, size)
+    char *p;		/* Pointer to part of pattern. */
+    char *copy;	/* Place to copy field. */
+    int size;			/* Maximum number of characters to
+				 * copy. */
+{
+    while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
+	    && (*p != '-') && (size > 1)) {
+	*copy = *p;
+	p++;
+	copy++;
+	size--;
+    }
+    *copy = '\0';
+    return p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetPatternString --
+ *
+ *	Produce a string version of the given event, for displaying to
+ *	the user.  
+ *
+ * Results:
+ *	The string is left in dsPtr.
+ *
+ * Side effects:
+ *	It is the caller's responsibility to initialize the DString before
+ *	and to free it after calling this procedure.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void
+GetPatternString(psPtr, dsPtr)
+    PatSeq *psPtr;
+    Tcl_DString *dsPtr;
+{
+    Pattern *patPtr;
+    char c, buffer[10];
+    int patsLeft, needMods;
+    ModInfo *modPtr;
+    EventInfo *eiPtr;
+
+    /*
+     * The order of the patterns in the sequence is backwards from the order
+     * in which they must be output.
+     */
+
+    for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
+	    patsLeft > 0; patsLeft--, patPtr--) {
+
+	/*
+	 * Check for simple case of an ASCII character.
+	 */
+
+	if ((patPtr->eventType == KeyPress)
+		&& ((psPtr->flags & PAT_NEARBY) == 0) 
+		&& (patPtr->needMods == 0)
+		&& (patPtr->detail.keySym < 128)
+		&& isprint(UCHAR(patPtr->detail.keySym))
+		&& (patPtr->detail.keySym != '<')
+		&& (patPtr->detail.keySym != ' ')) {
+
+	    c = (char) patPtr->detail.keySym;
+	    Tcl_DStringAppend(dsPtr, &c, 1);
+	    continue;
+	}
+
+	/*
+	 * Check for virtual event.
+	 */
+
+	if (patPtr->eventType == VirtualEvent) {
+	    Tcl_DStringAppend(dsPtr, "<<", 2);
+	    Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
+	    Tcl_DStringAppend(dsPtr, ">>", 2);
+	    continue;
+	}
+
+	/*
+	 * It's a more general event specification.  First check
+	 * for "Double" or "Triple", then modifiers, then event type,
+	 * then keysym or button detail.
+	 */
+
+	Tcl_DStringAppend(dsPtr, "<", 1);
+	if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
+		&& (memcmp((char *) patPtr, (char *) (patPtr-1),
+			sizeof(Pattern)) == 0)) {
+	    patsLeft--;
+	    patPtr--;
+	    if ((patsLeft > 1) && (memcmp((char *) patPtr,
+		    (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
+		patsLeft--;
+		patPtr--;
+		Tcl_DStringAppend(dsPtr, "Triple-", 7);
+	    } else {
+		Tcl_DStringAppend(dsPtr, "Double-", 7);
+	    }
+	}
+	for (needMods = patPtr->needMods, modPtr = modArray;
+		needMods != 0; modPtr++) {
+	    if (modPtr->mask & needMods) {
+		needMods &= ~modPtr->mask;
+		Tcl_DStringAppend(dsPtr, modPtr->name, -1);
+		Tcl_DStringAppend(dsPtr, "-", 1);
+	    }
+	}
+	for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+	    if (eiPtr->type == patPtr->eventType) {
+		Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
+		if (patPtr->detail.clientData != 0) {
+		    Tcl_DStringAppend(dsPtr, "-", 1);
+		}
+		break;
+	    }
+	}
+
+	if (patPtr->detail.clientData != 0) {
+	    if ((patPtr->eventType == KeyPress)
+		    || (patPtr->eventType == KeyRelease)) {
+		char *string;
+
+		string = TkKeysymToString(patPtr->detail.keySym);
+		if (string != NULL) {
+		    Tcl_DStringAppend(dsPtr, string, -1);
+		}
+	    } else {
+		sprintf(buffer, "%d", patPtr->detail.button);
+		Tcl_DStringAppend(dsPtr, buffer, -1);
+	    }
+	}
+	Tcl_DStringAppend(dsPtr, ">", 1);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetKeySym --
+ *
+ *	Given an X KeyPress or KeyRelease event, map the
+ *	keycode in the event into a KeySym.
+ *
+ * Results:
+ *	The return value is the KeySym corresponding to
+ *	eventPtr, or NoSymbol if no matching Keysym could be
+ *	found.
+ *
+ * Side effects:
+ *	In the first call for a given display, keycode-to-
+ *	KeySym maps get loaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static KeySym
+GetKeySym(dispPtr, eventPtr)
+    TkDisplay *dispPtr;	/* Display in which to
+					 * map keycode. */
+    XEvent *eventPtr;		/* Description of X event. */
+{
+    KeySym sym;
+    int index;
+
+    /*
+     * Refresh the mapping information if it's stale
+     */
+
+    if (dispPtr->bindInfoStale) {
+	InitKeymapInfo(dispPtr);
+    }
+
+    /*
+     * Figure out which of the four slots in the keymap vector to
+     * use for this key.  Refer to Xlib documentation for more info
+     * on how this computation works.
+     */
+
+    index = 0;
+    if (eventPtr->xkey.state & dispPtr->modeModMask) {
+	index = 2;
+    }
+    if ((eventPtr->xkey.state & ShiftMask)
+	    || ((dispPtr->lockUsage != LU_IGNORE)
+	    && (eventPtr->xkey.state & LockMask))) {
+	index += 1;
+    }
+    sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
+
+    /*
+     * Special handling:  if the key was shifted because of Lock, but
+     * lock is only caps lock, not shift lock, and the shifted keysym
+     * isn't upper-case alphabetic, then switch back to the unshifted
+     * keysym.
+     */
+
+    if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
+	    && (dispPtr->lockUsage == LU_CAPS)) {
+	if (!(((sym >= XK_A) && (sym <= XK_Z))
+		|| ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
+		|| ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
+	    index &= ~1;
+	    sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+		    index);
+	}
+    }
+
+    /*
+     * Another bit of special handling:  if this is a shifted key and there
+     * is no keysym defined, then use the keysym for the unshifted key.
+     */
+
+    if ((index & 1) && (sym == NoSymbol)) {
+	sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+		    index & ~1);
+    }
+    return sym;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitKeymapInfo --
+ *
+ *	This procedure is invoked to scan keymap information
+ *	to recompute stuff that's important for binding, such
+ *	as the modifier key (if any) that corresponds to "mode
+ *	switch".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Keymap-related information in dispPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitKeymapInfo(dispPtr)
+    TkDisplay *dispPtr;		/* Display for which to recompute keymap
+				 * information. */
+{
+    XModifierKeymap *modMapPtr;
+    KeyCode *codePtr;
+    KeySym keysym;
+    int count, i, j, max, arraySize;
+#define KEYCODE_ARRAY_SIZE 20
+
+    dispPtr->bindInfoStale = 0;
+    modMapPtr = XGetModifierMapping(dispPtr->display);
+
+    /*
+     * Check the keycodes associated with the Lock modifier.  If
+     * any of them is associated with the XK_Shift_Lock modifier,
+     * then Lock has to be interpreted as Shift Lock, not Caps Lock.
+     */
+
+    dispPtr->lockUsage = LU_IGNORE;
+    codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
+    for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
+	if (*codePtr == 0) {
+	    continue;
+	}
+	keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+	if (keysym == XK_Shift_Lock) {
+	    dispPtr->lockUsage = LU_SHIFT;
+	    break;
+	}
+	if (keysym == XK_Caps_Lock) {
+	    dispPtr->lockUsage = LU_CAPS;
+	    break;
+	}
+    }
+
+    /*
+     * Look through the keycodes associated with modifiers to see if
+     * the the "mode switch", "meta", or "alt" keysyms are associated
+     * with any modifiers.  If so, remember their modifier mask bits.
+     */
+
+    dispPtr->modeModMask = 0;
+    dispPtr->metaModMask = 0;
+    dispPtr->altModMask = 0;
+    codePtr = modMapPtr->modifiermap;
+    max = 8*modMapPtr->max_keypermod;
+    for (i = 0; i < max; i++, codePtr++) {
+	if (*codePtr == 0) {
+	    continue;
+	}
+	keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+	if (keysym == XK_Mode_switch) {
+	    dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+	}
+	if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
+	    dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+	}
+	if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
+	    dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+	}
+    }
+
+    /*
+     * Create an array of the keycodes for all modifier keys.
+     */
+
+    if (dispPtr->modKeyCodes != NULL) {
+	ckfree((char *) dispPtr->modKeyCodes);
+    }
+    dispPtr->numModKeyCodes = 0;
+    arraySize = KEYCODE_ARRAY_SIZE;
+    dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
+	    (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
+    for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
+	if (*codePtr == 0) {
+	    continue;
+	}
+
+	/*
+	 * Make sure that the keycode isn't already in the array.
+	 */
+
+	for (j = 0; j < dispPtr->numModKeyCodes; j++) {
+	    if (dispPtr->modKeyCodes[j] == *codePtr) {
+		goto nextModCode;
+	    }
+	}
+	if (dispPtr->numModKeyCodes >= arraySize) {
+	    KeyCode *new;
+
+	    /*
+	     * Ran out of space in the array;  grow it.
+	     */
+
+	    arraySize *= 2;
+	    new = (KeyCode *) ckalloc((unsigned)
+		    (arraySize * sizeof(KeyCode)));
+	    memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
+		    (dispPtr->numModKeyCodes * sizeof(KeyCode)));
+	    ckfree((char *) dispPtr->modKeyCodes);
+	    dispPtr->modKeyCodes = new;
+	}
+	dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
+	dispPtr->numModKeyCodes++;
+	nextModCode: continue;
+    }
+    XFreeModifiermap(modMapPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EvalTclBinding --
+ *
+ *	The procedure that is invoked by Tk_BindEvent when a Tcl binding
+ *	is fired.  
+ *
+ * Results:
+ *	A standard Tcl result code, the result of globally evaluating the
+ *	percent-substitued binding string.
+ *
+ * Side effects:
+ *	Normal side effects due to eval.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeTclBinding(clientData)
+    ClientData clientData;
+{
+    ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkStringToKeysym --
+ *
+ *	This procedure finds the keysym associated with a given keysym
+ *	name.
+ *
+ * Results:
+ *	The return value is the keysym that corresponds to name, or
+ *	NoSymbol if there is no such keysym.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkStringToKeysym(name)
+    char *name;			/* Name of a keysym. */
+{
+#ifdef REDO_KEYSYM_LOOKUP
+    Tcl_HashEntry *hPtr;
+    KeySym keysym;
+
+    hPtr = Tcl_FindHashEntry(&keySymTable, name);
+    if (hPtr != NULL) {
+	return (KeySym) Tcl_GetHashValue(hPtr);
+    }
+    if (strlen(name) == 1) {
+	keysym = (KeySym) (unsigned char) name[0];
+	if (TkKeysymToString(keysym) != NULL) {
+	    return keysym;
+	}
+    }
+#endif /* REDO_KEYSYM_LOOKUP */
+    return XStringToKeysym(name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkKeysymToString --
+ *
+ *	This procedure finds the keysym name associated with a given
+ *	keysym.
+ *
+ * Results:
+ *	The return value is a pointer to a static string containing
+ *	the name of the given keysym, or NULL if there is no known name.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkKeysymToString(keysym)
+    KeySym keysym;
+{
+#ifdef REDO_KEYSYM_LOOKUP
+    Tcl_HashEntry *hPtr;
+
+    hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
+    if (hPtr != NULL) {
+	return (char *) Tcl_GetHashValue(hPtr);
+    }
+#endif /* REDO_KEYSYM_LOOKUP */
+    return XKeysymToString(keysym);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCopyAndGlobalEval --
+ *
+ *	This procedure makes a copy of a script then calls Tcl_GlobalEval
+ *	to evaluate it.  It's used in situations where the execution of
+ *	a command may cause the original command string to be reallocated.
+ *
+ * Results:
+ *	Returns the result of evaluating script, including both a standard
+ *	Tcl completion code and a string in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkCopyAndGlobalEval(interp, script)
+    Tcl_Interp *interp;			/* Interpreter in which to evaluate
+					 * script. */
+    char *script;			/* Script to evaluate. */
+{
+    Tcl_DString buffer;
+    int code;
+
+    Tcl_DStringInit(&buffer);
+    Tcl_DStringAppend(&buffer, script, -1);
+    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer));
+    Tcl_DStringFree(&buffer);
+    return code;
+}
+
+