diff options
Diffstat (limited to 'tk8.6/generic/tkBind.c')
| -rw-r--r-- | tk8.6/generic/tkBind.c | 4351 |
1 files changed, 0 insertions, 4351 deletions
diff --git a/tk8.6/generic/tkBind.c b/tk8.6/generic/tkBind.c deleted file mode 100644 index 285b3f7..0000000 --- a/tk8.6/generic/tkBind.c +++ /dev/null @@ -1,4351 +0,0 @@ -/* - * 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; - } - } - - /* - * Ignore event types which are not in flagArray and all zeroes there. - * Most notably, NoExpose events can fill the ring buffer and disturb - * (thus masking out) event sequences of interest. - */ - - if ((eventPtr->type >= TK_LASTEVENT) || !flagArray[eventPtr->type]) { - 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 synchronously 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); - -Tk_Window warpWindow = Tk_IdToWindow(dispPtr->display, - event.general.xmotion.window); - - if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) { - Tcl_DoWhenIdle(DoWarp, dispPtr); - dispPtr->flags |= TK_DISPLAY_IN_WARP; - } - - if (warpWindow != dispPtr->warpWindow) { - if (warpWindow) { - Tcl_Preserve(warpWindow); - } - if (dispPtr->warpWindow) { - Tcl_Release(dispPtr->warpWindow); - } - dispPtr->warpWindow = warpWindow; - } - 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); - } - - if (dispPtr->warpWindow) { - Tcl_Release(dispPtr->warpWindow); - dispPtr->warpWindow = None; - } - 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]); -} - -/* - *---------------------------------------------------------------------- - * - * TkpCancelWarp -- - * - * This function cancels an outstanding pointer warp and - * is called during tear down of the display. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -TkpCancelWarp( - TkDisplay *dispPtr) -{ - if (dispPtr->flags & TK_DISPLAY_IN_WARP) { - Tcl_CancelIdleCall(DoWarp, dispPtr); - dispPtr->flags &= ~TK_DISPLAY_IN_WARP; - } -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |