/* 
 * 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-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 *  RCS: @(#) Id
 */

#include "tkPort.h"
#include "tkInt.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* UNIX */
#include "tkUnixInt.h"
#endif


/*
 * 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 tk::Priv 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. */
    int deleted;    /* 1 the application has been deleted but
         * the structure has been preserved. */
} 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;
TCL_DECLARE_MUTEX(bindMutex)

/*
 * 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.
 * QUADRUPLE -    Non-zero means quadruple this event,
 *      e.g. for 4-fold-clicks.
 * MULT_CLICKS -  Combination of all of above.
 */

#define DOUBLE    1
#define TRIPLE    2
#define QUADRUPLE  4
#define MULT_CLICKS  7

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},
    {"Quadruple",  0,    QUADRUPLE},
    {"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},
    {"MouseWheel",  MouseWheelEvent,  MouseWheelMask},
    {"CirculateRequest", CirculateRequest,  SubstructureRedirectMask},
    {"ConfigureRequest", ConfigureRequest,  SubstructureRedirectMask},
    {"Create",    CreateNotify,    SubstructureNotifyMask},
    {"MapRequest",  MapRequest,             SubstructureRedirectMask},
    {"ResizeRequest",  ResizeRequest,    ResizeRedirectMask},
    {(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  MAPREQ      0x80000
#define  CONFIGREQ    0x100000
#define  RESIZEREQ    0x200000
#define CIRCREQ      0x400000

#define KEY_BUTTON_MOTION_VIRTUAL  (KEY|BUTTON|MOTION|VIRTUAL)
#define KEY_BUTTON_MOTION_CROSSING  (KEY|BUTTON|MOTION|CROSSING|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 */    MAPREQ,
   /* ReparentNotify */    REPARENT,
   /* ConfigureNotify */  CONFIG,
   /* ConfigureRequest */  CONFIGREQ,
   /* GravityNotify */    GRAVITY,
   /* ResizeRequest */    RESIZEREQ,
   /* CirculateNotify */  CIRC,
   /* CirculateRequest */  0,
   /* PropertyNotify */    PROP,
   /* SelectionClear */    0,
   /* SelectionRequest */  0,
   /* SelectionNotify */  0,
   /* ColormapNotify */    COLORMAP,
   /* ClientMessage */    0,
   /* MappingNotify */    0,
   /* VirtualEvent */    VIRTUAL,
   /* Activate */    ACTIVATE,      
   /* Deactivate */    ACTIVATE,
   /* MouseWheel */    KEY
};

/*
 * The following table is used to map between the location where an
 * generated event should be queued and the string used to specify the
 * location.
 */
 
static TkStateMap queuePosition[] = {
    {-1,      "now"},
    {TCL_QUEUE_HEAD,    "head"},
    {TCL_QUEUE_MARK,    "mark"},
    {TCL_QUEUE_TAIL,    "tail"},
    {-2,      NULL}
};

/*
 * 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}
};

static TkStateMap configureRequestDetail[] = {
    {None,    "None"},
    {Above,    "Above"},
    {Below,    "Below"},
    {BottomIf,    "BottomIf"},
    {TopIf,    "TopIf"},
    {Opposite,    "Opposite"},
    {-1, NULL}
};

static TkStateMap propNotify[] = {
    {PropertyNewValue,  "NewValue"},
    {PropertyDelete,  "Delete"},
    {-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,
          CONST 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,
          CONST 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 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 objc,
          Tcl_Obj *CONST objv[]));
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    NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
          Tk_Window main, Tcl_Obj *objPtr,
          Tk_Window *tkwinPtr));
static int    ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
          CONST char **eventStringPtr, Pattern *patPtr,
          unsigned long *eventMaskPtr));
static void    DoWarp _ANSI_ARGS_((ClientData clientData));

/*
 * 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_MutexLock(&bindMutex);
  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;
  }
        Tcl_MutexUnlock(&bindMutex);
    }

    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;
    bindInfoPtr->deleted = 0;
    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);
    bindInfoPtr->deleted = 1;
    Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC);
    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_CreateBinding.
 *
 * 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 the interp's 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. */
    CONST char *eventString;  /* String describing event sequence that
         * triggers binding. */
    CONST 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 the interp's 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. */
    CONST 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 the interp's 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. */
    CONST 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
 *  the interp's result.  The return value is semi-static:  it
 *  will persist until the binding is changed or deleted.
 *
 * Side effects:
 *  None.
 *
 *--------------------------------------------------------------
 */

CONST 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. */
    CONST 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 (CONST 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.  The interp's 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;
    ScreenInfo *screenPtr;
    BindInfo *bindInfoPtr;
    TkDisplay *oldDispPtr;
    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;
    Tk_ClassModalProc *modalProc;
    /*
     * 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 = TkpGetKeySym(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 the interp's 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) {
  /*
   * Remember the list of pending C binding callbacks, so we can mark
   * them as deleted and not call them if the act of evaluating a C
   * or Tcl binding deletes a C binding callback or even the whole
   * window.
   */

  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;

    /*
     * Be carefule when dereferencing screenPtr or bindInfoPtr.  If we
     * evaluate something that destroys ".", bindInfoPtr would have been
     * freed, but we can tell that by first checking to see if
     * winPtr->mainPtr == NULL.
     */

    Tcl_Preserve((ClientData) bindInfoPtr);
    while (p < end) {
  int code;
  
  if (!bindInfoPtr->deleted) {
      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 {
      int len = (int) strlen(p);
      code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
      p += len;
  }
  p++;

  if (!bindInfoPtr->deleted) {
      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) {
      modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc);
      if (modalProc != NULL) {
    (*modalProc)(tkwin, eventPtr);
      }
  }
    }

    if (!bindInfoPtr->deleted && (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) {
  if (!bindInfoPtr->deleted) {
      /*
       * Delete the pending list from the list of pending scripts
       * for this window.
       */
       
      PendingBinding **curPtrPtr;

      for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
    if (*curPtrPtr == pendingPtr) {
        *curPtrPtr = pendingPtr->nextPtr;
        break;
    }
    curPtrPtr = &(*curPtrPtr)->nextPtr;
      }
  }
  if (pendingPtr != &staticPending) {
      ckfree((char *) pendingPtr);
  }
    }
    Tcl_Release((ClientData) bindInfoPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * 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;

    /*
     * Certain special windows like those used for send and clipboard
     * have no mainPtr.
     */
    if (winPtr->mainPtr == NULL)
        return;

    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.type == CreateNotify
    && eventPtr->xcreatewindow.parent != window) {
    goto nextSequence;
      } else 
      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 & META_MASK) && (dispPtr->metaModMask != 0)) {
        state = (state & ~META_MASK) | dispPtr->metaModMask;
    }
    if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) {
        state = (state & ~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. */
    CONST 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
    CONST char *string;
    Tcl_DString buf;
    char numStorage[NUM_SIZE+1];

    Tcl_DStringInit(&buf);

    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, (int) (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':
    if (flags & CONFIG) {
        TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
        string = numStorage;
    }
    goto doString;
      case 'b':
    if (flags & BUTTON) {
        number = eventPtr->xbutton.button;
        goto doNumber;
    }
    goto doString;
      case 'c':
    if (flags & EXPOSE) {
        number = eventPtr->xexpose.count;
        goto doNumber;
    }
    goto doString;
      case 'd':
    if (flags & (CROSSING|FOCUS)) {
        if (flags & FOCUS) {
      number = eventPtr->xfocus.detail;
        } else {
      number = eventPtr->xcrossing.detail;
        }
        string = TkFindStateString(notifyDetail, number);
    } else if (flags & CONFIGREQ) {
        if (eventPtr->xconfigurerequest.value_mask & CWStackMode) {
      string = TkFindStateString(configureRequestDetail,
          eventPtr->xconfigurerequest.detail);
        } else {
      string = "";
        }
    }
    goto doString;
      case 'f':
    if (flags & CROSSING) {
        number = eventPtr->xcrossing.focus;
        goto doNumber;
    }
    goto doString;
      case 'h':
    if (flags & EXPOSE) {
        number = eventPtr->xexpose.height;
    } else if (flags & (CONFIG)) {
        number = eventPtr->xconfigure.height;
    } else if (flags & CREATE) {
        number = eventPtr->xcreatewindow.height;
    } else if (flags & CONFIGREQ) {
        number =  eventPtr->xconfigurerequest.height;
    } else if (flags & RESIZEREQ) {
        number =  eventPtr->xresizerequest.height;
    } else {
        goto doString;
    }
    goto doNumber;
      case 'i':
    if (flags & CREATE) {
        TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window);
    } else if (flags & CONFIGREQ) {
        TkpPrintWindowId(numStorage, eventPtr->xconfigurerequest.window);
    } else if (flags & MAPREQ) {
        TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window);
    } else {
        TkpPrintWindowId(numStorage, eventPtr->xany.window);
    }
    string = numStorage;
    goto doString;
      case 'k':
    if (flags & KEY) {
        number = eventPtr->xkey.keycode;
        goto doNumber;
    }
    goto doString;
      case 'm':
    if (flags & CROSSING) {
        number = eventPtr->xcrossing.mode;
        string = TkFindStateString(notifyMode, number);
    } 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;
    } else {
        goto doString;
    }
    goto doNumber;
      case 'p':
    if (flags & CIRC) {
        string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
    } else if (flags & CIRCREQ) {
        string = TkFindStateString(circPlace, eventPtr->xcirculaterequest.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 & PROP) {
        string = TkFindStateString(propNotify,
          eventPtr->xproperty.state);
        goto doString;
    } else if (flags & VISIBILITY) {
        string = TkFindStateString(visNotify,
          eventPtr->xvisibility.state);
        goto doString;
    } else {
        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;
    } else {
        goto doString;
    }
    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;
    } else if (flags & CREATE) {
        number = eventPtr->xcreatewindow.width;
    } else if (flags & CONFIGREQ) {
        number =  eventPtr->xconfigurerequest.width;
    } else if (flags & RESIZEREQ) {
        number =  eventPtr->xresizerequest.width;
    } else {
        goto doString;
    }
    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;
    } else if (flags & CREATE) {
        number = eventPtr->xcreatewindow.x;
    } else if (flags & CONFIGREQ) {
        number =  eventPtr->xconfigurerequest.x;
    } else {
        goto doString;
    }
    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;
    } else if (flags & CREATE) {
        number = eventPtr->xcreatewindow.y;
    } else if (flags & CONFIGREQ) {
        number = eventPtr->xconfigurerequest.y;
    } else {
        goto doString;
    }
    goto doNumber;
      case 'A':
    if (flags & KEY) {
        Tcl_DStringFree(&buf);
        string = TkpGetString(winPtr, eventPtr, &buf);
    }
    goto doString;
      case 'B':
    if (flags & CREATE) {
        number = eventPtr->xcreatewindow.border_width;
    } else if (flags & CONFIGREQ) {
        number = eventPtr->xconfigurerequest.border_width;
    } else if (flags & CONFIG) {
        number = eventPtr->xconfigure.border_width;
    } else {
        goto doString;
    }
    goto doNumber;
      case 'D':
    /*
     * This is used only by the MouseWheel event.
     */
    if (flags & KEY) {
        number = eventPtr->xkey.keycode;
        goto doNumber;
    }
    goto doString;
      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':
    if (flags & KEY) {
        number = (int) keySym;
        goto doNumber;
    }
    goto doString;
      case 'P':
    if (flags & PROP) {
        string = Tk_GetAtomName((Tk_Window) winPtr, eventPtr->xproperty.atom);
    }
    goto doString;
      case 'R':
    if (flags & KEY_BUTTON_MOTION_CROSSING) {
        TkpPrintWindowId(numStorage, eventPtr->xkey.root);
        string = numStorage;
    }
    goto doString;
            case 'S':
    if (flags & KEY_BUTTON_MOTION_CROSSING) {
        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':
    if (flags & KEY_BUTTON_MOTION_CROSSING) {
        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;
    }
    goto doString;
      case 'Y':
    if (flags & KEY_BUTTON_MOTION_CROSSING) {
        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;
    }
    goto doString;
      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;
    }
    Tcl_DStringFree(&buf);
}

/*
 *----------------------------------------------------------------------
 *
 * ChangeScreen --
 *
 *  This procedure is invoked whenever the current screen changes
 *  in an application.  It invokes a Tcl procedure named
 *  "tk::ScreenChanged", passing it the screen name as argument.
 *  tk::ScreenChanged does things like making the tk::Priv variable
 *  point to an array for the current display.
 *
 * Results:
 *  None.
 *
 * Side effects:
 *  Depends on what tk::ScreenChanged does.  If an error occurs
 *  them bgerror 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[TCL_INTEGER_SPACE];

    Tcl_DStringInit(&cmd);
    Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18);
    Tcl_DStringAppend(&cmd, dispName, -1);
    sprintf(screen, ".%d", screenIndex);
    Tcl_DStringAppend(&cmd, screen, -1);
    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd),
      TCL_EVAL_GLOBAL);
    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_EventObjCmd(clientData, interp, objc, objv)
    ClientData clientData;  /* Main window associated with interpreter. */
    Tcl_Interp *interp;    /* Current interpreter. */
    int objc;      /* Number of arguments. */
    Tcl_Obj *CONST objv[];  /* Argument objects. */
{
    int index;
    Tk_Window tkwin;
    VirtualEventTable *vetPtr;
    TkBindInfo bindInfo;
    static CONST char *optionStrings[] = {
  "add",    "delete",  "generate",  "info",
  NULL
    };
    enum options {
  EVENT_ADD,  EVENT_DELETE,  EVENT_GENERATE,  EVENT_INFO
    };

    tkwin = (Tk_Window) clientData;
    bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
    vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;

    if (objc < 2) {
  Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
  return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
      &index) != TCL_OK) {
  return TCL_ERROR;
    }

    switch ((enum options) index) {
  case EVENT_ADD: {
      int i;
      char *name, *event;
      
      if (objc < 4) {
    Tcl_WrongNumArgs(interp, 2, objv,
      "virtual sequence ?sequence ...?");
    return TCL_ERROR;
      }
      name = Tcl_GetStringFromObj(objv[2], NULL);
      for (i = 3; i < objc; i++) {
    event = Tcl_GetStringFromObj(objv[i], NULL);
    if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
        return TCL_ERROR;
    }
      }
      break;
  }
  case EVENT_DELETE: {
      int i;
      char *name, *event;
      
      if (objc < 3) {
    Tcl_WrongNumArgs(interp, 2, objv,
      "virtual ?sequence sequence ...?");
    return TCL_ERROR;
      }
      name = Tcl_GetStringFromObj(objv[2], NULL);
      if (objc == 3) {
    return DeleteVirtualEvent(interp, vetPtr, name, NULL);
      }
      for (i = 3; i < objc; i++) {
    event = Tcl_GetStringFromObj(objv[i], NULL);
    if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
        return TCL_ERROR;
    }
      }
      break;
  }
  case EVENT_GENERATE: {
      if (objc < 4) {
    Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
    return TCL_ERROR;
      }
      return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
  }
  case EVENT_INFO: {
      if (objc == 2) {
    GetAllVirtualEvents(interp, vetPtr);
    return TCL_OK;
      } else if (objc == 3) {  
    return GetVirtualEvent(interp, vetPtr,
      Tcl_GetStringFromObj(objv[2], NULL));
      } else {
    Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
    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 the interp's 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 the interp's 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) {
      CONST char *string;

      string = Tcl_GetStringResult(interp); 
      return (string[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("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 the interp's 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, the interp's 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 the interp's 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.  The interp's 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, mainWin, objc, objv)
    Tcl_Interp *interp;    /* Interp for errors return and name lookup. */
    Tk_Window mainWin;    /* Main window associated with interp. */
    int objc;      /* Number of arguments. */
    Tcl_Obj *CONST objv[];  /* Argument objects. */
{
    XEvent event;    
    CONST char *p;
    char *name, *windowName;
    int count, flags, synch, i, number, warp;
    Tcl_QueuePosition pos;
    Pattern pat;
    Tk_Window tkwin, tkwin2;
    TkWindow *mainPtr;
    unsigned long eventMask;
    static CONST char *fieldStrings[] = {
  "-when",  "-above",  "-borderwidth",  "-button",
  "-count",  "-delta",  "-detail",  "-focus",
  "-height",
  "-keycode",  "-keysym",  "-mode",  "-override",
  "-place",  "-root",  "-rootx",  "-rooty",
  "-sendevent",  "-serial",  "-state",  "-subwindow",
  "-time",  "-warp",  "-width",  "-window",
  "-x",    "-y",  NULL
    };
    enum field {
  EVENT_WHEN,  EVENT_ABOVE,  EVENT_BORDER,  EVENT_BUTTON,
  EVENT_COUNT,  EVENT_DELTA,  EVENT_DETAIL,  EVENT_FOCUS,
  EVENT_HEIGHT,
  EVENT_KEYCODE,  EVENT_KEYSYM,  EVENT_MODE,  EVENT_OVERRIDE,
  EVENT_PLACE,  EVENT_ROOT,  EVENT_ROOTX,  EVENT_ROOTY,
  EVENT_SEND,  EVENT_SERIAL,  EVENT_STATE,  EVENT_SUBWINDOW,
  EVENT_TIME,  EVENT_WARP,  EVENT_WIDTH,  EVENT_WINDOW,
  EVENT_X,  EVENT_Y
    };

    windowName = Tcl_GetStringFromObj(objv[0], NULL);
    if (!windowName[0]) {
  tkwin = mainWin;
    } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
  return TCL_ERROR;
    }

    mainPtr = (TkWindow *) mainWin;
    if ((tkwin == NULL)
      || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
  char *name;

  name = Tcl_GetStringFromObj(objv[0], NULL);
  Tcl_AppendResult(interp, "window id \"", name,     
    "\" doesn't exist in this application", (char *) NULL);
  return TCL_ERROR;
    }

    name = Tcl_GetStringFromObj(objv[1], NULL);

    p = name;
    eventMask = 0;
    count = ParseEventDescription(interp, &p, &pat, &eventMask);
    if (count == 0) {
  return TCL_ERROR;
    }
    if (count != 1) {
  Tcl_SetResult(interp, "Double or Triple modifier not allowed",
    TCL_STATIC);
  return TCL_ERROR;
    }
    if (*p != '\0') {
  Tcl_SetResult(interp, "only one event specification allowed",
    TCL_STATIC);
  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;
    if (windowName[0]) {
  event.xany.window = Tk_WindowId(tkwin);
    } else {
  event.xany.window = RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
    }
    event.xany.display = Tk_Display(tkwin);

    flags = flagArray[event.xany.type];
    if (flags & DESTROY) {
  /*
   * Event DesotryNotify should be generated by destroying 
   * the window.
   */
  Tk_DestroyWindow(tkwin);
  return TCL_OK;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
  event.xkey.state = pat.needMods;
  if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {
      TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event);
  } else if (flags & BUTTON) {
      event.xbutton.button = pat.detail.button;
  } else if (flags & VIRTUAL) {
      ((XVirtualEvent *) &event)->name = pat.detail.name;
  }
    }
    if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
  event.xcreatewindow.window = event.xany.window;
    }

    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
  event.xkey.x_root = -1;
  event.xkey.y_root = -1;
    }

    /*
     * Process the remaining arguments to fill in additional fields
     * of the event.
     */

    synch = 1;
    warp = 0;
    pos = TCL_QUEUE_TAIL;
    for (i = 2; i < objc; i += 2) {
  Tcl_Obj *optionPtr, *valuePtr;
  int index;
  
  optionPtr = objv[i];
  valuePtr = objv[i + 1];

  if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
    TCL_EXACT, &index) != TCL_OK) {
      return TCL_ERROR;
  }
  if (objc & 1) {
      /*
       * This test occurs after Tcl_GetIndexFromObj() so that
       * "event generate <Button> -xyz" will return the error message
       * that "-xyz" is a bad option, rather than that the value
       * for "-xyz" is missing.
       */

      Tcl_AppendResult(interp, "value for \"",
        Tcl_GetStringFromObj(optionPtr, NULL), "\" missing",
        (char *) NULL);
      return TCL_ERROR;
  }

  switch ((enum field) index) {
      case EVENT_WARP: {
    if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
        return TCL_ERROR;
    }
    if (!(flags & (KEY_BUTTON_MOTION_VIRTUAL))) {
        goto badopt;
    }
    break;
      }
      case EVENT_WHEN: {
    pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr, 
      queuePosition, valuePtr);
    if ((int) pos < -1) {
        return TCL_ERROR;
    }
    synch = 0;
    if ((int) pos == -1) {
        synch = 1;
    }
    break;
      }
      case EVENT_ABOVE: {
    if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & CONFIG) {
        event.xconfigure.above = Tk_WindowId(tkwin2);
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_BORDER: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (CREATE|CONFIG)) {
        event.xcreatewindow.border_width = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_BUTTON: {
    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & BUTTON) {
        event.xbutton.button = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_COUNT: {
    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & EXPOSE) {
        event.xexpose.count = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_DELTA: {
    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
        event.xkey.keycode = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_DETAIL: {
    number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
      valuePtr);
    if (number < 0) {
        return TCL_ERROR;
    }
    if (flags & FOCUS) {
        event.xfocus.detail = number;
    } else if (flags & CROSSING) {
        event.xcrossing.detail = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_FOCUS: {
    if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & CROSSING) {
        event.xcrossing.focus = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_HEIGHT: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & EXPOSE) {
         event.xexpose.height = number;
    } else if (flags & CONFIG) {
        event.xconfigure.height = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_KEYCODE: {
    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
        event.xkey.keycode = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_KEYSYM: {
    KeySym keysym;
    char *value;

    value = Tcl_GetStringFromObj(valuePtr, NULL);
    keysym = TkStringToKeysym(value);
    if (keysym == NoSymbol) {
        Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
          (char *) NULL);
        return TCL_ERROR;
    }

    TkpSetKeycodeAndState(tkwin, keysym, &event);
    if (event.xkey.keycode == 0) {
        Tcl_AppendResult(interp, "no keycode for keysym \"", value,
          "\"", (char *) NULL);
        return TCL_ERROR;
    }
    if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
        goto badopt;
    }
    break;
      }
      case EVENT_MODE: {
    number = TkFindStateNumObj(interp, optionPtr, notifyMode,
      valuePtr);
    if (number < 0) {
        return TCL_ERROR;
    }
    if (flags & CROSSING) {
        event.xcrossing.mode = number;
    } else if (flags & FOCUS) {
        event.xfocus.mode = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_OVERRIDE: {
    if (Tcl_GetBooleanFromObj(interp, valuePtr, &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;
    }
    break;
      }
      case EVENT_PLACE: {
    number = TkFindStateNumObj(interp, optionPtr, circPlace,
      valuePtr);
    if (number < 0) {
        return TCL_ERROR;
    }
    if (flags & CIRC) {
        event.xcirculate.place = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_ROOT: {
    if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
        event.xkey.root = Tk_WindowId(tkwin2);
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_ROOTX: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
        event.xkey.x_root = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_ROOTY: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
        event.xkey.y_root = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_SEND: {
    CONST char *value;

    value = Tcl_GetStringFromObj(valuePtr, NULL);
    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_GetIntFromObj(interp, valuePtr, &number)
          != TCL_OK) {
      return TCL_ERROR;
        }
    } else {
        if (Tcl_GetBooleanFromObj(interp, valuePtr, &number)
          != TCL_OK) {
      return TCL_ERROR;
        }
    }
    event.xany.send_event = number;
    break;
      }
      case EVENT_SERIAL: {
    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
        return TCL_ERROR;
    }
    event.xany.serial = number;
    break;
      }
      case EVENT_STATE: {
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
        if (Tcl_GetIntFromObj(interp, valuePtr, &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 = TkFindStateNumObj(interp, optionPtr, visNotify,
          valuePtr);
        if (number < 0) {
      return TCL_ERROR;
        }
        event.xvisibility.state = number;
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_SUBWINDOW: {
    if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
        event.xkey.subwindow = Tk_WindowId(tkwin2);
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_TIME: {
    if (Tcl_GetIntFromObj(interp, valuePtr, &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;
    }
    break;
      }
      case EVENT_WIDTH: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &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;
    }
    break;
      }
      case EVENT_WINDOW: {
    if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG
      |GRAVITY|CIRC)) {
        event.xcreatewindow.window = Tk_WindowId(tkwin2);
    } else {
        goto badopt;
    }
    break;
      }
      case EVENT_X: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
      != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {  
        event.xkey.x = number;
        /*
         * Only modify rootx as well if it hasn't been changed.
         */
        if (event.xkey.x_root == -1) {
      int rootX, rootY;

      Tk_GetRootCoords(tkwin, &rootX, &rootY);
      event.xkey.x_root = rootX + number;
        }
    } 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;
    }
    break;
      }
      case EVENT_Y: {
    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
      != TCL_OK) {
        return TCL_ERROR;
    }
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
        event.xkey.y = number;
        /*
         * Only modify rooty as well if it hasn't been changed.
         */
        if (event.xkey.y_root == -1) {
      int rootX, rootY;

      Tk_GetRootCoords(tkwin, &rootX, &rootY);
      event.xkey.y_root = rootY + number;
        }
    } 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;
    }
    break;
      }
  }
  continue;
  
  badopt:
  Tcl_AppendResult(interp, name, " event doesn't accept \"",
    Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL);
  return TCL_ERROR;
    }
    if (synch != 0) {
  Tk_HandleEvent(&event);
    } else {
  Tk_QueueWindowEvent(&event, pos);
    }
    /*
     * We only allow warping if the window is mapped
     */
    if ((warp != 0) && Tk_IsMapped(tkwin)) {
  TkDisplay *dispPtr;
  dispPtr = TkGetDisplay(event.xmotion.display);
  if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
      Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr);
      dispPtr->flags |= TK_DISPLAY_IN_WARP;
  }
  dispPtr->warpWindow = event.xany.window;
  dispPtr->warpX = event.xkey.x;
  dispPtr->warpY = event.xkey.y;
    }
    Tcl_ResetResult(interp);
    return TCL_OK;
    
}
static int
NameToWindow(interp, mainWin, objPtr, tkwinPtr)
    Tcl_Interp *interp;    /* Interp for error return and name lookup. */
    Tk_Window mainWin;    /* Main window of application. */
    Tcl_Obj *objPtr;    /* Contains name or id string of window. */
    Tk_Window *tkwinPtr;  /* Filled with token for window. */
{
    char *name;
    Tk_Window tkwin;
    Window id;

    name = Tcl_GetStringFromObj(objPtr, NULL);
    if (name[0] == '.') {
  tkwin = Tk_NameToWindow(interp, name, mainWin);
  if (tkwin == NULL) {
      return TCL_ERROR;
  }
  *tkwinPtr = tkwin;
    } else {
  /*
   * Check for the winPtr being valid, even if it looks ok to
   * TkpScanWindowId.  [Bug #411307]
   */

  if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) ||
    ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id))
      == NULL)) {
      Tcl_AppendResult(interp, "bad window name/identifier \"",
        name, "\"", (char *) NULL);
      return TCL_ERROR;
  }
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * DoWarp --
 *
 *  Perform Warping of X pointer. Executed as an idle handler only.
 *
 * Results:
 *  None
 *
 * Side effects:
 *  X Pointer will move to a new location.
 *
 *-------------------------------------------------------------------------
 */
static void
DoWarp(clientData)
    ClientData clientData;
{
    TkDisplay *dispPtr = (TkDisplay *) clientData;

    XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow,
                     0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY);
    XForceScreenSaver(dispPtr->display, ScreenSaverReset);
    dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
}

/*
 *-------------------------------------------------------------------------
 *
 * 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 the interp's 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 the interp's 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. */
    CONST 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;
    CONST 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) {
    Tcl_SetResult(interp, 
      "virtual event not allowed in definition of another virtual event",
      TCL_STATIC);
    return NULL;
      }
      virtualFound = 1;
  }

  /*
   * Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
   */

  while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
      flags |= PAT_NEARBY;
      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) {
  Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
  return NULL;
    }
    if ((numPats > 1) && (virtualFound != 0)) {
  Tcl_SetResult(interp, "virtual events may not be composed",
    TCL_STATIC);
  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);
  }
  /*
   * No binding exists for the sequence, so return an empty error.
   * This is a special error that the caller will check for in order
   * to silently ignore this case.  This is a hack that maintains
   * backward compatibility for Tk_GetBinding but the various "bind"
   * commands silently ignore missing bindings.
   */
  
  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. */
    CONST 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;
    Tcl_DString copy;

    Tcl_DStringInit(&copy);
    p = Tcl_DStringAppend(&copy, *eventStringPtr, -1);

    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 {
    char buf[64];
    
    sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    count = 0;
    goto done;
      }
  }
  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) {
      Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
        TCL_STATIC);
      count = 0;
      goto done;
  }      
  if ((p == NULL) || (p[1] != '>')) {
      Tcl_SetResult(interp, "missing \">\" in virtual binding",
        TCL_STATIC);
      count = 0;
      goto done;
  }
  *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 & (MULT_CLICKS)) {
      int i = modPtr->flags & MULT_CLICKS;
      count = 2;
      while (i >>= 1) count++;
  }
  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);
    count = 0;
    goto done;
      }
      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);
    count = 0;
    goto done;
      }
      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);
    count = 0;
    goto done;
      }
  }
    } else if (eventFlags == 0) {
  Tcl_SetResult(interp, "no event type or button # or keysym",
    TCL_STATIC);
  count = 0;
  goto done;
    }

    while ((*p == '-') || isspace(UCHAR(*p))) {
  p++;
    }
    if (*p != '>') {
  while (*p != '\0') {
      p++;
      if (*p == '>') {
    Tcl_SetResult(interp,
      "extra characters after detail in binding",
      TCL_STATIC);
    count = 0;
    goto done;
      }
  }
  Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
  count = 0;
  goto done;
    }
    p++;

end:
    *eventStringPtr += (p - Tcl_DStringValue(&copy));
    *eventMaskPtr |= eventMask;
done:
    Tcl_DStringFree(&copy);
    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[TCL_INTEGER_SPACE];
    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", "Triple", "Quadruple", 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--;
        if ((patsLeft > 1) && (memcmp((char *) patPtr,
          (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
      patsLeft--;
      patPtr--;
      Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
        } else {
      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);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * 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 passes to Tcl
 *  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 the interp's 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_EvalEx(interp, Tcl_DStringValue(&buffer),
      Tcl_DStringLength(&buffer), TCL_EVAL_GLOBAL);
    Tcl_DStringFree(&buffer);
    return code;
}


