diff options
Diffstat (limited to 'generic/tkBind.c')
| -rw-r--r-- | generic/tkBind.c | 4533 |
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; +} + + |