diff options
Diffstat (limited to 'tk8.6/generic/tkBind.c')
| -rw-r--r-- | tk8.6/generic/tkBind.c | 4298 |
1 files changed, 4298 insertions, 0 deletions
diff --git a/tk8.6/generic/tkBind.c b/tk8.6/generic/tkBind.c new file mode 100644 index 0000000..3b05066 --- /dev/null +++ b/tk8.6/generic/tkBind.c @@ -0,0 +1,4298 @@ +/* + * tkBind.c -- + * + * This file provides functions that associate Tcl commands with X events + * or sequences of X events. + * + * Copyright (c) 1989-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tkInt.h" + +#ifdef _WIN32 +#include "tkWinInt.h" +#elif defined(MAC_OSX_TK) +#include "tkMacOSXInt.h" +#else +#include "tkUnixInt.h" +#endif + +/* + * File structure: + * + * Structure definitions and static variables. + * + * Init/Free this package. + * + * Tcl "bind" command (actually located in tkCmds.c) core implementation, plus + * helpers. + * + * Tcl "event" command implementation, plus 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 Tk_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 commands. 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 { + 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 { + 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 { + 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). */ +} TkPattern; + +/* + * 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). */ + char *script; /* Binding script to evaluate when sequence + * matches (ckalloc()ed) */ + int flags; /* Miscellaneous flag values; see below for + * definitions. */ + 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. */ + TkPattern 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. + */ + +#define PAT_NEARBY 0x1 + +/* + * 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 { + 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 + * command can be invoked whenever the display/screen changes (the command does + * things like point tk::Priv at a display-specific structure). + */ + +typedef struct { + TkDisplay *curDispPtr; /* Display for last binding command invoked in + * this application. */ + int curScreenIndex; /* Index of screen for last binding command */ + int bindingDepth; /* Number of active instances of Tk_BindEvent + * in this application. */ +} ScreenInfo; + +/* + * The following structure keeps track of all the information local to the + * binding package on a per interpreter basis. + */ + +typedef struct TkBindInfo_ { + 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. */ + int deleted; /* 1 the application has been deleted but the + * structure has been preserved. */ +} BindInfo; + +/* + * In X11R4 and earlier versions, XStringToKeysym is ridiculously slow. The + * data structure and hash table below, along with the code that uses them, + * implement a fast mapping from strings to keysyms. In X11R5 and later + * releases XStringToKeysym is plenty fast so this stuff isn't needed. The + * #define REDO_KEYSYM_LOOKUP is normally undefined, so that XStringToKeysym + * gets used. It can be set in the Makefile to enable the use of the hash + * table below. + */ + +#ifdef REDO_KEYSYM_LOOKUP +typedef struct { + const char *name; /* Name of keysym. */ + KeySym value; /* Numeric identifier for keysym. */ +} KeySymInfo; +static const KeySymInfo keyArray[] = { +#ifndef lint +#include "ks_names.h" +#endif + {NULL, 0} +}; +static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */ +static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */ +#endif /* REDO_KEYSYM_LOOKUP */ + +/* + * Set to non-zero when the package-wide static variables have been + * initialized. + */ + +static int initialized = 0; +TCL_DECLARE_MUTEX(bindMutex) + +/* + * A hash table is kept to map from the string names of event modifiers to + * information about those modifiers. The structure for storing this + * information, and the hash table built at initialization time, are defined + * below. + */ + +typedef struct { + const char *name; /* Name of modifier. */ + int mask; /* Button/modifier mask value, such as + * Button1Mask. */ + int flags; /* Various flags; see below for + * definitions. */ +} ModInfo; + +/* + * Flags for ModInfo structures: + * + * DOUBLE - Non-zero means duplicate this event, + * e.g. for double-clicks. + * TRIPLE - Non-zero means triplicate this event, + * e.g. for triple-clicks. + * QUADRUPLE - Non-zero means quadruple this event, + * e.g. for 4-fold-clicks. + * MULT_CLICKS - Combination of all of above. + */ + +#define DOUBLE 1 +#define TRIPLE 2 +#define QUADRUPLE 4 +#define MULT_CLICKS 7 + +static const ModInfo modArray[] = { + {"Control", ControlMask, 0}, + {"Shift", ShiftMask, 0}, + {"Lock", LockMask, 0}, + {"Meta", META_MASK, 0}, + {"M", META_MASK, 0}, + {"Alt", ALT_MASK, 0}, + {"Extended", EXTENDED_MASK, 0}, + {"B1", Button1Mask, 0}, + {"Button1", Button1Mask, 0}, + {"B2", Button2Mask, 0}, + {"Button2", Button2Mask, 0}, + {"B3", Button3Mask, 0}, + {"Button3", Button3Mask, 0}, + {"B4", Button4Mask, 0}, + {"Button4", Button4Mask, 0}, + {"B5", Button5Mask, 0}, + {"Button5", Button5Mask, 0}, + {"Mod1", Mod1Mask, 0}, + {"M1", Mod1Mask, 0}, + {"Command", Mod1Mask, 0}, + {"Mod2", Mod2Mask, 0}, + {"M2", Mod2Mask, 0}, + {"Option", Mod2Mask, 0}, + {"Mod3", Mod3Mask, 0}, + {"M3", Mod3Mask, 0}, + {"Mod4", Mod4Mask, 0}, + {"M4", Mod4Mask, 0}, + {"Mod5", Mod5Mask, 0}, + {"M5", Mod5Mask, 0}, + {"Double", 0, DOUBLE}, + {"Triple", 0, TRIPLE}, + {"Quadruple", 0, QUADRUPLE}, + {"Any", 0, 0}, /* Ignored: historical relic */ + {NULL, 0, 0} +}; +static Tcl_HashTable modTable; + +/* + * This module also keeps a hash table mapping from event names to information + * about those events. The structure, an array to use to initialize the hash + * table, and the hash table are all defined below. + */ + +typedef struct { + const 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 const EventInfo eventArray[] = { + {"Key", KeyPress, KeyPressMask}, + {"KeyPress", KeyPress, KeyPressMask}, + {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask}, + {"Button", ButtonPress, ButtonPressMask}, + {"ButtonPress", ButtonPress, ButtonPressMask}, + {"ButtonRelease", ButtonRelease, + ButtonPressMask|ButtonReleaseMask}, + {"Motion", MotionNotify, + ButtonPressMask|PointerMotionMask}, + {"Enter", EnterNotify, EnterWindowMask}, + {"Leave", LeaveNotify, LeaveWindowMask}, + {"FocusIn", FocusIn, FocusChangeMask}, + {"FocusOut", FocusOut, FocusChangeMask}, + {"Expose", Expose, ExposureMask}, + {"Visibility", VisibilityNotify, VisibilityChangeMask}, + {"Destroy", DestroyNotify, StructureNotifyMask}, + {"Unmap", UnmapNotify, StructureNotifyMask}, + {"Map", MapNotify, StructureNotifyMask}, + {"Reparent", ReparentNotify, StructureNotifyMask}, + {"Configure", ConfigureNotify, StructureNotifyMask}, + {"Gravity", GravityNotify, StructureNotifyMask}, + {"Circulate", CirculateNotify, StructureNotifyMask}, + {"Property", PropertyNotify, PropertyChangeMask}, + {"Colormap", ColormapNotify, ColormapChangeMask}, + {"Activate", ActivateNotify, ActivateMask}, + {"Deactivate", DeactivateNotify, ActivateMask}, + {"MouseWheel", MouseWheelEvent, MouseWheelMask}, + {"CirculateRequest", CirculateRequest, SubstructureRedirectMask}, + {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask}, + {"Create", CreateNotify, SubstructureNotifyMask}, + {"MapRequest", MapRequest, SubstructureRedirectMask}, + {"ResizeRequest", ResizeRequest, ResizeRedirectMask}, + {NULL, 0, 0} +}; +static Tcl_HashTable eventTable; + +/* + * The defines and table below are used to classify events into various + * groups. The reason for this is that logically identical fields (e.g. + * "state") appear at different places in different types of events. The + * classification masks can be used to figure out quickly where to extract + * information from events. + */ + +#define KEY 0x1 +#define BUTTON 0x2 +#define MOTION 0x4 +#define CROSSING 0x8 +#define FOCUS 0x10 +#define EXPOSE 0x20 +#define VISIBILITY 0x40 +#define CREATE 0x80 +#define DESTROY 0x100 +#define UNMAP 0x200 +#define MAP 0x400 +#define REPARENT 0x800 +#define CONFIG 0x1000 +#define GRAVITY 0x2000 +#define CIRC 0x4000 +#define PROP 0x8000 +#define COLORMAP 0x10000 +#define VIRTUAL 0x20000 +#define ACTIVATE 0x40000 +#define MAPREQ 0x80000 +#define CONFIGREQ 0x100000 +#define RESIZEREQ 0x200000 +#define CIRCREQ 0x400000 + +#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL) +#define KEY_BUTTON_MOTION_CROSSING (KEY|BUTTON|MOTION|VIRTUAL|CROSSING) + +static const int flagArray[TK_LASTEVENT] = { + /* Not used */ 0, + /* Not used */ 0, + /* KeyPress */ KEY, + /* KeyRelease */ KEY, + /* ButtonPress */ BUTTON, + /* ButtonRelease */ BUTTON, + /* MotionNotify */ MOTION, + /* EnterNotify */ CROSSING, + /* LeaveNotify */ CROSSING, + /* FocusIn */ FOCUS, + /* FocusOut */ FOCUS, + /* KeymapNotify */ 0, + /* Expose */ EXPOSE, + /* GraphicsExpose */ EXPOSE, + /* NoExpose */ 0, + /* VisibilityNotify */ VISIBILITY, + /* CreateNotify */ CREATE, + /* DestroyNotify */ DESTROY, + /* UnmapNotify */ UNMAP, + /* MapNotify */ MAP, + /* MapRequest */ MAPREQ, + /* ReparentNotify */ REPARENT, + /* ConfigureNotify */ CONFIG, + /* ConfigureRequest */ CONFIGREQ, + /* GravityNotify */ GRAVITY, + /* ResizeRequest */ RESIZEREQ, + /* CirculateNotify */ CIRC, + /* CirculateRequest */ 0, + /* PropertyNotify */ PROP, + /* SelectionClear */ 0, + /* SelectionRequest */ 0, + /* SelectionNotify */ 0, + /* ColormapNotify */ COLORMAP, + /* ClientMessage */ 0, + /* MappingNotify */ 0, + /* VirtualEvent */ VIRTUAL, + /* Activate */ ACTIVATE, + /* Deactivate */ ACTIVATE, + /* MouseWheel */ KEY +}; + +/* + * The following table is used to map between the location where an generated + * event should be queued and the string used to specify the location. + */ + +static const TkStateMap queuePosition[] = { + {-1, "now"}, + {TCL_QUEUE_HEAD, "head"}, + {TCL_QUEUE_MARK, "mark"}, + {TCL_QUEUE_TAIL, "tail"}, + {-2, NULL} +}; + +/* + * The following tables are used as a two-way map between X's internal numeric + * values for fields in an XEvent and the strings used in Tcl. The tables are + * used both when constructing an XEvent from user input and when providing + * data from an XEvent to the user. + */ + +static const TkStateMap notifyMode[] = { + {NotifyNormal, "NotifyNormal"}, + {NotifyGrab, "NotifyGrab"}, + {NotifyUngrab, "NotifyUngrab"}, + {NotifyWhileGrabbed, "NotifyWhileGrabbed"}, + {-1, NULL} +}; + +static const TkStateMap notifyDetail[] = { + {NotifyAncestor, "NotifyAncestor"}, + {NotifyVirtual, "NotifyVirtual"}, + {NotifyInferior, "NotifyInferior"}, + {NotifyNonlinear, "NotifyNonlinear"}, + {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"}, + {NotifyPointer, "NotifyPointer"}, + {NotifyPointerRoot, "NotifyPointerRoot"}, + {NotifyDetailNone, "NotifyDetailNone"}, + {-1, NULL} +}; + +static const TkStateMap circPlace[] = { + {PlaceOnTop, "PlaceOnTop"}, + {PlaceOnBottom, "PlaceOnBottom"}, + {-1, NULL} +}; + +static const TkStateMap visNotify[] = { + {VisibilityUnobscured, "VisibilityUnobscured"}, + {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"}, + {VisibilityFullyObscured, "VisibilityFullyObscured"}, + {-1, NULL} +}; + +static const TkStateMap configureRequestDetail[] = { + {None, "None"}, + {Above, "Above"}, + {Below, "Below"}, + {BottomIf, "BottomIf"}, + {TopIf, "TopIf"}, + {Opposite, "Opposite"}, + {-1, NULL} +}; + +static const TkStateMap propNotify[] = { + {PropertyNewValue, "NewValue"}, + {PropertyDelete, "Delete"}, + {-1, NULL} +}; + +/* + * Prototypes for local functions defined in this file: + */ + +static void ChangeScreen(Tcl_Interp *interp, char *dispName, + int screenIndex); +static int CreateVirtualEvent(Tcl_Interp *interp, + VirtualEventTable *vetPtr, char *virtString, + const char *eventString); +static int DeleteVirtualEvent(Tcl_Interp *interp, + VirtualEventTable *vetPtr, char *virtString, + const char *eventString); +static void DeleteVirtualEventTable(VirtualEventTable *vetPtr); +static void ExpandPercents(TkWindow *winPtr, const char *before, + XEvent *eventPtr,KeySym keySym, + unsigned int scriptCount, Tcl_DString *dsPtr); +static PatSeq * FindSequence(Tcl_Interp *interp, + Tcl_HashTable *patternTablePtr, ClientData object, + const char *eventString, int create, + int allowVirtual, unsigned long *maskPtr); +static void GetAllVirtualEvents(Tcl_Interp *interp, + VirtualEventTable *vetPtr); +static char * GetField(char *p, char *copy, int size); +static Tcl_Obj * GetPatternObj(PatSeq *psPtr); +static int GetVirtualEvent(Tcl_Interp *interp, + VirtualEventTable *vetPtr, Tcl_Obj *virtName); +static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp, + char *virtString); +static int HandleEventGenerate(Tcl_Interp *interp, Tk_Window main, + int objc, Tcl_Obj *const objv[]); +static void InitVirtualEventTable(VirtualEventTable *vetPtr); +static PatSeq * MatchPatterns(TkDisplay *dispPtr, + BindingTable *bindPtr, PatSeq *psPtr, + PatSeq *bestPtr, ClientData *objectPtr, + PatSeq **sourcePtrPtr); +static int NameToWindow(Tcl_Interp *interp, Tk_Window main, + Tcl_Obj *objPtr, Tk_Window *tkwinPtr); +static int ParseEventDescription(Tcl_Interp *interp, + const char **eventStringPtr, TkPattern *patPtr, + unsigned long *eventMaskPtr); +static void DoWarp(ClientData clientData); + +/* + *--------------------------------------------------------------------------- + * + * TkBindInit -- + * + * This function 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( + TkMainInfo *mainPtr) /* The newly created application. */ +{ + BindInfo *bindInfoPtr; + + if (sizeof(XEvent) < sizeof(XVirtualEvent)) { + Tcl_Panic("TkBindInit: virtual events can't be supported"); + } + + /* + * Initialize the static data structures used by the binding package. They + * are only initialized once, no matter how many interps are created. + */ + + if (!initialized) { + Tcl_MutexLock(&bindMutex); + if (!initialized) { + Tcl_HashEntry *hPtr; + const ModInfo *modPtr; + const EventInfo *eiPtr; + int newEntry; +#ifdef REDO_KEYSYM_LOOKUP + const 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, &newEntry); + Tcl_SetHashValue(hPtr, kPtr->value); + hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value, + &newEntry); + if (newEntry) { + 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, &newEntry); + Tcl_SetHashValue(hPtr, modPtr); + } + + Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS); + for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { + hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &newEntry); + Tcl_SetHashValue(hPtr, eiPtr); + } + initialized = 1; + } + Tcl_MutexUnlock(&bindMutex); + } + + mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp); + + bindInfoPtr = ckalloc(sizeof(BindInfo)); + InitVirtualEventTable(&bindInfoPtr->virtualEventTable); + bindInfoPtr->screenInfo.curDispPtr = NULL; + bindInfoPtr->screenInfo.curScreenIndex = -1; + bindInfoPtr->screenInfo.bindingDepth = 0; + bindInfoPtr->deleted = 0; + mainPtr->bindInfo = bindInfoPtr; + + TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable); +} + +/* + *--------------------------------------------------------------------------- + * + * TkBindFree -- + * + * This function 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( + TkMainInfo *mainPtr) /* The newly created application. */ +{ + BindInfo *bindInfoPtr; + + Tk_DeleteBindingTable(mainPtr->bindingTable); + mainPtr->bindingTable = NULL; + + bindInfoPtr = mainPtr->bindInfo; + DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable); + bindInfoPtr->deleted = 1; + Tcl_EventuallyFree(bindInfoPtr, TCL_DYNAMIC); + mainPtr->bindInfo = NULL; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CreateBindingTable -- + * + * Set up a new domain in which event bindings may be created. + * + * Results: + * The return value is a token for the new table, which must be passed to + * functions like Tk_CreateBinding. + * + * Side effects: + * Memory is allocated for the new table. + * + *-------------------------------------------------------------- + */ + +Tk_BindingTable +Tk_CreateBindingTable( + Tcl_Interp *interp) /* Interpreter to associate with the binding + * table: commands are executed in this + * interpreter. */ +{ + BindingTable *bindPtr = ckalloc(sizeof(BindingTable)); + int i; + + /* + * Create and initialize a new binding table. + */ + + 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 bindPtr; +} + +/* + *-------------------------------------------------------------- + * + * Tk_DeleteBindingTable -- + * + * Destroy a binding table and free up all its memory. The caller should + * not use bindingTable again after this function returns. + * + * Results: + * None. + * + * Side effects: + * Memory is freed. + * + *-------------------------------------------------------------- + */ + +void +Tk_DeleteBindingTable( + Tk_BindingTable bindPtr) /* Token for the binding table to destroy. */ +{ + 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 = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) { + nextPtr = psPtr->nextSeqPtr; + ckfree(psPtr->script); + ckfree(psPtr); + } + } + + /* + * Clean up the rest of the information associated with the binding table. + */ + + Tcl_DeleteHashTable(&bindPtr->patternTable); + Tcl_DeleteHashTable(&bindPtr->objectTable); + ckfree(bindPtr); +} + +/* + *-------------------------------------------------------------- + * + * Tk_CreateBinding -- + * + * Add a binding to a binding table, so that future calls to Tk_BindEvent + * may execute the command in the binding. + * + * Results: + * The return value is 0 if an error occurred while setting up the + * binding. In this case, an error message will be left in the interp's + * result. If all went well then the return value is a mask of the event + * types that must be made available to Tk_BindEvent in order to properly + * detect when this binding triggers. This value can be used to determine + * what events to select for in a window, for example. + * + * Side effects: + * An existing binding on the same event sequence may be replaced. The + * new binding may cause future calls to Tk_BindEvent to behave + * differently than they did previously. + * + *-------------------------------------------------------------- + */ + +unsigned long +Tk_CreateBinding( + Tcl_Interp *interp, /* Used for error reporting. */ + Tk_BindingTable bindPtr, /* Table in which to create binding. */ + ClientData object, /* Token for object with which binding is + * associated. */ + const char *eventString, /* String describing event sequence that + * triggers binding. */ + const char *script, /* Contains Tcl script 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. */ +{ + PatSeq *psPtr; + unsigned long eventMask; + char *newStr, *oldStr; + + if (!*script) { + /* Silently ignore empty scripts -- see SF#3006842 */ + return 1; + } + psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, + 1, 1, &eventMask); + if (psPtr == NULL) { + return 0; + } + if (psPtr->script == NULL) { + int isNew; + 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, + &isNew); + if (isNew) { + psPtr->nextObjPtr = NULL; + } else { + psPtr->nextObjPtr = Tcl_GetHashValue(hPtr); + } + Tcl_SetHashValue(hPtr, psPtr); + } + + oldStr = psPtr->script; + if ((append != 0) && (oldStr != NULL)) { + size_t length1 = strlen(oldStr), length2 = strlen(script); + + newStr = ckalloc(length1 + length2 + 2); + memcpy(newStr, oldStr, length1); + newStr[length1] = '\n'; + memcpy(newStr+length1+1, script, length2+1); + } else { + size_t length = strlen(script); + + newStr = ckalloc(length + 1); + memcpy(newStr, script, length+1); + } + if (oldStr != NULL) { + ckfree(oldStr); + } + psPtr->script = newStr; + return eventMask; +} + +/* + *-------------------------------------------------------------- + * + * Tk_DeleteBinding -- + * + * Remove an event binding from a binding table. + * + * Results: + * The result is a standard Tcl return value. If an error occurs then the + * interp's result will contain an error message. + * + * Side effects: + * The binding given by object and eventString is removed from + * bindingTable. + * + *-------------------------------------------------------------- + */ + +int +Tk_DeleteBinding( + Tcl_Interp *interp, /* Used for error reporting. */ + Tk_BindingTable bindPtr, /* Table in which to delete binding. */ + ClientData object, /* Token for object with which binding is + * associated. */ + const char *eventString) /* String describing event sequence that + * triggers binding. */ +{ + 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) { + Tcl_Panic("Tk_DeleteBinding couldn't find object table entry"); + } + prevPtr = Tcl_GetHashValue(hPtr); + if (prevPtr == psPtr) { + Tcl_SetHashValue(hPtr, psPtr->nextObjPtr); + } else { + for ( ; ; prevPtr = prevPtr->nextObjPtr) { + if (prevPtr == NULL) { + Tcl_Panic("Tk_DeleteBinding couldn't find on object list"); + } + if (prevPtr->nextObjPtr == psPtr) { + prevPtr->nextObjPtr = psPtr->nextObjPtr; + break; + } + } + } + prevPtr = 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) { + Tcl_Panic("Tk_DeleteBinding couldn't find on hash chain"); + } + if (prevPtr->nextSeqPtr == psPtr) { + prevPtr->nextSeqPtr = psPtr->nextSeqPtr; + break; + } + } + } + + ckfree(psPtr->script); + ckfree(psPtr); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_GetBinding -- + * + * Return the script associated with a given event string. + * + * Results: + * The return value is a pointer to the script associated with + * eventString for object in the domain given by bindingTable. If there + * is no binding for eventString, or if eventString is improperly formed, + * then NULL is returned and an error message is left in the interp's + * result. The return value is semi-static: it will persist until the + * binding is changed or deleted. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +const char * +Tk_GetBinding( + Tcl_Interp *interp, /* Interpreter for error reporting. */ + Tk_BindingTable bindPtr, /* Table in which to look for binding. */ + ClientData object, /* Token for object with which binding is + * associated. */ + const char *eventString) /* String describing event sequence that + * triggers binding. */ +{ + PatSeq *psPtr; + unsigned long eventMask; + + psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, + 0, 1, &eventMask); + if (psPtr == NULL) { + return NULL; + } + return psPtr->script; +} + +/* + *-------------------------------------------------------------- + * + * Tk_GetAllBindings -- + * + * Return a list of event strings for all the bindings associated with a + * given object. + * + * Results: + * There is no return value. The interp's result is modified to hold a + * Tcl list with one entry for each binding associated with object in + * bindingTable. Each entry in the list contains the event string + * associated with one binding. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Tk_GetAllBindings( + Tcl_Interp *interp, /* Interpreter returning result or error. */ + Tk_BindingTable bindPtr, /* Table in which to look for bindings. */ + ClientData object) /* Token for object. */ +{ + PatSeq *psPtr; + Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; + + hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); + if (hPtr == NULL) { + return; + } + + resultObj = Tcl_NewObj(); + for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; + psPtr = psPtr->nextObjPtr) { + /* + * For each binding, output information about each of the patterns in + * its sequence. + */ + + Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr)); + } + Tcl_SetObjResult(interp, resultObj); +} + +/* + *-------------------------------------------------------------- + * + * 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( + Tk_BindingTable bindPtr, /* Table in which to delete bindings. */ + ClientData object) /* Token for object. */ +{ + PatSeq *psPtr, *prevPtr; + PatSeq *nextPtr; + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); + if (hPtr == NULL) { + return; + } + for (psPtr = 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 = 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) { + Tcl_Panic("Tk_DeleteAllBindings couldn't find on hash chain"); + } + if (prevPtr->nextSeqPtr == psPtr) { + prevPtr->nextSeqPtr = psPtr->nextSeqPtr; + break; + } + } + } + ckfree(psPtr->script); + ckfree(psPtr); + } + Tcl_DeleteHashEntry(hPtr); +} + +/* + *--------------------------------------------------------------------------- + * + * Tk_BindEvent -- + * + * This function 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 script associated with the matching binding. + * + * All Tcl binding 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. + * + *--------------------------------------------------------------------------- + */ + +void +Tk_BindEvent( + Tk_BindingTable bindPtr, /* 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. */ +{ + TkDisplay *dispPtr; + ScreenInfo *screenPtr; + BindInfo *bindInfoPtr; + TkDisplay *oldDispPtr; + XEvent *ringPtr; + PatSeq *vMatchDetailList, *vMatchNoDetailList; + int flags, oldScreen; + unsigned int scriptCount; + Tcl_Interp *interp; + Tcl_DString scripts; + Tcl_InterpState interpState; + Detail detail; + char *p, *end; + 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; + } + } + + dispPtr = ((TkWindow *) tkwin)->dispPtr; + bindInfoPtr = 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(ringPtr, eventPtr, sizeof(XEvent)); + detail.clientData = 0; + flags = flagArray[ringPtr->type]; + if (flags & KEY) { + detail.keySym = TkpGetKeySym(dispPtr, ringPtr); + if (detail.keySym == NoSymbol) { + detail.keySym = 0; + } + } else if (flags & BUTTON) { + detail.button = ringPtr->xbutton.button; + } else if (flags & VIRTUAL) { + detail.name = ((XVirtualEvent *) ringPtr)->name; + } + bindPtr->detailRing[bindPtr->curEvent] = detail; + + /* + * Find out if there are any virtual events that correspond to this + * physical event (or sequence of physical events). + */ + + vMatchDetailList = NULL; + vMatchNoDetailList = NULL; + memset(&key, 0, sizeof(key)); + + if (ringPtr->type != VirtualEvent) { + Tcl_HashTable *veptPtr = &bindInfoPtr->virtualEventTable.patternTable; + Tcl_HashEntry *hPtr; + + key.object = NULL; + key.type = ringPtr->type; + key.detail = detail; + + hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key); + if (hPtr != NULL) { + vMatchDetailList = Tcl_GetHashValue(hPtr); + } + + if (key.detail.clientData != 0) { + key.detail.clientData = 0; + hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key); + if (hPtr != NULL) { + vMatchNoDetailList = 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. + */ + + scriptCount = 0; + Tcl_DStringInit(&scripts); + + for ( ; numObjects > 0; numObjects--, objectPtr++) { + PatSeq *matchPtr = NULL, *sourcePtr = NULL; + Tcl_HashEntry *hPtr; + + /* + * 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, 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, + Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr); + } + + if (vMatchNoDetailList != NULL) { + matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList, + matchPtr, objectPtr, &sourcePtr); + } + } + + if (matchPtr != NULL) { + ExpandPercents(winPtr, sourcePtr->script, eventPtr, + detail.keySym, scriptCount++, &scripts); + + /* + * A "" is added to the scripts string to separate the various + * scripts that should be invoked. + */ + + Tcl_DStringAppend(&scripts, "", 1); + } + } + if (Tcl_DStringLength(&scripts) == 0) { + return; + } + + /* + * Now go back through and evaluate the binding for each object, in order, + * dealing with "break" and "continue" exceptions appropriately. + * + * There are two tricks here: + * 1. Bindings can be invoked from in the middle of Tcl commands, where + * the interp's result is significant (for example, a widget might be + * deleted because of an error in creating it, so the result contains + * an error message that is eventually going to be returned by the + * creating command). To preserve the result, we save it in a dynamic + * string. + * 2. The binding's action can potentially delete the binding, so bindPtr + * may not point to anything valid once the action completes. Thus we + * have to save bindPtr->interp in a local variable in order to restore + * the result. + */ + + interp = bindPtr->interp; + + /* + * Save information about the current screen, then invoke a script if the + * screen has changed. + */ + + interpState = Tcl_SaveInterpState(interp, TCL_OK); + 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); + } + + p = Tcl_DStringValue(&scripts); + end = p + Tcl_DStringLength(&scripts); + + /* + * Be careful when dereferencing screenPtr or bindInfoPtr. If we evaluate + * something that destroys ".", bindInfoPtr would have been freed, but we + * can tell that by first checking to see if winPtr->mainPtr == NULL. + */ + + Tcl_Preserve(bindInfoPtr); + while (p < end) { + int len = (int) strlen(p); + int code; + + if (!bindInfoPtr->deleted) { + screenPtr->bindingDepth++; + } + Tcl_AllowExceptions(interp); + + code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL); + p += len + 1; + + if (!bindInfoPtr->deleted) { + screenPtr->bindingDepth--; + } + if (code != TCL_OK) { + if (code == TCL_CONTINUE) { + /* + * Do nothing: just go on to the next command. + */ + } else if (code == TCL_BREAK) { + break; + } else { + Tcl_AddErrorInfo(interp, "\n (command bound to event)"); + Tcl_BackgroundException(interp, code); + break; + } + } + } + + if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0) + && ((oldDispPtr != screenPtr->curDispPtr) + || (oldScreen != screenPtr->curScreenIndex))) { + /* + * Some other binding script is currently executing, but its screen is + * no longer current. Change the current display back again. + */ + + screenPtr->curDispPtr = oldDispPtr; + screenPtr->curScreenIndex = oldScreen; + ChangeScreen(interp, oldDispPtr->name, oldScreen); + } + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_DStringFree(&scripts); + + Tcl_Release(bindInfoPtr); +} + +/* + *---------------------------------------------------------------------- + * + * 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 function 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 function 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( + 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 function. 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 = &bindPtr->eventRing[bindPtr->curEvent]; + Detail *detailPtr = &bindPtr->detailRing[bindPtr->curEvent]; + TkPattern *patPtr = psPtr->pats; + Window window = eventPtr->xany.window; + int patCount, ringCount, flags, state, modMask, i; + + /* + * Iterate over all the patterns in a sequence to be sure that they + * all match. + */ + + 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)) { + /* + * Ignore key events if they are modifier keys. + */ + + for (i = 0; i < dispPtr->numModKeyCodes; i++) { + if (dispPtr->modKeyCodes[i] + == eventPtr->xkey.keycode) { + /* + * This key is a modifier key, so ignore it. + */ + + goto nextEvent; + } + } + goto nextSequence; + } + } + goto nextEvent; + } + if (eventPtr->xany.type == CreateNotify + && eventPtr->xcreatewindow.parent != window) { + goto nextSequence; + } else if (eventPtr->xany.window != window) { + goto nextSequence; + } + + /* + * Note: it's important for the keysym check to go before the + * modifier check, so we can ignore unwanted modifier keys before + * choking on the modifier check. + */ + + if ((patPtr->detail.clientData != 0) + && (patPtr->detail.clientData != detailPtr->clientData)) { + /* + * The detail appears not to match. However, if the event is a + * KeyPress for a modifier key then just ignore the event. + * Otherwise event sequences like "aD" never match because the + * shift key goes down between the "a" and the "D". + */ + + if (eventPtr->xany.type == KeyPress) { + for (i = 0; i < dispPtr->numModKeyCodes; i++) { + if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) { + goto nextEvent; + } + } + } + goto nextSequence; + } + flags = flagArray[eventPtr->type]; + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + state = eventPtr->xkey.state; + } else if (flags & CROSSING) { + state = eventPtr->xcrossing.state; + } else { + state = 0; + } + if (patPtr->needMods != 0) { + modMask = patPtr->needMods; + if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) { + modMask = (modMask & ~META_MASK) | dispPtr->metaModMask; + } + if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) { + modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask; + } + + if ((state & META_MASK) && (dispPtr->metaModMask != 0)) { + state = (state & ~META_MASK) | dispPtr->metaModMask; + } + if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) { + state = (state & ~ALT_MASK) | dispPtr->altModMask; + } + + if ((state & modMask) != modMask) { + goto nextSequence; + } + } + if (psPtr->flags & PAT_NEARBY) { + XEvent *firstPtr = &bindPtr->eventRing[bindPtr->curEvent]; + int timeDiff; + + 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 = Tcl_GetHashValue(hPtr); + + if ((virtMatchPtr->numPats != 1) + || (virtMatchPtr->nextSeqPtr != NULL)) { + Tcl_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) { + TkPattern *patPtr2; + + 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( + TkWindow *winPtr, /* Window where event occurred: needed to get + * input context. */ + const char *before, /* Command containing percent expressions to + * be replaced. */ + XEvent *eventPtr, /* X event containing information to be used + * in % replacements. */ + KeySym keySym, /* KeySym: only relevant for KeyPress and + * KeyRelease events). */ + unsigned int scriptCount, /* The number of script-based binding patterns + * matched so far for this event. */ + Tcl_DString *dsPtr) /* Dynamic string in which to append new + * command. */ +{ + int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl + * list element. */ + int number, flags, length; +#define NUM_SIZE 40 + const char *string; + Tcl_DString buf; + char numStorage[NUM_SIZE+1]; + + Tcl_DStringInit(&buf); + + if (eventPtr->type < TK_LASTEVENT) { + flags = flagArray[eventPtr->type]; + } else { + flags = 0; + } + + while (1) { + /* + * Find everything up to the next % character and append it to the + * result string. + */ + + for (string = before; (*string != 0) && (*string != '%'); string++) { + /* Empty loop body. */ + } + if (string != before) { + Tcl_DStringAppend(dsPtr, before, (int) (string-before)); + before = string; + } + if (*before == 0) { + break; + } + + /* + * There's a percent sequence here. Process it. + */ + + number = 0; + string = "??"; + switch (before[1]) { + case '#': + number = eventPtr->xany.serial; + goto doNumber; + case 'a': + if (flags & CONFIG) { + TkpPrintWindowId(numStorage, eventPtr->xconfigure.above); + string = numStorage; + } + goto doString; + case 'b': + if (flags & BUTTON) { + number = eventPtr->xbutton.button; + goto doNumber; + } + goto doString; + case 'c': + if (flags & EXPOSE) { + number = eventPtr->xexpose.count; + goto doNumber; + } + goto doString; + case 'd': + if (flags & (CROSSING|FOCUS)) { + if (flags & FOCUS) { + number = eventPtr->xfocus.detail; + } else { + number = eventPtr->xcrossing.detail; + } + string = TkFindStateString(notifyDetail, number); + } else if (flags & CONFIGREQ) { + if (eventPtr->xconfigurerequest.value_mask & CWStackMode) { + string = TkFindStateString(configureRequestDetail, + eventPtr->xconfigurerequest.detail); + } else { + string = ""; + } + } else if (flags & VIRTUAL) { + XVirtualEvent *vePtr = (XVirtualEvent *) eventPtr; + + if (vePtr->user_data != NULL) { + string = Tcl_GetString(vePtr->user_data); + } else { + string = ""; + } + } + goto doString; + case 'f': + if (flags & CROSSING) { + number = eventPtr->xcrossing.focus; + goto doNumber; + } + goto doString; + case 'h': + if (flags & EXPOSE) { + number = eventPtr->xexpose.height; + } else if (flags & CONFIG) { + number = eventPtr->xconfigure.height; + } else if (flags & CREATE) { + number = eventPtr->xcreatewindow.height; + } else if (flags & CONFIGREQ) { + number = eventPtr->xconfigurerequest.height; + } else if (flags & RESIZEREQ) { + number = eventPtr->xresizerequest.height; + } else { + goto doString; + } + goto doNumber; + case 'i': + if (flags & CREATE) { + TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window); + } else if (flags & CONFIGREQ) { + TkpPrintWindowId(numStorage, + eventPtr->xconfigurerequest.window); + } else if (flags & MAPREQ) { + TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window); + } else { + TkpPrintWindowId(numStorage, eventPtr->xany.window); + } + string = numStorage; + goto doString; + case 'k': + if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) { + number = eventPtr->xkey.keycode; + goto doNumber; + } + goto doString; + case 'm': + if (flags & CROSSING) { + number = eventPtr->xcrossing.mode; + string = TkFindStateString(notifyMode, number); + } else if (flags & FOCUS) { + number = eventPtr->xfocus.mode; + string = TkFindStateString(notifyMode, number); + } + goto doString; + case 'o': + if (flags & CREATE) { + number = eventPtr->xcreatewindow.override_redirect; + } else if (flags & MAP) { + number = eventPtr->xmap.override_redirect; + } else if (flags & REPARENT) { + number = eventPtr->xreparent.override_redirect; + } else if (flags & CONFIG) { + number = eventPtr->xconfigure.override_redirect; + } else { + goto doString; + } + goto doNumber; + case 'p': + if (flags & CIRC) { + string = TkFindStateString(circPlace, + eventPtr->xcirculate.place); + } else if (flags & CIRCREQ) { + string = TkFindStateString(circPlace, + eventPtr->xcirculaterequest.place); + } + goto doString; + case 's': + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + number = eventPtr->xkey.state; + goto doNumber; + } else if (flags & CROSSING) { + number = eventPtr->xcrossing.state; + goto doNumber; + } else if (flags & PROP) { + string = TkFindStateString(propNotify, + eventPtr->xproperty.state); + } else if (flags & VISIBILITY) { + string = TkFindStateString(visNotify, + eventPtr->xvisibility.state); + } + goto doString; + case 't': + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + number = (int) eventPtr->xkey.time; + } else if (flags & CROSSING) { + number = (int) eventPtr->xcrossing.time; + } else if (flags & PROP) { + number = (int) eventPtr->xproperty.time; + } else { + goto doString; + } + goto doNumber; + case 'v': + number = eventPtr->xconfigurerequest.value_mask; + goto doNumber; + case 'w': + if (flags & EXPOSE) { + number = eventPtr->xexpose.width; + } else if (flags & CONFIG) { + number = eventPtr->xconfigure.width; + } else if (flags & CREATE) { + number = eventPtr->xcreatewindow.width; + } else if (flags & CONFIGREQ) { + number = eventPtr->xconfigurerequest.width; + } else if (flags & RESIZEREQ) { + number = eventPtr->xresizerequest.width; + } else { + goto doString; + } + goto doNumber; + case 'x': + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + number = eventPtr->xkey.x; + } else if (flags & CROSSING) { + number = eventPtr->xcrossing.x; + } else if (flags & EXPOSE) { + number = eventPtr->xexpose.x; + } else if (flags & (CREATE|CONFIG|GRAVITY)) { + number = eventPtr->xcreatewindow.x; + } else if (flags & REPARENT) { + number = eventPtr->xreparent.x; + } else if (flags & CREATE) { + number = eventPtr->xcreatewindow.x; + } else if (flags & CONFIGREQ) { + number = eventPtr->xconfigurerequest.x; + } else { + goto doString; + } + goto doNumber; + case 'y': + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + number = eventPtr->xkey.y; + } else if (flags & EXPOSE) { + number = eventPtr->xexpose.y; + } else if (flags & (CREATE|CONFIG|GRAVITY)) { + number = eventPtr->xcreatewindow.y; + } else if (flags & REPARENT) { + number = eventPtr->xreparent.y; + } else if (flags & CROSSING) { + number = eventPtr->xcrossing.y; + } else if (flags & CREATE) { + number = eventPtr->xcreatewindow.y; + } else if (flags & CONFIGREQ) { + number = eventPtr->xconfigurerequest.y; + } else { + goto doString; + } + goto doNumber; + case 'A': + if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) { + Tcl_DStringFree(&buf); + string = TkpGetString(winPtr, eventPtr, &buf); + } + goto doString; + case 'B': + if (flags & CREATE) { + number = eventPtr->xcreatewindow.border_width; + } else if (flags & CONFIGREQ) { + number = eventPtr->xconfigurerequest.border_width; + } else if (flags & CONFIG) { + number = eventPtr->xconfigure.border_width; + } else { + goto doString; + } + goto doNumber; + case 'D': + /* + * This is used only by the MouseWheel event. + */ + + if ((flags & KEY) && (eventPtr->type == MouseWheelEvent)) { + number = eventPtr->xkey.keycode; + goto doNumber; + } + goto doString; + case 'E': + number = (int) eventPtr->xany.send_event; + goto doNumber; + case 'K': + if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) { + const char *name = TkKeysymToString(keySym); + + if (name != NULL) { + string = name; + } + } + goto doString; + case 'M': + number = scriptCount; + goto doNumber; + case 'N': + if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) { + number = (int) keySym; + goto doNumber; + } + goto doString; + case 'P': + if (flags & PROP) { + string = Tk_GetAtomName((Tk_Window) winPtr, + eventPtr->xproperty.atom); + } + goto doString; + case 'R': + if (flags & KEY_BUTTON_MOTION_CROSSING) { + TkpPrintWindowId(numStorage, eventPtr->xkey.root); + string = numStorage; + } + goto doString; + case 'S': + if (flags & KEY_BUTTON_MOTION_CROSSING) { + TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow); + string = numStorage; + } + goto doString; + case 'T': + number = eventPtr->type; + goto doNumber; + case 'W': { + Tk_Window tkwin; + + tkwin = Tk_IdToWindow(eventPtr->xany.display, + eventPtr->xany.window); + if (tkwin != NULL) { + string = Tk_PathName(tkwin); + } else { + string = "??"; + } + goto doString; + } + case 'X': + if (flags & KEY_BUTTON_MOTION_CROSSING) { + + number = eventPtr->xkey.x_root; + Tk_IdToWindow(eventPtr->xany.display, + eventPtr->xany.window); + goto doNumber; + } + goto doString; + case 'Y': + if (flags & KEY_BUTTON_MOTION_CROSSING) { + + number = eventPtr->xkey.y_root; + Tk_IdToWindow(eventPtr->xany.display, + eventPtr->xany.window); + goto doNumber; + } + goto doString; + default: + numStorage[0] = before[1]; + numStorage[1] = '\0'; + string = numStorage; + goto doString; + } + + doNumber: + sprintf(numStorage, "%d", number); + string = numStorage; + + doString: + spaceNeeded = Tcl_ScanElement(string, &cvtFlags); + length = Tcl_DStringLength(dsPtr); + Tcl_DStringSetLength(dsPtr, length + spaceNeeded); + spaceNeeded = Tcl_ConvertElement(string, + Tcl_DStringValue(dsPtr) + length, + cvtFlags | TCL_DONT_USE_BRACES); + Tcl_DStringSetLength(dsPtr, length + spaceNeeded); + before += 2; + } + Tcl_DStringFree(&buf); +} + +/* + *---------------------------------------------------------------------- + * + * ChangeScreen -- + * + * This function is invoked whenever the current screen changes in an + * application. It invokes a Tcl command named "tk::ScreenChanged", + * passing it the screen name as argument. tk::ScreenChanged does things + * like making the tk::Priv variable point to an array for the current + * display. + * + * Results: + * None. + * + * Side effects: + * Depends on what tk::ScreenChanged does. If an error occurs then + * bgerror will be invoked. + * + *---------------------------------------------------------------------- + */ + +static void +ChangeScreen( + Tcl_Interp *interp, /* Interpreter in which to invoke command. */ + char *dispName, /* Name of new display. */ + int screenIndex) /* Index of new screen. */ +{ + Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d", + dispName, screenIndex); + int code; + + Tcl_IncrRefCount(cmdObj); + code = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { + Tcl_AddErrorInfo(interp, + "\n (changing screen in event binding)"); + Tcl_BackgroundException(interp, code); + } + Tcl_DecrRefCount(cmdObj); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_EventCmd -- + * + * This function is invoked to process the "event" Tcl command. It is + * used to define and generate events. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tk_EventObjCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int index, i; + char *name; + const char *event; + Tk_Window tkwin = clientData; + TkBindInfo bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; + VirtualEventTable *vetPtr = &bindInfo->virtualEventTable; + static const char *const optionStrings[] = { + "add", "delete", "generate", "info", + NULL + }; + enum options { + EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO + }; + + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case EVENT_ADD: + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "virtual sequence ?sequence ...?"); + return TCL_ERROR; + } + name = Tcl_GetString(objv[2]); + for (i = 3; i < objc; i++) { + event = Tcl_GetString(objv[i]); + if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) { + return TCL_ERROR; + } + } + break; + case EVENT_DELETE: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "virtual ?sequence ...?"); + return TCL_ERROR; + } + name = Tcl_GetString(objv[2]); + if (objc == 3) { + return DeleteVirtualEvent(interp, vetPtr, name, NULL); + } + for (i = 3; i < objc; i++) { + event = Tcl_GetString(objv[i]); + if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) { + return TCL_ERROR; + } + } + break; + case EVENT_GENERATE: + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "window event ?-option value ...?"); + return TCL_ERROR; + } + return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2); + case EVENT_INFO: + if (objc == 2) { + GetAllVirtualEvents(interp, vetPtr); + return TCL_OK; + } else if (objc == 3) { + return GetVirtualEvent(interp, vetPtr, objv[2]); + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?virtual?"); + return TCL_ERROR; + } + } + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * + * InitVirtualEventTable -- + * + * Given storage for a virtual event table, set up the fields to prepare + * a new domain in which virtual events may be defined. + * + * Results: + * None. + * + * Side effects: + * *vetPtr is now initialized. + * + *--------------------------------------------------------------------------- + */ + +static void +InitVirtualEventTable( + 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( + 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 = Tcl_GetHashValue(hPtr); + for ( ; psPtr != NULL; psPtr = nextPtr) { + nextPtr = psPtr->nextSeqPtr; + ckfree(psPtr->voPtr); + ckfree(psPtr); + } + } + Tcl_DeleteHashTable(&vetPtr->patternTable); + + hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search); + for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + ckfree(Tcl_GetHashValue(hPtr)); + } + Tcl_DeleteHashTable(&vetPtr->nameTable); +} + +/* + *---------------------------------------------------------------------- + * + * CreateVirtualEvent -- + * + * Add a new definition for a virtual event. If the virtual event is + * already defined, the new definition augments those that already exist. + * + * Results: + * The return value is TCL_ERROR if an error occured while creating the + * virtual binding. In this case, an error message will be left in the + * interp's result. If all went well then the return value is TCL_OK. + * + * Side effects: + * The virtual event may cause future calls to Tk_BindEvent to behave + * differently than they did previously. + * + *---------------------------------------------------------------------- + */ + +static int +CreateVirtualEvent( + Tcl_Interp *interp, /* Used for error reporting. */ + VirtualEventTable *vetPtr, /* Table in which to augment virtual event. */ + char *virtString, /* Name of new virtual event. */ + const 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 = Tcl_GetHashValue(vhPtr); + if (poPtr == NULL) { + poPtr = 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 = ckrealloc(poPtr, sizeof(PhysicalsOwned) + + poPtr->numOwned * sizeof(PatSeq *)); + } + Tcl_SetHashValue(vhPtr, 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 = ckalloc(sizeof(VirtualOwners)); + voPtr->numOwners = 0; + } else { + voPtr = ckrealloc(voPtr, sizeof(VirtualOwners) + + voPtr->numOwners * sizeof(Tcl_HashEntry *)); + } + psPtr->voPtr = voPtr; + voPtr->owners[voPtr->numOwners] = vhPtr; + voPtr->numOwners++; + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * DeleteVirtualEvent -- + * + * Remove the definition of a given virtual event. If the event string is + * NULL, all definitions of the virtual event will be removed. + * Otherwise, just the specified definition of the virtual event will be + * removed. + * + * Results: + * The result is a standard Tcl return value. If an error occurs then the + * interp's result will contain an error message. It is not an error to + * attempt to delete a virtual event that does not exist or a definition + * that does not exist. + * + * Side effects: + * The virtual event given by virtString may be removed from the virtual + * event table. + * + *-------------------------------------------------------------- + */ + +static int +DeleteVirtualEvent( + Tcl_Interp *interp, /* Used for error reporting. */ + VirtualEventTable *vetPtr, /* Table in which to delete event. */ + char *virtString, /* String describing event sequence that + * triggers binding. */ + const 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 = Tcl_GetHashValue(vhPtr); + + eventPSPtr = NULL; + if (eventString != NULL) { + unsigned long eventMask; + + /* + * Delete only the specific physical event associated with the virtual + * event. If the physical event doesn't already exist, or the virtual + * event doesn't own that physical event, return w/o doing anything. + */ + + eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL, + eventString, 0, 0, &eventMask); + if (eventPSPtr == NULL) { + const char *string = Tcl_GetString(Tcl_GetObjResult(interp)); + + return (string[0] != '\0') ? TCL_ERROR : TCL_OK; + } + } + + for (iPhys = poPtr->numOwned; --iPhys >= 0; ) { + PatSeq *psPtr = poPtr->patSeqs[iPhys]; + + if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) { + int iVirt; + VirtualOwners *voPtr; + + /* + * Remove association between this physical event and the given + * virtual event that it triggers. + */ + + voPtr = psPtr->voPtr; + for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) { + if (voPtr->owners[iVirt] == vhPtr) { + break; + } + } + if (iVirt == voPtr->numOwners) { + Tcl_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 = 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) { + Tcl_Panic("DeleteVirtualEvent couldn't find on hash chain"); + } + if (prevPtr->nextSeqPtr == psPtr) { + prevPtr->nextSeqPtr = psPtr->nextSeqPtr; + break; + } + } + } + ckfree(psPtr->voPtr); + ckfree(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(poPtr); + Tcl_DeleteHashEntry(vhPtr); + } + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * + * GetVirtualEvent -- + * + * Return the list of physical events that can invoke the given virtual + * event. + * + * Results: + * The return value is TCL_OK and the interp's result is filled with the + * string representation of the physical events associated with the + * virtual event; if there are no physical events for the given virtual + * event, the interp's result is filled with and empty string. If the + * virtual event string is improperly formed, then TCL_ERROR is returned + * and an error message is left in the interp's result. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +GetVirtualEvent( + Tcl_Interp *interp, /* Interpreter for reporting. */ + VirtualEventTable *vetPtr, /* Table in which to look for event. */ + Tcl_Obj *virtName) /* String describing virtual event. */ +{ + Tcl_HashEntry *vhPtr; + int iPhys; + PhysicalsOwned *poPtr; + Tk_Uid virtUid; + Tcl_Obj *resultObj; + + virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName)); + if (virtUid == NULL) { + return TCL_ERROR; + } + + vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid); + if (vhPtr == NULL) { + return TCL_OK; + } + + resultObj = Tcl_NewObj(); + poPtr = Tcl_GetHashValue(vhPtr); + for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) { + Tcl_ListObjAppendElement(NULL, resultObj, + GetPatternObj(poPtr->patSeqs[iPhys])); + } + Tcl_SetObjResult(interp, resultObj); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * GetAllVirtualEvents -- + * + * Return a list that contains the names of all the virtual event + * defined. + * + * Results: + * There is no return value. The interp's result is modified to hold a + * Tcl list with one entry for each virtual event in nameTable. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +GetAllVirtualEvents( + Tcl_Interp *interp, /* Interpreter returning result. */ + VirtualEventTable *vetPtr) /* Table containing events. */ +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *resultObj; + + resultObj = Tcl_NewObj(); + hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search); + for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr))); + } + Tcl_SetObjResult(interp, resultObj); +} + +/* + *--------------------------------------------------------------------------- + * + * 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( + Tcl_Interp *interp, /* Interp for errors return and name lookup. */ + Tk_Window mainWin, /* Main window associated with interp. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + union {XEvent general; XVirtualEvent virtual;} event; + const char *p; + const char *name, *windowName; + int count, flags, synch, i, number, warp; + Tcl_QueuePosition pos; + TkPattern pat; + Tk_Window tkwin, tkwin2; + TkWindow *mainPtr; + unsigned long eventMask; + Tcl_Obj *userDataObj; + + static const char *const fieldStrings[] = { + "-when", "-above", "-borderwidth", "-button", + "-count", "-data", "-delta", "-detail", + "-focus", "-height", + "-keycode", "-keysym", "-mode", "-override", + "-place", "-root", "-rootx", "-rooty", + "-sendevent", "-serial", "-state", "-subwindow", + "-time", "-warp", "-width", "-window", + "-x", "-y", NULL + }; + enum field { + EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON, + EVENT_COUNT, EVENT_DATA, EVENT_DELTA, EVENT_DETAIL, + EVENT_FOCUS, EVENT_HEIGHT, + EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE, + EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY, + EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW, + EVENT_TIME, EVENT_WARP, EVENT_WIDTH, EVENT_WINDOW, + EVENT_X, EVENT_Y + }; + + windowName = Tcl_GetString(objv[0]); + if (!windowName[0]) { + tkwin = mainWin; + } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) { + return TCL_ERROR; + } + + mainPtr = (TkWindow *) mainWin; + if ((tkwin == NULL) + || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", + Tcl_GetString(objv[0]), NULL); + return TCL_ERROR; + } + + name = Tcl_GetString(objv[1]); + + p = name; + eventMask = 0; + userDataObj = NULL; + count = ParseEventDescription(interp, &p, &pat, &eventMask); + if (count == 0) { + return TCL_ERROR; + } + if (count != 1) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Double or Triple modifier not allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL); + return TCL_ERROR; + } + if (*p != '\0') { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "only one event specification allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL); + return TCL_ERROR; + } + + memset(&event, 0, sizeof(event)); + event.general.xany.type = pat.eventType; + event.general.xany.serial = NextRequest(Tk_Display(tkwin)); + event.general.xany.send_event = False; + if (windowName[0]) { + event.general.xany.window = Tk_WindowId(tkwin); + } else { + event.general.xany.window = + RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin)); + } + event.general.xany.display = Tk_Display(tkwin); + + flags = flagArray[event.general.xany.type]; + if (flags & DESTROY) { + /* + * Event DestroyNotify should be generated by destroying the window. + */ + + Tk_DestroyWindow(tkwin); + return TCL_OK; + } + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + event.general.xkey.state = pat.needMods; + if ((flags & KEY) && (event.general.xany.type != MouseWheelEvent)) { + TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event.general); + } else if (flags & BUTTON) { + event.general.xbutton.button = pat.detail.button; + } else if (flags & VIRTUAL) { + event.virtual.name = pat.detail.name; + } + } + if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) { + event.general.xcreatewindow.window = event.general.xany.window; + } + + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.x_root = -1; + event.general.xkey.y_root = -1; + } + + if (event.general.xany.type == FocusIn + || event.general.xany.type == FocusOut) { + event.general.xany.send_event = GENERATED_FOCUS_EVENT_MAGIC; + } + + /* + * Process the remaining arguments to fill in additional fields of the + * event. + */ + + synch = 1; + warp = 0; + pos = TCL_QUEUE_TAIL; + for (i = 2; i < objc; i += 2) { + Tcl_Obj *optionPtr, *valuePtr; + int index; + + optionPtr = objv[i]; + valuePtr = objv[i + 1]; + + if (Tcl_GetIndexFromObjStruct(interp, optionPtr, fieldStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + if (objc & 1) { + /* + * This test occurs after Tcl_GetIndexFromObj() so that "event + * generate <Button> -xyz" will return the error message that + * "-xyz" is a bad option, rather than that the value for "-xyz" + * is missing. + */ + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL); + return TCL_ERROR; + } + + switch ((enum field) index) { + case EVENT_WARP: + if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) { + return TCL_ERROR; + } + if (!(flags & KEY_BUTTON_MOTION_VIRTUAL)) { + goto badopt; + } + break; + case EVENT_WHEN: + pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr, + queuePosition, valuePtr); + if ((int) pos < -1) { + return TCL_ERROR; + } + synch = 0; + if ((int) pos == -1) { + synch = 1; + } + break; + case EVENT_ABOVE: + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { + return TCL_ERROR; + } + if (flags & CONFIG) { + event.general.xconfigure.above = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; + case EVENT_BORDER: + if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & (CREATE|CONFIG)) { + event.general.xcreatewindow.border_width = number; + } else { + goto badopt; + } + break; + case EVENT_BUTTON: + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & BUTTON) { + event.general.xbutton.button = number; + } else { + goto badopt; + } + break; + case EVENT_COUNT: + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & EXPOSE) { + event.general.xexpose.count = number; + } else { + goto badopt; + } + break; + case EVENT_DATA: + if (flags & VIRTUAL) { + /* + * Do not increment reference count until after parsing + * completes and we know that the event generation is really + * going to happen. + */ + + userDataObj = valuePtr; + } else { + goto badopt; + } + break; + case EVENT_DELTA: + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if ((flags & KEY) && (event.general.xkey.type == MouseWheelEvent)) { + event.general.xkey.keycode = number; + } else { + goto badopt; + } + break; + case EVENT_DETAIL: + number = TkFindStateNumObj(interp, optionPtr, notifyDetail, + valuePtr); + if (number < 0) { + return TCL_ERROR; + } + if (flags & FOCUS) { + event.general.xfocus.detail = number; + } else if (flags & CROSSING) { + event.general.xcrossing.detail = number; + } else { + goto badopt; + } + break; + case EVENT_FOCUS: + if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & CROSSING) { + event.general.xcrossing.focus = number; + } else { + goto badopt; + } + break; + case EVENT_HEIGHT: + if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, + &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & EXPOSE) { + event.general.xexpose.height = number; + } else if (flags & CONFIG) { + event.general.xconfigure.height = number; + } else { + goto badopt; + } + break; + case EVENT_KEYCODE: + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if ((flags & KEY) && (event.general.xkey.type != MouseWheelEvent)) { + event.general.xkey.keycode = number; + } else { + goto badopt; + } + break; + case EVENT_KEYSYM: { + KeySym keysym; + const char *value; + + value = Tcl_GetString(valuePtr); + keysym = TkStringToKeysym(value); + if (keysym == NoSymbol) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value, + NULL); + return TCL_ERROR; + } + + TkpSetKeycodeAndState(tkwin, keysym, &event.general); + if (event.general.xkey.keycode == 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no keycode for keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value, + NULL); + return TCL_ERROR; + } + if (!(flags & KEY) + || (event.general.xkey.type == MouseWheelEvent)) { + goto badopt; + } + break; + } + case EVENT_MODE: + number = TkFindStateNumObj(interp,optionPtr,notifyMode,valuePtr); + if (number < 0) { + return TCL_ERROR; + } + if (flags & CROSSING) { + event.general.xcrossing.mode = number; + } else if (flags & FOCUS) { + event.general.xfocus.mode = number; + } else { + goto badopt; + } + break; + case EVENT_OVERRIDE: + if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & CREATE) { + event.general.xcreatewindow.override_redirect = number; + } else if (flags & MAP) { + event.general.xmap.override_redirect = number; + } else if (flags & REPARENT) { + event.general.xreparent.override_redirect = number; + } else if (flags & CONFIG) { + event.general.xconfigure.override_redirect = number; + } else { + goto badopt; + } + break; + case EVENT_PLACE: + number = TkFindStateNumObj(interp, optionPtr, circPlace, valuePtr); + if (number < 0) { + return TCL_ERROR; + } + if (flags & CIRC) { + event.general.xcirculate.place = number; + } else { + goto badopt; + } + break; + case EVENT_ROOT: + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.root = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; + case EVENT_ROOTX: + if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.x_root = number; + } else { + goto badopt; + } + break; + case EVENT_ROOTY: + if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.y_root = number; + } else { + goto badopt; + } + break; + case EVENT_SEND: { + const char *value; + + value = Tcl_GetString(valuePtr); + if (isdigit(UCHAR(value[0]))) { + /* + * Allow arbitrary integer values for the field; they are + * needed by a few of the tests in the Tk test suite. + */ + + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + } else { + if (Tcl_GetBooleanFromObj(interp,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + } + event.general.xany.send_event = number; + break; + } + case EVENT_SERIAL: + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + event.general.xany.serial = number; + break; + case EVENT_STATE: + if (flags & KEY_BUTTON_MOTION_CROSSING) { + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_VIRTUAL) { + event.general.xkey.state = number; + } else { + event.general.xcrossing.state = number; + } + } else if (flags & VISIBILITY) { + number = TkFindStateNumObj(interp, optionPtr, visNotify, + valuePtr); + if (number < 0) { + return TCL_ERROR; + } + event.general.xvisibility.state = number; + } else { + goto badopt; + } + break; + case EVENT_SUBWINDOW: + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.subwindow = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; + case EVENT_TIME: + if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.time = (Time) number; + } else if (flags & PROP) { + event.general.xproperty.time = (Time) number; + } else { + goto badopt; + } + break; + case EVENT_WIDTH: + if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & EXPOSE) { + event.general.xexpose.width = number; + } else if (flags & (CREATE|CONFIG)) { + event.general.xcreatewindow.width = number; + } else { + goto badopt; + } + break; + case EVENT_WINDOW: + if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { + return TCL_ERROR; + } + if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) { + event.general.xcreatewindow.window = Tk_WindowId(tkwin2); + } else { + goto badopt; + } + break; + case EVENT_X: + if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.x = number; + + /* + * Only modify rootx as well if it hasn't been changed. + */ + + if (event.general.xkey.x_root == -1) { + int rootX, rootY; + + Tk_GetRootCoords(tkwin, &rootX, &rootY); + event.general.xkey.x_root = rootX + number; + } + } else if (flags & EXPOSE) { + event.general.xexpose.x = number; + } else if (flags & (CREATE|CONFIG|GRAVITY)) { + event.general.xcreatewindow.x = number; + } else if (flags & REPARENT) { + event.general.xreparent.x = number; + } else { + goto badopt; + } + break; + case EVENT_Y: + if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { + return TCL_ERROR; + } + if (flags & KEY_BUTTON_MOTION_CROSSING) { + event.general.xkey.y = number; + + /* + * Only modify rooty as well if it hasn't been changed. + */ + + if (event.general.xkey.y_root == -1) { + int rootX, rootY; + + Tk_GetRootCoords(tkwin, &rootX, &rootY); + event.general.xkey.y_root = rootY + number; + } + } else if (flags & EXPOSE) { + event.general.xexpose.y = number; + } else if (flags & (CREATE|CONFIG|GRAVITY)) { + event.general.xcreatewindow.y = number; + } else if (flags & REPARENT) { + event.general.xreparent.y = number; + } else { + goto badopt; + } + break; + } + continue; + + badopt: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s event doesn't accept \"%s\" option", + name, Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL); + return TCL_ERROR; + } + + /* + * Don't generate events for windows that don't exist yet. + */ + + if (!event.general.xany.window) { + goto done; + } + + if (userDataObj != NULL) { + + /* + * Must be virtual event to set that variable to non-NULL. Now we want + * to install the object into the event. Note that we must incr the + * refcount before firing it into the low-level event subsystem; the + * refcount will be decremented once the event has been processed. + */ + + event.virtual.user_data = userDataObj; + Tcl_IncrRefCount(userDataObj); + } + + /* + * Now we have constructed the event, inject it into the event handling + * code. + */ + + if (synch != 0) { + Tk_HandleEvent(&event.general); + } else { + Tk_QueueWindowEvent(&event.general, pos); + } + + /* + * We only allow warping if the window is mapped. + */ + + if ((warp != 0) && Tk_IsMapped(tkwin)) { + TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display); + + if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) { + Tcl_DoWhenIdle(DoWarp, dispPtr); + dispPtr->flags |= TK_DISPLAY_IN_WARP; + } + dispPtr->warpWindow = Tk_IdToWindow(Tk_Display(mainWin), + event.general.xmotion.window); + dispPtr->warpMainwin = mainWin; + dispPtr->warpX = event.general.xmotion.x; + dispPtr->warpY = event.general.xmotion.y; + } + + done: + Tcl_ResetResult(interp); + return TCL_OK; +} + +static int +NameToWindow( + Tcl_Interp *interp, /* Interp for error return and name lookup. */ + Tk_Window mainWin, /* Main window of application. */ + Tcl_Obj *objPtr, /* Contains name or id string of window. */ + Tk_Window *tkwinPtr) /* Filled with token for window. */ +{ + const char *name = Tcl_GetString(objPtr); + Tk_Window tkwin; + + if (name[0] == '.') { + tkwin = Tk_NameToWindow(interp, name, mainWin); + if (tkwin == NULL) { + return TCL_ERROR; + } + } else { + Window id; + + /* + * Check for the winPtr being valid, even if it looks ok to + * TkpScanWindowId. [Bug #411307] + */ + + if (TkpScanWindowId(NULL, name, &id) != TCL_OK) { + goto badWindow; + } + tkwin = Tk_IdToWindow(Tk_Display(mainWin), id); + if (tkwin == NULL) { + goto badWindow; + } + } + *tkwinPtr = tkwin; + return TCL_OK; + + badWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window name/identifier \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL); + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------- + * + * DoWarp -- + * + * Perform Warping of X pointer. Executed as an idle handler only. + * + * Results: + * None + * + * Side effects: + * X Pointer will move to a new location. + * + *------------------------------------------------------------------------- + */ + +static void +DoWarp( + ClientData clientData) +{ + TkDisplay *dispPtr = clientData; + + /* + * DoWarp was scheduled only if the window was mapped. It needs to be + * still mapped at the time the present idle callback is executed. Also + * one needs to guard against window destruction in the meantime. + * Finally, the case warpWindow == NULL is special in that it means + * the whole screen. + */ + + if ((dispPtr->warpWindow == NULL) || + (Tk_IsMapped(dispPtr->warpWindow) + && (Tk_WindowId(dispPtr->warpWindow) != None))) { + TkpWarpPointer(dispPtr); + XForceScreenSaver(dispPtr->display, ScreenSaverReset); + } + dispPtr->flags &= ~TK_DISPLAY_IN_WARP; +} + +/* + *------------------------------------------------------------------------- + * + * GetVirtualEventUid -- + * + * Determine if the given string is in the proper format for a virtual + * event. + * + * Results: + * The return value is NULL if the virtual event string was not in the + * proper format. In this case, an error message will be left in the + * interp's result. Otherwise the return value is a Tk_Uid that + * represents the virtual event. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static Tk_Uid +GetVirtualEventUid( + Tcl_Interp *interp, + char *virtString) +{ + Tk_Uid uid; + size_t length; + + length = strlen(virtString); + + if (length < 5 || virtString[0] != '<' || virtString[1] != '<' || + virtString[length - 2] != '>' || virtString[length - 1] != '>') { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "virtual event \"%s\" is badly formed", virtString)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); + return NULL; + } + virtString[length - 2] = '\0'; + uid = Tk_GetUid(virtString + 2); + virtString[length - 2] = '>'; + + return uid; +} + +/* + *---------------------------------------------------------------------- + * + * FindSequence -- + * + * Find the entry in the pattern table that corresponds to a particular + * pattern string, and return a pointer to that entry. + * + * Results: + * The return value is normally a pointer to the PatSeq in patternTable + * that corresponds to eventString. If an error was found while parsing + * eventString, or if "create" is 0 and no pattern sequence previously + * existed, then NULL is returned and the interp's result contains a + * message describing the problem. If no pattern sequence previously + * existed for eventString, then a new one is created with a NULL command + * field. In a successful return, *maskPtr is filled in with a mask of + * the event types on which the pattern sequence depends. + * + * Side effects: + * A new pattern sequence may be allocated. + * + *---------------------------------------------------------------------- + */ + +static PatSeq * +FindSequence( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + Tcl_HashTable *patternTablePtr, + /* Table to use for lookup. */ + ClientData object, /* For binding table, token for object with + * which binding is associated. For virtual + * event table, NULL. */ + const char *eventString, /* String description of pattern to match on. + * See user documentation for details. */ + int create, /* 0 means don't create the entry if it + * doesn't already exist. Non-zero means + * create. */ + int allowVirtual, /* 0 means that virtual events are not allowed + * in the sequence. Non-zero otherwise. */ + unsigned long *maskPtr) /* *maskPtr is filled in with the event types + * on which this pattern sequence depends. */ +{ + TkPattern pats[EVENT_BUFFER_SIZE]; + int numPats, virtualFound; + const char *p; + TkPattern *patPtr; + PatSeq *psPtr; + Tcl_HashEntry *hPtr; + int flags, count, isNew; + size_t sequenceSize; + unsigned long eventMask; + PatternTableKey key; + + /* + *------------------------------------------------------------- + * Step 1: parse the pattern string to produce an array of Patterns. The + * array is generated backwards, so that the lowest-indexed pattern + * corresponds to the last event that must occur. + *------------------------------------------------------------- + */ + + p = eventString; + flags = 0; + eventMask = 0; + virtualFound = 0; + + patPtr = &pats[EVENT_BUFFER_SIZE-1]; + for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) { + while (isspace(UCHAR(*p))) { + p++; + } + if (*p == '\0') { + break; + } + + count = ParseEventDescription(interp, &p, patPtr, &eventMask); + if (count == 0) { + return NULL; + } + + if (eventMask & VirtualEventMask) { + if (allowVirtual == 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual event not allowed in definition of another virtual event", + -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", + NULL); + return NULL; + } + virtualFound = 1; + } + + /* + * Replicate events for DOUBLE, TRIPLE, QUADRUPLE. + */ + + while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) { + flags |= PAT_NEARBY; + patPtr[-1] = patPtr[0]; + patPtr--; + numPats++; + } + } + + /* + *------------------------------------------------------------- + * Step 2: find the sequence in the binding table if it exists, and add a + * new sequence to the table if it doesn't. + *------------------------------------------------------------- + */ + + if (numPats == 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no events specified in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL); + return NULL; + } + if ((numPats > 1) && (virtualFound != 0)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual events may not be composed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", + NULL); + 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, &isNew); + sequenceSize = numPats*sizeof(TkPattern); + if (!isNew) { + for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; + psPtr = psPtr->nextSeqPtr) { + if ((numPats == psPtr->numPats) + && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY)) + && (memcmp(patPtr, psPtr->pats, sequenceSize) == 0)) { + goto done; + } + } + } + if (!create) { + if (isNew) { + Tcl_DeleteHashEntry(hPtr); + } + + /* + * No binding exists for the sequence, so return an empty error. This + * is a special error that the caller will check for in order to + * silently ignore this case. This is a hack that maintains backward + * compatibility for Tk_GetBinding but the various "bind" commands + * silently ignore missing bindings. + */ + + return NULL; + } + psPtr = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(TkPattern)); + psPtr->numPats = numPats; + psPtr->script = NULL; + psPtr->flags = flags; + psPtr->nextSeqPtr = Tcl_GetHashValue(hPtr); + psPtr->hPtr = hPtr; + psPtr->voPtr = NULL; + psPtr->nextObjPtr = NULL; + Tcl_SetHashValue(hPtr, psPtr); + + memcpy(psPtr->pats, 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 function can be called repeatedly to parse + * all the events in the entire sequence. + * + *--------------------------------------------------------------------------- + */ + +static int +ParseEventDescription( + Tcl_Interp *interp, /* For error messages. */ + const char **eventStringPtr,/* On input, holds a pointer to start of event + * string. On exit, gets pointer to rest of + * string after parsed event. */ + TkPattern *patPtr, /* Filled with the pattern parsed from the + * event string. */ + unsigned long *eventMaskPtr)/* Filled with event mask of matched event. */ +{ + char *p; + unsigned long eventMask; + int count, eventFlags; +#define FIELD_SIZE 48 + char field[FIELD_SIZE]; + Tcl_HashEntry *hPtr; + Tcl_DString copy; + + Tcl_DStringInit(©); + p = Tcl_DStringAppend(©, *eventStringPtr, -1); + + patPtr->eventType = -1; + patPtr->needMods = 0; + patPtr->detail.clientData = 0; + + eventMask = 0; + count = 1; + + /* + * Handle simple ASCII characters. + */ + + if (*p != '<') { + char string[2]; + + patPtr->eventType = KeyPress; + eventMask = KeyPressMask; + string[0] = *p; + string[1] = 0; + patPtr->detail.keySym = TkStringToKeysym(string); + if (patPtr->detail.keySym == NoSymbol) { + if (isprint(UCHAR(*p))) { + patPtr->detail.keySym = *p; + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ASCII character 0x%x", UCHAR(*p))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL); + count = 0; + goto done; + } + } + p++; + goto end; + } + + /* + * A fancier event description. This can be either a virtual event or a + * physical event. + * + * A virtual event description consists of: + * + * 1. double open angle brackets. + * 2. virtual event name. + * 3. double close angle brackets. + * + * A physical event description consists of: + * + * 1. open angle bracket. + * 2. any number of modifiers, each followed by spaces or dashes. + * 3. an optional event name. + * 4. an option button or keysym name. Either this or item 3 *must* be + * present; if both are present then they are separated by spaces or + * dashes. + * 5. a close angle bracket. + */ + + p++; + if (*p == '<') { + /* + * This is a virtual event: soak up all the characters up to the next + * '>'. + */ + + char *field = p + 1; + + p = strchr(field, '>'); + if (p == field) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual event \"<<>>\" is badly formed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); + count = 0; + goto done; + } + if ((p == NULL) || (p[1] != '>')) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in virtual binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); + count = 0; + goto done; + } + *p = '\0'; + patPtr->eventType = VirtualEvent; + eventMask = VirtualEventMask; + patPtr->detail.name = Tk_GetUid(field); + *p = '>'; + + p += 2; + goto end; + } + + while (1) { + ModInfo *modPtr; + + p = GetField(p, field, FIELD_SIZE); + if (*p == '>') { + /* + * This solves the problem of, e.g., <Control-M> being + * misinterpreted as Control + Meta + missing keysym instead of + * Control + KeyPress + M. + */ + + break; + } + hPtr = Tcl_FindHashEntry(&modTable, field); + if (hPtr == NULL) { + break; + } + modPtr = Tcl_GetHashValue(hPtr); + patPtr->needMods |= modPtr->mask; + if (modPtr->flags & MULT_CLICKS) { + int i = modPtr->flags & MULT_CLICKS; + + count = 2; + while (i >>= 1) { + count++; + } + } + while ((*p == '-') || isspace(UCHAR(*p))) { + p++; + } + } + + eventFlags = 0; + hPtr = Tcl_FindHashEntry(&eventTable, field); + if (hPtr != NULL) { + const EventInfo *eiPtr = 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)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified button \"%s\" for non-button event", + field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL); + count = 0; + goto done; + } + patPtr->detail.button = (*field - '0'); + } else { + + getKeysym: + patPtr->detail.keySym = TkStringToKeysym(field); + if (patPtr->detail.keySym == NoSymbol) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad event type or keysym \"%s\"", field)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field, + NULL); + count = 0; + goto done; + } + if (eventFlags == 0) { + patPtr->eventType = KeyPress; + eventMask = KeyPressMask; + } else if (!(eventFlags & KEY)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified keysym \"%s\" for non-key event", field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL); + count = 0; + goto done; + } + } + } else if (eventFlags == 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no event type or button # or keysym", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); + count = 0; + goto done; + } + + while ((*p == '-') || isspace(UCHAR(*p))) { + p++; + } + if (*p != '>') { + while (*p != '\0') { + p++; + if (*p == '>') { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after detail in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); + count = 0; + goto done; + } + } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); + count = 0; + goto done; + } + p++; + + end: + *eventStringPtr += (p - Tcl_DStringValue(©)); + *eventMaskPtr |= eventMask; + done: + Tcl_DStringFree(©); + 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( + 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; +} + +/* + *--------------------------------------------------------------------------- + * + * GetPatternObj -- + * + * Produce a string version of the given event, for displaying to the + * user. + * + * Results: + * The string is returned as a Tcl_Obj. + * + * Side effects: + * It is the caller's responsibility to arrange for the object to be + * released; it starts with a refCount of zero. + * + *--------------------------------------------------------------------------- + */ + +static Tcl_Obj * +GetPatternObj( + PatSeq *psPtr) +{ + TkPattern *patPtr; + int patsLeft, needMods; + const ModInfo *modPtr; + const EventInfo *eiPtr; + Tcl_Obj *patternObj = Tcl_NewObj(); + + /* + * 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) + && (patPtr->needMods == 0) + && (patPtr->detail.keySym < 128) + && isprint(UCHAR(patPtr->detail.keySym)) + && (patPtr->detail.keySym != '<') + && (patPtr->detail.keySym != ' ')) { + char c = (char) patPtr->detail.keySym; + + Tcl_AppendToObj(patternObj, &c, 1); + continue; + } + + /* + * Check for virtual event. + */ + + if (patPtr->eventType == VirtualEvent) { + Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name); + continue; + } + + /* + * It's a more general event specification. First check for "Double", + * "Triple", "Quadruple", then modifiers, then event type, then keysym + * or button detail. + */ + + Tcl_AppendToObj(patternObj, "<", 1); + + if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) + && (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { + patsLeft--; + patPtr--; + if ((patsLeft > 1) && + (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { + patsLeft--; + patPtr--; + if ((patsLeft > 1) && + (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { + patsLeft--; + patPtr--; + Tcl_AppendToObj(patternObj, "Quadruple-", 10); + } else { + Tcl_AppendToObj(patternObj, "Triple-", 7); + } + } else { + Tcl_AppendToObj(patternObj, "Double-", 7); + } + } + + for (needMods = patPtr->needMods, modPtr = modArray; + needMods != 0; modPtr++) { + if (modPtr->mask & needMods) { + needMods &= ~modPtr->mask; + Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name); + } + } + + for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { + if (eiPtr->type == patPtr->eventType) { + Tcl_AppendToObj(patternObj, eiPtr->name, -1); + if (patPtr->detail.clientData != 0) { + Tcl_AppendToObj(patternObj, "-", 1); + } + break; + } + } + + if (patPtr->detail.clientData != 0) { + if ((patPtr->eventType == KeyPress) + || (patPtr->eventType == KeyRelease)) { + const char *string = TkKeysymToString(patPtr->detail.keySym); + + if (string != NULL) { + Tcl_AppendToObj(patternObj, string, -1); + } + } else { + Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button); + } + } + + Tcl_AppendToObj(patternObj, ">", 1); + } + + return patternObj; +} + +/* + *---------------------------------------------------------------------- + * + * TkStringToKeysym -- + * + * This function 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( + const char *name) /* Name of a keysym. */ +{ +#ifdef REDO_KEYSYM_LOOKUP + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&keySymTable, name); + + if (hPtr != NULL) { + return (KeySym) Tcl_GetHashValue(hPtr); + } + if (strlen(name) == 1) { + KeySym keysym = (KeySym) (unsigned char) name[0]; + + if (TkKeysymToString(keysym) != NULL) { + return keysym; + } + } +#endif /* REDO_KEYSYM_LOOKUP */ + return XStringToKeysym(name); +} + +/* + *---------------------------------------------------------------------- + * + * TkKeysymToString -- + * + * This function 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. + * + *---------------------------------------------------------------------- + */ + +const char * +TkKeysymToString( + KeySym keysym) +{ +#ifdef REDO_KEYSYM_LOOKUP + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym); + + if (hPtr != NULL) { + return Tcl_GetHashValue(hPtr); + } +#endif /* REDO_KEYSYM_LOOKUP */ + + return XKeysymToString(keysym); +} + +/* + *---------------------------------------------------------------------- + * + * TkpGetBindingXEvent -- + * + * This function returns the XEvent associated with the currently + * executing binding. This function can only be invoked while a binding + * is executing. + * + * Results: + * Returns a pointer to the XEvent that caused the current binding code + * to be run. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +XEvent * +TkpGetBindingXEvent( + Tcl_Interp *interp) /* Interpreter. */ +{ + TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp); + BindingTable *bindPtr = winPtr->mainPtr->bindingTable; + + return &(bindPtr->eventRing[bindPtr->curEvent]); +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |