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