/*
* 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.
*
* RCS: @(#) $Id: tkBind.c,v 1.50 2008/11/25 11:19:03 dkf Exp $
*/
#include "tkInt.h"
#ifdef __WIN32__
#include "tkWinInt.h"
#endif
#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* UNIX */
#include "tkUnixInt.h"
#endif
/*
* File structure:
*
* Structure definitions and static variables.
*
* Init/Free this package.
*
* Tcl "bind" command (actually located in tkCmds.c) 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 BindingTable {
XEvent eventRing[EVENT_BUFFER_SIZE];
/* Circular queue of recent events (higher
* indices are for more recent events). */
Detail detailRing[EVENT_BUFFER_SIZE];
/* "Detail" information (keySym, button,
* Tk_Uid, or 0) for each entry in
* eventRing. */
int curEvent; /* Index in eventRing of most recent event.
* Newer events have higher indices. */
Tcl_HashTable patternTable; /* Used to map from an event to a list of
* patterns that may match that event. Keys
* are PatternTableKey structs, values are
* (PatSeq *). */
Tcl_HashTable objectTable; /* Used to map from an object to a list of
* patterns associated with that object. Keys
* are ClientData, values are (PatSeq *). */
Tcl_Interp *interp; /* Interpreter in which commands are
* executed. */
} BindingTable;
/*
* The following structure represents virtual event table. A virtual event
* table provides a way to map from platform-specific physical events such as
* button clicks or key presses to virtual events such as <<Paste>>,
* <<Close>>, or <<ScrollWindow>>.
*
* A virtual event is usually never part of the event stream, but instead is
* synthesized inline by matching low-level events. However, a virtual event
* may be generated by platform-specific code or by Tcl scripts. In that case,
* no lookup of the virtual event will need to be done using this table,
* because the virtual event is actually in the event stream.
*/
typedef struct VirtualEventTable {
Tcl_HashTable patternTable; /* Used to map from a physical event to a list
* of patterns that may match that event. Keys
* are PatternTableKey structs, values are
* (PatSeq *). */
Tcl_HashTable nameTable; /* Used to map a virtual event name to the
* array of physical events that can trigger
* it. Keys are the Tk_Uid names of the
* virtual events, values are PhysicalsOwned
* structs. */
} VirtualEventTable;
/*
* The following structure is used as a key in a patternTable for both binding
* tables and a virtual event tables.
*
* In a binding table, the object field corresponds to the binding tag for the
* widget whose bindings are being accessed.
*
* In a virtual event table, the object field is always NULL. Virtual events
* are a global definiton and are not tied to a particular binding tag.
*
* The same key is used for both types of pattern tables so that the helper
* functions that traverse and match patterns will work for both binding
* tables and virtual event tables.
*/
typedef struct PatternTableKey {
ClientData object; /* For binding table, identifies the binding
* tag of the object (or class of objects)
* relative to which the event occurred. For
* virtual event table, always NULL. */
int type; /* Type of event (from X). */
Detail detail; /* Additional information, such as keysym,
* button, Tk_Uid, or 0 if nothing
* additional. */
} PatternTableKey;
/*
* The following structure defines a pattern, which is matched against X
* events as part of the process of converting X events into Tcl commands.
*/
typedef struct Pattern {
int eventType; /* Type of X event, e.g. ButtonPress. */
int needMods; /* Mask of modifiers that must be present (0
* means no modifiers are required). */
Detail detail; /* Additional information that must match
* event. Normally this is 0, meaning no
* additional information must match. For
* KeyPress and KeyRelease events, a keySym
* may be specified to select a particular
* keystroke (0 means any keystrokes). For
* button events, specifies a particular
* button (0 means any buttons are OK). For
* virtual events, specifies the Tk_Uid of the
* virtual event name (never 0). */
} Pattern;
/*
* The following structure defines a pattern sequence, which consists of one
* or more patterns. In order to trigger, a pattern sequence must match the
* most recent X events (first pattern to most recent event, next pattern to
* next event, and so on). It is used as the hash value in a patternTable for
* both binding tables and virtual event tables.
*
* In a binding table, it is the sequence of physical events that make up a
* binding for an object.
*
* In a virtual event table, it is the sequence of physical events that define
* a virtual event.
*
* The same structure is used for both types of pattern tables so that the
* helper functions that traverse and match patterns will work for both
* binding tables and virtual event tables.
*/
typedef struct PatSeq {
int numPats; /* Number of patterns in sequence (usually
* 1). */
TkBindEvalProc *eventProc; /* The function that will be invoked on the
* clientData when this pattern sequence
* matches. */
TkBindFreeProc *freeProc; /* The function that will be invoked to
* release the clientData when this pattern
* sequence is freed. */
ClientData clientData; /* Arbitray data passed to eventProc and
* freeProc when sequence matches. */
int flags; /* Miscellaneous flag values; see below for
* definitions. */
int refCount; /* Number of times that this binding is in the
* midst of executing. If greater than 1, then
* a recursive invocation is happening. Only
* when this is zero can the binding actually
* be freed. */
struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences that
* have the same initial pattern. NULL means
* end of list. */
Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the initial
* pattern. This is the head of the list of
* which nextSeqPtr forms a part. */
struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
* virtual event table, identifies the array
* of virtual events that can be triggered by
* this event. */
struct PatSeq *nextObjPtr; /* In a binding table, next in list of all
* pattern sequences for the same object (NULL
* for end of list). Needed to implement
* Tk_DeleteAllBindings. In a virtual event
* table, always NULL. */
Pattern pats[1]; /* Array of "numPats" patterns. Only one
* element is declared here but in actuality
* enough space will be allocated for
* "numPats" patterns. To match, pats[0] must
* match event n, pats[1] must match event
* n-1, etc. */
} PatSeq;
/*
* Flag values for PatSeq structures:
*
* PAT_NEARBY 1 means that all of the events matching this sequence
* must occur with nearby X and Y mouse coordinates and
* close in time. This is typically used to restrict
* multiple button presses.
* MARKED_DELETED 1 means that this binding has been marked as deleted
* and removed from the binding table, but its memory
* could not be released because it was already queued
* for execution. When the binding is actually about to
* be executed, this flag will be checked and the binding
* skipped if set.
*/
#define PAT_NEARBY 0x1
#define MARKED_DELETED 0x2
/*
* Constants that define how close together two events must be in milliseconds
* or pixels to meet the PAT_NEARBY constraint:
*/
#define NEARBY_PIXELS 5
#define NEARBY_MS 500
/*
* The following structure keeps track of all the virtual events that are
* associated with a particular physical event. It is pointed to by the voPtr
* field in a PatSeq in the patternTable of a virtual event table.
*/
typedef struct VirtualOwners {
int numOwners; /* Number of virtual events to trigger. */
Tcl_HashEntry *owners[1]; /* Array of pointers to entries in nameTable.
* Enough space will actually be allocated for
* numOwners hash entries. */
} VirtualOwners;
/*
* The following structure is used in the nameTable of a virtual event table
* to associate a virtual event with all the physical events that can trigger
* it.
*/
typedef struct PhysicalsOwned {
int numOwned; /* Number of physical events owned. */
PatSeq *patSeqs[1]; /* Array of pointers to physical event
* patterns. Enough space will actually be
* allocated to hold numOwned. */
} PhysicalsOwned;
/*
* One of the following structures exists for each interpreter. This structure
* keeps track of the current display and screen in the interpreter, so that a
* script can be invoked whenever the display/screen changes (the script does
* things like point tk::Priv at a display-specific structure).
*/
typedef struct {
TkDisplay *curDispPtr; /* Display for last binding command invoked in
* this application. */
int curScreenIndex; /* Index of screen for last binding command */
int bindingDepth; /* Number of active instances of Tk_BindEvent
* in this application. */
} ScreenInfo;
/*
* The following structure is used to keep track of all the C bindings that
* are awaiting invocation and whether the window they refer to has been
* destroyed. If the window is destroyed, then all pending callbacks for that
* window will be cancelled. The Tcl bindings will still all be invoked,
* however.
*/
typedef struct PendingBinding {
struct PendingBinding *nextPtr;
/* Next in chain of pending bindings, in case
* a recursive binding evaluation is in
* progress. */
Tk_Window tkwin; /* The window that the following bindings
* depend upon. */
int deleted; /* Set to non-zero by window cleanup code if
* tkwin is deleted. */
PatSeq *matchArray[5]; /* Array of pending C bindings. The actual
* size of this depends on how many C bindings
* matched the event passed to Tk_BindEvent.
* THIS FIELD MUST BE THE LAST IN THE
* STRUCTURE. */
} PendingBinding;
/*
* The following structure keeps track of all the information local to the
* binding package on a per interpreter basis.
*/
typedef struct BindInfo {
VirtualEventTable virtualEventTable;
/* The virtual events that exist in this
* interpreter. */
ScreenInfo screenInfo; /* Keeps track of the current display and
* screen, so it can be restored after a
* binding has executed. */
PendingBinding *pendingList;/* The list of pending C bindings, kept in
* case a C or Tcl binding causes the target
* window to be deleted. */
int deleted; /* 1 the application has been deleted but the
* structure has been preserved. */
} BindInfo;
/*
* In X11R4 and earlier versions, XStringToKeysym is ridiculously slow. The
* data structure and hash table below, along with the code that uses them,
* implement a fast mapping from strings to keysyms. In X11R5 and later
* releases XStringToKeysym is plenty fast so this stuff isn't needed. The
* #define REDO_KEYSYM_LOOKUP is normally undefined, so that XStringToKeysym
* gets used. It can be set in the Makefile to enable the use of the hash
* table below.
*/
#ifdef REDO_KEYSYM_LOOKUP
typedef struct {
const char *name; /* Name of keysym. */
KeySym value; /* Numeric identifier for keysym. */
} KeySymInfo;
static 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 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 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,
char *eventString);
static int DeleteVirtualEvent(Tcl_Interp *interp,
VirtualEventTable *vetPtr, char *virtString,
char *eventString);
static void DeleteVirtualEventTable(VirtualEventTable *vetPtr);
static void ExpandPercents(TkWindow *winPtr, const char *before,
XEvent *eventPtr,KeySym keySym,Tcl_DString *dsPtr);
static void FreeTclBinding(ClientData clientData);
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 void GetPatternString(PatSeq *psPtr, Tcl_DString *dsPtr);
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, Pattern *patPtr,
unsigned long *eventMaskPtr);
static void DoWarp(ClientData clientData);
/*
* The following define is used as a short circuit for the callback function
* to evaluate a TclBinding. The actual evaluation of the binding is handled
* inline, because special things have to be done with a Tcl binding before
* evaluation time.
*/
#define EvalTclBinding ((TkBindEvalProc *) 1)
/*
*---------------------------------------------------------------------------
*
* TkBindInit --
*
* This 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;
EventInfo *eiPtr;
int newEntry;
#ifdef REDO_KEYSYM_LOOKUP
KeySymInfo *kPtr;
Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &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 = (BindInfo *) ckalloc(sizeof(BindInfo));
InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
bindInfoPtr->screenInfo.curDispPtr = NULL;
bindInfoPtr->screenInfo.curScreenIndex = -1;
bindInfoPtr->screenInfo.bindingDepth = 0;
bindInfoPtr->pendingList = NULL;
bindInfoPtr->deleted = 0;
mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
}
/*
*---------------------------------------------------------------------------
*
* TkBindFree --
*
* This 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 = (BindInfo *) 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;
int i;
/*
* Create and initialize a new binding table.
*/
bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
bindPtr->eventRing[i].type = -1;
}
bindPtr->curEvent = 0;
Tcl_InitHashTable(&bindPtr->patternTable,
sizeof(PatternTableKey)/sizeof(int));
Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
bindPtr->interp = interp;
return (Tk_BindingTable) bindPtr;
}
/*
*--------------------------------------------------------------
*
* Tk_DeleteBindingTable --
*
* Destroy a binding table and free up all its memory. The caller should
* not use bindingTable again after this function returns.
*
* Results:
* None.
*
* Side effects:
* Memory is freed.
*
*--------------------------------------------------------------
*/
void
Tk_DeleteBindingTable(
Tk_BindingTable bindingTable)
/* Token for the binding table to destroy. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr, *nextPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
/*
* Find and delete all of the patterns associated with the binding table.
*/
for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) {
nextPtr = psPtr->nextSeqPtr;
psPtr->flags |= MARKED_DELETED;
if (psPtr->refCount == 0) {
if (psPtr->freeProc != NULL) {
psPtr->freeProc(psPtr->clientData);
}
ckfree((char *) psPtr);
}
}
}
/*
* Clean up the rest of the information associated with the binding table.
*/
Tcl_DeleteHashTable(&bindPtr->patternTable);
Tcl_DeleteHashTable(&bindPtr->objectTable);
ckfree((char *) bindPtr);
}
/*
*--------------------------------------------------------------
*
* Tk_CreateBinding --
*
* Add a binding to a binding table, so that future calls to Tk_BindEvent
* may execute the command in the binding.
*
* Results:
* The return value is 0 if an error occurred while setting up the
* binding. In this case, an error message will be left in the interp's
* result. If all went well then the return value is a mask of the event
* types that must be made available to Tk_BindEvent in order to properly
* detect when this binding triggers. This value can be used to determine
* what events to select for in a window, for example.
*
* Side effects:
* An existing binding on the same event sequence may be replaced. The
* new binding may cause future calls to Tk_BindEvent to behave
* differently than they did previously.
*
*--------------------------------------------------------------
*/
unsigned long
Tk_CreateBinding(
Tcl_Interp *interp, /* Used for error reporting. */
Tk_BindingTable bindingTable,
/* Table in which to create binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString, /* String describing event sequence that
* triggers binding. */
const char *command, /* Contains Tcl command to execute when
* binding triggers. */
int append) /* 0 means replace any existing binding for
* eventString; 1 means append to that
* binding. If the existing binding is for a
* callback function and not a Tcl command
* string, the existing binding will always be
* replaced. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
unsigned long eventMask;
char *newStr, *oldStr;
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
1, 1, &eventMask);
if (psPtr == NULL) {
return 0;
}
if (psPtr->eventProc == 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);
} else if (psPtr->eventProc != EvalTclBinding) {
/*
* Free existing procedural binding.
*/
if (psPtr->freeProc != NULL) {
psPtr->freeProc(psPtr->clientData);
}
psPtr->clientData = NULL;
append = 0;
}
oldStr = psPtr->clientData;
if ((append != 0) && (oldStr != NULL)) {
size_t length1 = strlen(oldStr), length2 = strlen(command);
newStr = ckalloc((unsigned) length1 + length2 + 2);
memcpy(newStr, oldStr, length1);
newStr[length1] = '\n';
memcpy(newStr+length1+1, command, length2+1);
} else {
size_t length = strlen(command);
newStr = ckalloc((unsigned) length+1);
memcpy(newStr, command, length+1);
}
if (oldStr != NULL) {
ckfree(oldStr);
}
psPtr->eventProc = EvalTclBinding;
psPtr->freeProc = FreeTclBinding;
psPtr->clientData = newStr;
return eventMask;
}
/*
*---------------------------------------------------------------------------
*
* TkCreateBindingFunction --
*
* Add a C binding to a binding table, so that future calls to
* Tk_BindEvent may callback the function in the binding.
*
* Results:
* The return value is 0 if an error occurred while setting up the
* binding. In this case, an error message will be left in the interp's
* result. If all went well then the return value is a mask of the event
* types that must be made available to Tk_BindEvent in order to properly
* detect when this binding triggers. This value can be used to determine
* what events to select for in a window, for example.
*
* Side effects:
* Any existing binding on the same event sequence will be replaced.
*
*---------------------------------------------------------------------------
*/
unsigned long
TkCreateBindingProcedure(
Tcl_Interp *interp, /* Used for error reporting. */
Tk_BindingTable bindingTable,
/* Table in which to create binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString, /* String describing event sequence that
* triggers binding. */
TkBindEvalProc *eventProc, /* Function to invoke when binding triggers.
* Must not be NULL. */
TkBindFreeProc *freeProc, /* Function to invoke when binding is freed.
* May be NULL for no function. */
ClientData clientData) /* Arbitrary ClientData to pass to eventProc
* and freeProc. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
unsigned long eventMask;
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
1, 1, &eventMask);
if (psPtr == NULL) {
return 0;
}
if (psPtr->eventProc == NULL) {
int 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);
} else {
/*
* Free existing callback.
*/
if (psPtr->freeProc != NULL) {
psPtr->freeProc(psPtr->clientData);
}
}
psPtr->eventProc = eventProc;
psPtr->freeProc = freeProc;
psPtr->clientData = clientData;
return eventMask;
}
/*
*--------------------------------------------------------------
*
* Tk_DeleteBinding --
*
* Remove an event binding from a binding table.
*
* Results:
* The result is a standard Tcl return value. If an error occurs then the
* interp's result will contain an error message.
*
* Side effects:
* The binding given by object and eventString is removed from
* bindingTable.
*
*--------------------------------------------------------------
*/
int
Tk_DeleteBinding(
Tcl_Interp *interp, /* Used for error reporting. */
Tk_BindingTable bindingTable,
/* Table in which to delete binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString) /* String describing event sequence that
* triggers binding. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr, *prevPtr;
unsigned long eventMask;
Tcl_HashEntry *hPtr;
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
0, 1, &eventMask);
if (psPtr == NULL) {
Tcl_ResetResult(interp);
return TCL_OK;
}
/*
* Unlink the binding from the list for its object, then from the list for
* its pattern.
*/
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
if (hPtr == NULL) {
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;
}
}
}
psPtr->flags |= MARKED_DELETED;
if (psPtr->refCount == 0) {
if (psPtr->freeProc != NULL) {
psPtr->freeProc(psPtr->clientData);
}
ckfree((char *) psPtr);
}
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* Tk_GetBinding --
*
* Return the command associated with a given event string.
*
* Results:
* The return value is a pointer to the command string associated with
* eventString for object in the domain given by bindingTable. If there
* is no binding for eventString, or if eventString is improperly formed,
* then NULL is returned and an error message is left in the interp's
* result. The return value is semi-static: it will persist until the
* binding is changed or deleted.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
const char *
Tk_GetBinding(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tk_BindingTable bindingTable,
/* Table in which to look for binding. */
ClientData object, /* Token for object with which binding is
* associated. */
const char *eventString) /* String describing event sequence that
* triggers binding. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
unsigned long eventMask;
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
0, 1, &eventMask);
if (psPtr == NULL) {
return NULL;
}
if (psPtr->eventProc == EvalTclBinding) {
return (const char *) psPtr->clientData;
}
return "";
}
/*
*--------------------------------------------------------------
*
* Tk_GetAllBindings --
*
* Return a list of event strings for all the bindings associated with a
* given object.
*
* Results:
* There is no return value. The interp's result is modified to hold a
* Tcl list with one entry for each binding associated with object in
* bindingTable. Each entry in the list contains the event string
* associated with one binding.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
void
Tk_GetAllBindings(
Tcl_Interp *interp, /* Interpreter returning result or error. */
Tk_BindingTable bindingTable,
/* Table in which to look for bindings. */
ClientData object) /* Token for object. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr;
Tcl_HashEntry *hPtr;
Tcl_DString ds;
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
if (hPtr == NULL) {
return;
}
Tcl_DStringInit(&ds);
for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
psPtr = psPtr->nextObjPtr) {
/*
* For each binding, output information about each of the patterns in
* its sequence.
*/
Tcl_DStringSetLength(&ds, 0);
GetPatternString(psPtr, &ds);
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
}
Tcl_DStringFree(&ds);
}
/*
*--------------------------------------------------------------
*
* Tk_DeleteAllBindings --
*
* Remove all bindings associated with a given object in a given binding
* table.
*
* Results:
* All bindings associated with object are removed from bindingTable.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
void
Tk_DeleteAllBindings(
Tk_BindingTable bindingTable,
/* Table in which to delete bindings. */
ClientData object) /* Token for object. */
{
BindingTable *bindPtr = (BindingTable *) bindingTable;
PatSeq *psPtr, *prevPtr;
PatSeq *nextPtr;
Tcl_HashEntry *hPtr;
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
if (hPtr == NULL) {
return;
}
for (psPtr = 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;
}
}
}
psPtr->flags |= MARKED_DELETED;
if (psPtr->refCount == 0) {
if (psPtr->freeProc != NULL) {
psPtr->freeProc(psPtr->clientData);
}
ckfree((char *) psPtr);
}
}
Tcl_DeleteHashEntry(hPtr);
}
/*
*---------------------------------------------------------------------------
*
* Tk_BindEvent --
*
* This 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 command associated with the matching binding.
*
* All Tcl bindings scripts for each object are accumulated before the
* first binding is evaluated. If the action of a Tcl binding is to
* change or delete a binding, or delete the window associated with the
* binding, all the original Tcl binding scripts will still fire.
* Contrast this with C binding functions. If a pending C binding (one
* that hasn't fired yet, but is queued to be fired for this window) is
* deleted, it will not be called, and if it is changed, then the new
* binding function will be called. If the window itself is deleted, no
* further C binding functions will be called for this window. When both
* Tcl binding scripts and C binding functions are interleaved, the above
* rules still apply.
*
*---------------------------------------------------------------------------
*/
void
Tk_BindEvent(
Tk_BindingTable bindingTable,
/* Table in which to look for bindings. */
XEvent *eventPtr, /* What actually happened. */
Tk_Window tkwin, /* Window on display where event occurred
* (needed in order to locate display
* information). */
int numObjects, /* Number of objects at *objectPtr. */
ClientData *objectPtr) /* Array of one or more objects to check for a
* matching binding. */
{
BindingTable *bindPtr;
TkDisplay *dispPtr;
ScreenInfo *screenPtr;
BindInfo *bindInfoPtr;
TkDisplay *oldDispPtr;
XEvent *ringPtr;
PatSeq *vMatchDetailList, *vMatchNoDetailList;
int flags, oldScreen, i, deferModal;
unsigned int matchCount, matchSpace;
Tcl_Interp *interp;
Tcl_DString scripts, savedResult;
Detail detail;
char *p, *end;
PendingBinding staticPending, *pendingPtr;
TkWindow *winPtr = (TkWindow *) tkwin;
PatternTableKey key;
Tk_ClassModalProc *modalProc;
/*
* Ignore events on windows that don't have names: these are windows like
* wrapper windows that shouldn't be visible to the application.
*/
if (winPtr->pathName == NULL) {
return;
}
/*
* Ignore the event completely if it is an Enter, Leave, FocusIn, or
* FocusOut event with detail NotifyInferior. The reason for ignoring
* these events is that we don't want transitions between a window and its
* children to visible to bindings on the parent: this would cause
* problems for mega-widgets, since the internal structure of a
* mega-widget isn't supposed to be visible to people watching the parent.
*/
if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
if (eventPtr->xcrossing.detail == NotifyInferior) {
return;
}
}
if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
if (eventPtr->xfocus.detail == NotifyInferior) {
return;
}
}
bindPtr = (BindingTable *) bindingTable;
dispPtr = ((TkWindow *) tkwin)->dispPtr;
bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
/*
* Add the new event to the ring of saved events for the binding table.
* Two tricky points:
*
* 1. Combine consecutive MotionNotify events. Do this by putting the new
* event *on top* of the previous event.
* 2. If a modifier key is held down, it auto-repeats to generate
* continuous KeyPress and KeyRelease events. These can flush the event
* ring so that valuable information is lost (such as repeated button
* clicks). To handle this, check for the special case of a modifier
* KeyPress arriving when the previous two events are a KeyRelease and
* KeyPress of the same key. If this happens, mark the most recent
* event (the KeyRelease) invalid and put the new event on top of the
* event before that (the KeyPress).
*/
if ((eventPtr->type == MotionNotify)
&& (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
/*
* Don't advance the ring pointer.
*/
} else if (eventPtr->type == KeyPress) {
int i;
for (i = 0; ; i++) {
if (i >= dispPtr->numModKeyCodes) {
goto advanceRingPointer;
}
if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
break;
}
}
ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
if ((ringPtr->type != KeyRelease)
|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
goto advanceRingPointer;
}
if (bindPtr->curEvent <= 0) {
i = EVENT_BUFFER_SIZE - 1;
} else {
i = bindPtr->curEvent - 1;
}
ringPtr = &bindPtr->eventRing[i];
if ((ringPtr->type != KeyPress)
|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
goto advanceRingPointer;
}
bindPtr->eventRing[bindPtr->curEvent].type = -1;
bindPtr->curEvent = i;
} else {
advanceRingPointer:
bindPtr->curEvent++;
if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
bindPtr->curEvent = 0;
}
}
ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
memcpy(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. Append all the callbacks to the array of pending
* callbacks.
*/
pendingPtr = &staticPending;
matchCount = 0;
matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
Tcl_DStringInit(&scripts);
for ( ; numObjects > 0; numObjects--, objectPtr++) {
PatSeq *matchPtr = 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) {
if (sourcePtr->eventProc == NULL) {
Tcl_Panic("Tk_BindEvent: missing command");
}
if (sourcePtr->eventProc == EvalTclBinding) {
ExpandPercents(winPtr, (char *) sourcePtr->clientData,
eventPtr, detail.keySym, &scripts);
} else {
if (matchCount >= matchSpace) {
PendingBinding *newPtr;
unsigned int oldSize, newSize;
oldSize = sizeof(staticPending)
- sizeof(staticPending.matchArray)
+ matchSpace * sizeof(PatSeq*);
matchSpace *= 2;
newSize = sizeof(staticPending)
- sizeof(staticPending.matchArray)
+ matchSpace * sizeof(PatSeq*);
newPtr = (PendingBinding *) ckalloc(newSize);
memcpy(newPtr, pendingPtr, oldSize);
if (pendingPtr != &staticPending) {
ckfree((char *) pendingPtr);
}
pendingPtr = newPtr;
}
sourcePtr->refCount++;
pendingPtr->matchArray[matchCount] = sourcePtr;
matchCount++;
}
/*
* A "" is added to the scripts string to separate the various
* scripts that should be invoked.
*/
Tcl_DStringAppend(&scripts, "", 1);
}
}
if (Tcl_DStringLength(&scripts) == 0) {
return;
}
/*
* Now go back through and evaluate the binding for each object, in order,
* dealing with "break" and "continue" exceptions appropriately.
*
* There are two tricks here:
* 1. Bindings can be invoked from in the middle of Tcl commands, where
* the interp's result is significant (for example, a widget might be
* deleted because of an error in creating it, so the result contains
* an error message that is eventually going to be returned by the
* creating command). To preserve the result, we save it in a dynamic
* string.
* 2. The binding's action can potentially delete the binding, so bindPtr
* may not point to anything valid once the action completes. Thus we
* have to save bindPtr->interp in a local variable in order to restore
* the result.
*/
interp = bindPtr->interp;
Tcl_DStringInit(&savedResult);
/*
* Save information about the current screen, then invoke a script if the
* screen has changed.
*/
Tcl_DStringGetResult(interp, &savedResult);
screenPtr = &bindInfoPtr->screenInfo;
oldDispPtr = screenPtr->curDispPtr;
oldScreen = screenPtr->curScreenIndex;
if ((dispPtr != screenPtr->curDispPtr)
|| (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
screenPtr->curDispPtr = dispPtr;
screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
}
if (matchCount > 0) {
/*
* Remember the list of pending C binding callbacks, so we can mark
* them as deleted and not call them if the act of evaluating a C or
* Tcl binding deletes a C binding callback or even the whole window.
*/
pendingPtr->nextPtr = bindInfoPtr->pendingList;
pendingPtr->tkwin = tkwin;
pendingPtr->deleted = 0;
bindInfoPtr->pendingList = pendingPtr;
}
/*
* Save the current value of the TK_DEFER_MODAL flag so we can restore it
* at the end of the loop. Clear the flag so we can detect any recursive
* requests for a modal loop.
*/
flags = winPtr->flags;
winPtr->flags &= ~TK_DEFER_MODAL;
p = Tcl_DStringValue(&scripts);
end = p + Tcl_DStringLength(&scripts);
i = 0;
/*
* Be carefule when dereferencing screenPtr or bindInfoPtr. If we evaluate
* something that destroys ".", bindInfoPtr would have been freed, but we
* can tell that by first checking to see if winPtr->mainPtr == NULL.
*/
Tcl_Preserve(bindInfoPtr);
while (p < end) {
int code;
if (!bindInfoPtr->deleted) {
screenPtr->bindingDepth++;
}
Tcl_AllowExceptions(interp);
if (*p == '\0') {
PatSeq *psPtr;
psPtr = pendingPtr->matchArray[i];
i++;
code = TCL_OK;
if ((pendingPtr->deleted == 0)
&& ((psPtr->flags & MARKED_DELETED) == 0)) {
code = psPtr->eventProc(psPtr->clientData, interp, eventPtr,
tkwin, detail.keySym);
}
psPtr->refCount--;
if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
if (psPtr->freeProc != NULL) {
psPtr->freeProc(psPtr->clientData);
}
ckfree((char *) psPtr);
}
} else {
int len = (int) strlen(p);
code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
p += len;
}
p++;
if (!bindInfoPtr->deleted) {
screenPtr->bindingDepth--;
}
if (code != TCL_OK) {
if (code == TCL_CONTINUE) {
/*
* Do nothing: just go on to the next command.
*/
} else if (code == TCL_BREAK) {
break;
} else {
Tcl_AddErrorInfo(interp, "\n (command bound to event)");
Tcl_BackgroundError(interp);
break;
}
}
}
if (matchCount > 0 && !pendingPtr->deleted) {
/*
* Restore the original modal flag value and invoke the modal loop if
* needed.
*/
deferModal = winPtr->flags & TK_DEFER_MODAL;
winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL)
| (flags & TK_DEFER_MODAL);
if (deferModal) {
modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc);
if (modalProc != NULL) {
modalProc(tkwin, eventPtr);
}
}
}
if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
&& ((oldDispPtr != screenPtr->curDispPtr)
|| (oldScreen != screenPtr->curScreenIndex))) {
/*
* Some other binding script is currently executing, but its screen is
* no longer current. Change the current display back again.
*/
screenPtr->curDispPtr = oldDispPtr;
screenPtr->curScreenIndex = oldScreen;
ChangeScreen(interp, oldDispPtr->name, oldScreen);
}
Tcl_DStringResult(interp, &savedResult);
Tcl_DStringFree(&scripts);
if (matchCount > 0) {
if (!bindInfoPtr->deleted) {
/*
* Delete the pending list from the list of pending scripts for
* this window.
*/
PendingBinding **curPtrPtr;
for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
if (*curPtrPtr == pendingPtr) {
*curPtrPtr = pendingPtr->nextPtr;
break;
}
curPtrPtr = &(*curPtrPtr)->nextPtr;
}
}
if (pendingPtr != &staticPending) {
ckfree((char *) pendingPtr);
}
}
Tcl_Release(bindInfoPtr);
}
/*
*---------------------------------------------------------------------------
*
* TkBindDeadWindow --
*
* This function is invoked when it is determined that a window is dead.
* It cleans up bind-related information about the window
*
* Results:
* None.
*
* Side effects:
* Any pending C bindings for this window are cancelled.
*
*---------------------------------------------------------------------------
*/
void
TkBindDeadWindow(
TkWindow *winPtr) /* The window that is being deleted. */
{
BindInfo *bindInfoPtr;
PendingBinding *curPtr;
/*
* Certain special windows like those used for send and clipboard have no
* mainPtr.
*/
if (winPtr->mainPtr == NULL) {
return;
}
bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
curPtr = bindInfoPtr->pendingList;
while (curPtr != NULL) {
if (curPtr->tkwin == (Tk_Window) winPtr) {
curPtr->deleted = 1;
}
curPtr = curPtr->nextPtr;
}
}
/*
*----------------------------------------------------------------------
*
* MatchPatterns --
*
* Given a list of pattern sequences and a list of recent events, return
* the pattern sequence that best matches the event list, if there is
* one.
*
* This 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];
Pattern *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) {
Pattern *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). */
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) {
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);
goto doString;
} else if (flags & VISIBILITY) {
string = TkFindStateString(visNotify,
eventPtr->xvisibility.state);
goto doString;
} else {
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) {
Tcl_DStringFree(&buf);
string = TkpGetString(winPtr, eventPtr, &buf);
}
goto doString;
case 'B':
if (flags & CREATE) {
number = eventPtr->xcreatewindow.border_width;
} else if (flags & CONFIGREQ) {
number = eventPtr->xconfigurerequest.border_width;
} else if (flags & CONFIG) {
number = eventPtr->xconfigure.border_width;
} else {
goto doString;
}
goto doNumber;
case 'D':
/*
* This is used only by the MouseWheel event.
*/
if (flags & KEY) {
number = eventPtr->xkey.keycode;
goto doNumber;
}
goto doString;
case 'E':
number = (int) eventPtr->xany.send_event;
goto doNumber;
case 'K':
if (flags & KEY) {
char *name = TkKeysymToString(keySym);
if (name != NULL) {
string = name;
}
}
goto doString;
case 'N':
if (flags & KEY) {
number = (int) keySym;
goto doNumber;
}
goto doString;
case 'P':
if (flags & PROP) {
string = Tk_GetAtomName((Tk_Window) winPtr,
eventPtr->xproperty.atom);
}
goto doString;
case 'R':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
TkpPrintWindowId(numStorage, eventPtr->xkey.root);
string = numStorage;
}
goto doString;
case 'S':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
string = numStorage;
}
goto doString;
case 'T':
number = eventPtr->type;
goto doNumber;
case 'W': {
Tk_Window tkwin;
tkwin = Tk_IdToWindow(eventPtr->xany.display,
eventPtr->xany.window);
if (tkwin != NULL) {
string = Tk_PathName(tkwin);
} else {
string = "??";
}
goto doString;
}
case 'X':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
Tk_Window tkwin;
int x, y;
int width, height;
number = eventPtr->xkey.x_root;
tkwin = Tk_IdToWindow(eventPtr->xany.display,
eventPtr->xany.window);
if (tkwin != NULL) {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
number -= x;
}
goto doNumber;
}
goto doString;
case 'Y':
if (flags & KEY_BUTTON_MOTION_CROSSING) {
Tk_Window tkwin;
int x, y;
int width, height;
number = eventPtr->xkey.y_root;
tkwin = Tk_IdToWindow(eventPtr->xany.display,
eventPtr->xany.window);
if (tkwin != NULL) {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
number -= y;
}
goto doNumber;
}
goto doString;
default:
numStorage[0] = before[1];
numStorage[1] = '\0';
string = numStorage;
goto doString;
}
doNumber:
sprintf(numStorage, "%d", number);
string = numStorage;
doString:
spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
length = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
spaceNeeded = Tcl_ConvertElement(string,
Tcl_DStringValue(dsPtr) + length,
cvtFlags | TCL_DONT_USE_BRACES);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
before += 2;
}
Tcl_DStringFree(&buf);
}
/*
*----------------------------------------------------------------------
*
* ChangeScreen --
*
* This 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);
Tcl_IncrRefCount(cmdObj);
if (Tcl_GlobalEvalObj(interp, cmdObj) != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (changing screen in event binding)");
Tcl_BackgroundError(interp);
}
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, *event;
Tk_Window tkwin = clientData;
VirtualEventTable *vetPtr;
TkBindInfo bindInfo;
static const char *const optionStrings[] = {
"add", "delete", "generate", "info",
NULL
};
enum options {
EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
};
bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case EVENT_ADD:
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((char *) psPtr->voPtr);
ckfree((char *) 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. */
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 = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
poPtr->numOwned = 0;
} else {
/*
* See if this virtual event is already defined for this physical
* event and just return if it is.
*/
int i;
for (i = 0; i < poPtr->numOwned; i++) {
if (poPtr->patSeqs[i] == psPtr) {
return TCL_OK;
}
}
poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
}
Tcl_SetHashValue(vhPtr, poPtr);
poPtr->patSeqs[poPtr->numOwned] = psPtr;
poPtr->numOwned++;
/*
* Make physical event so it can trigger the virtual event.
*/
voPtr = psPtr->voPtr;
if (voPtr == NULL) {
voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
voPtr->numOwners = 0;
} else {
voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
sizeof(VirtualOwners)
+ voPtr->numOwners * sizeof(Tcl_HashEntry *));
}
psPtr->voPtr = voPtr;
voPtr->owners[voPtr->numOwners] = vhPtr;
voPtr->numOwners++;
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* DeleteVirtualEvent --
*
* Remove the definition of a given virtual event. If the event string is
* NULL, all definitions of the virtual event will be removed.
* Otherwise, just the specified definition of the virtual event will be
* removed.
*
* Results:
* The result is a standard Tcl return value. If an error occurs then the
* interp's result will contain an error message. It is not an error to
* attempt to delete a virtual event that does not exist or a definition
* that does not exist.
*
* Side effects:
* The virtual event given by virtString may be removed from the virtual
* event table.
*
*--------------------------------------------------------------
*/
static int
DeleteVirtualEvent(
Tcl_Interp *interp, /* Used for error reporting. */
VirtualEventTable *vetPtr, /* Table in which to delete event. */
char *virtString, /* String describing event sequence that
* triggers binding. */
char *eventString) /* The event sequence that should be deleted,
* or NULL to delete all event sequences for
* the entire virtual event. */
{
int iPhys;
Tk_Uid virtUid;
Tcl_HashEntry *vhPtr;
PhysicalsOwned *poPtr;
PatSeq *eventPSPtr;
virtUid = GetVirtualEventUid(interp, virtString);
if (virtUid == NULL) {
return TCL_ERROR;
}
vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
if (vhPtr == NULL) {
return TCL_OK;
}
poPtr = 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_GetStringResult(interp);
return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
}
}
for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
PatSeq *psPtr = poPtr->patSeqs[iPhys];
if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
int iVirt;
VirtualOwners *voPtr;
/*
* Remove association between this physical event and the given
* virtual event that it triggers.
*/
voPtr = psPtr->voPtr;
for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
if (voPtr->owners[iVirt] == vhPtr) {
break;
}
}
if (iVirt == voPtr->numOwners) {
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((char *) psPtr->voPtr);
ckfree((char *) psPtr);
} else {
/*
* This physical event still triggers some other virtual
* event(s). Consolidate the list of virtual owners for this
* physical event so it no longer triggers the given virtual
* event.
*/
voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
}
/*
* Now delete the virtual event's reference to the physical event.
*/
poPtr->numOwned--;
if (eventPSPtr != NULL && poPtr->numOwned != 0) {
/*
* Just deleting this one physical event. Consolidate list of
* owned physical events and return.
*/
poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
return TCL_OK;
}
}
}
if (poPtr->numOwned == 0) {
/*
* All the physical events for this virtual event were deleted, either
* because there was only one associated physical event or because the
* caller was deleting the entire virtual event. Now the virtual event
* itself should be deleted.
*/
ckfree((char *) poPtr);
Tcl_DeleteHashEntry(vhPtr);
}
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* GetVirtualEvent --
*
* Return the list of physical events that can invoke the given virtual
* event.
*
* Results:
* The return value is TCL_OK and the interp's result is filled with the
* string representation of the physical events associated with the
* virtual event; if there are no physical events for the given virtual
* event, the interp's result is filled with and empty string. If the
* virtual event string is improperly formed, then TCL_ERROR is returned
* and an error message is left in the interp's result.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
static int
GetVirtualEvent(
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;
Tcl_DString ds;
int iPhys;
PhysicalsOwned *poPtr;
Tk_Uid virtUid;
virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName));
if (virtUid == NULL) {
return TCL_ERROR;
}
vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
if (vhPtr == NULL) {
return TCL_OK;
}
Tcl_DStringInit(&ds);
poPtr = Tcl_GetHashValue(vhPtr);
for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
Tcl_DStringSetLength(&ds, 0);
GetPatternString(poPtr->patSeqs[iPhys], &ds);
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
}
Tcl_DStringFree(&ds);
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* GetAllVirtualEvents --
*
* Return a list that contains the names of all the virtual event
* defined.
*
* Results:
* There is no return value. The interp's result is modified to hold a
* Tcl list with one entry for each virtual event in nameTable.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
static void
GetAllVirtualEvents(
Tcl_Interp *interp, /* Interpreter returning result. */
VirtualEventTable *vetPtr) /* Table containing events. */
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_DString ds;
Tcl_DStringInit(&ds);
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_DStringSetLength(&ds, 0);
Tcl_DStringAppend(&ds, "<<", 2);
Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
Tcl_DStringAppend(&ds, ">>", 2);
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
}
Tcl_DStringFree(&ds);
}
/*
*---------------------------------------------------------------------------
*
* HandleEventGenerate --
*
* Helper function for the "event generate" command. Generate and process
* an XEvent, constructed from information parsed from the event
* description string and its optional arguments.
*
* argv[0] contains name of the target window.
* argv[1] contains pattern string for one event (e.g, <Control-v>).
* argv[2..argc-1] contains -field/option pairs for specifying additional
* detail in the generated event.
*
* Either virtual or physical events can be generated this way. The event
* description string must contain the specification for only one event.
*
* Results:
* None.
*
* Side effects:
* When constructing the event,
* event.xany.serial is filled with the current X serial number.
* event.xany.window is filled with the target window.
* event.xany.display is filled with the target window's display.
* Any other fields in eventPtr which are not specified by the pattern
* string or the optional arguments, are set to 0.
*
* The event may be handled sychronously or asynchronously, depending on
* the value specified by the optional "-when" option. The default
* setting is synchronous.
*
*---------------------------------------------------------------------------
*/
static int
HandleEventGenerate(
Tcl_Interp *interp, /* Interp for errors return and name lookup. */
Tk_Window mainWin, /* Main window associated with interp. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
XEvent event;
const char *p;
char *name, *windowName;
int count, flags, synch, i, number, warp;
Tcl_QueuePosition pos;
Pattern pat;
Tk_Window tkwin, tkwin2;
TkWindow *mainPtr;
unsigned long eventMask;
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_AppendResult(interp, "window id \"", Tcl_GetString(objv[0]),
"\" doesn't exist in this application", 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_SetResult(interp, "Double or Triple modifier not allowed",
TCL_STATIC);
return TCL_ERROR;
}
if (*p != '\0') {
Tcl_SetResult(interp, "only one event specification allowed",
TCL_STATIC);
return TCL_ERROR;
}
memset(&event, 0, sizeof(event));
event.xany.type = pat.eventType;
event.xany.serial = NextRequest(Tk_Display(tkwin));
event.xany.send_event = False;
if (windowName[0]) {
event.xany.window = Tk_WindowId(tkwin);
} else {
event.xany.window =
RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
}
event.xany.display = Tk_Display(tkwin);
flags = flagArray[event.xany.type];
if (flags & DESTROY) {
/*
* Event DesotryNotify should be generated by destroying the window.
*/
Tk_DestroyWindow(tkwin);
return TCL_OK;
}
if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
event.xkey.state = pat.needMods;
if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {
TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event);
} else if (flags & BUTTON) {
event.xbutton.button = pat.detail.button;
} else if (flags & VIRTUAL) {
((XVirtualEvent *) &event)->name = pat.detail.name;
}
}
if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
event.xcreatewindow.window = event.xany.window;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.x_root = -1;
event.xkey.y_root = -1;
}
if (event.xany.type == FocusIn || event.xany.type == FocusOut) {
event.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_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (objc & 1) {
/*
* This test occurs after Tcl_GetIndexFromObj() so that "event
* generate <Button> -xyz" will return the error message that
* "-xyz" is a bad option, rather than that the value for "-xyz"
* is missing.
*/
Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr),
"\" missing", NULL);
return TCL_ERROR;
}
switch ((enum field) index) {
case EVENT_WARP:
if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
return TCL_ERROR;
}
if (!(flags & KEY_BUTTON_MOTION_VIRTUAL)) {
goto badopt;
}
break;
case EVENT_WHEN:
pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
queuePosition, valuePtr);
if ((int) pos < -1) {
return TCL_ERROR;
}
synch = 0;
if ((int) pos == -1) {
synch = 1;
}
break;
case EVENT_ABOVE:
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & CONFIG) {
event.xconfigure.above = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
case EVENT_BORDER:
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (CREATE|CONFIG)) {
event.xcreatewindow.border_width = number;
} else {
goto badopt;
}
break;
case EVENT_BUTTON:
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & BUTTON) {
event.xbutton.button = number;
} else {
goto badopt;
}
break;
case EVENT_COUNT:
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & EXPOSE) {
event.xexpose.count = number;
} else {
goto badopt;
}
break;
case EVENT_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.xkey.type == MouseWheelEvent)) {
event.xkey.keycode = number;
} else {
goto badopt;
}
break;
case EVENT_DETAIL:
number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
valuePtr);
if (number < 0) {
return TCL_ERROR;
}
if (flags & FOCUS) {
event.xfocus.detail = number;
} else if (flags & CROSSING) {
event.xcrossing.detail = number;
} else {
goto badopt;
}
break;
case EVENT_FOCUS:
if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & CROSSING) {
event.xcrossing.focus = number;
} else {
goto badopt;
}
break;
case EVENT_HEIGHT:
if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & EXPOSE) {
event.xexpose.height = number;
} else if (flags & CONFIG) {
event.xconfigure.height = number;
} else {
goto badopt;
}
break;
case EVENT_KEYCODE:
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
event.xkey.keycode = number;
} else {
goto badopt;
}
break;
case EVENT_KEYSYM: {
KeySym keysym;
char *value;
value = Tcl_GetString(valuePtr);
keysym = TkStringToKeysym(value);
if (keysym == NoSymbol) {
Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
NULL);
return TCL_ERROR;
}
TkpSetKeycodeAndState(tkwin, keysym, &event);
if (event.xkey.keycode == 0) {
Tcl_AppendResult(interp, "no keycode for keysym \"", value,
"\"", NULL);
return TCL_ERROR;
}
if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
goto badopt;
}
break;
}
case EVENT_MODE:
number = TkFindStateNumObj(interp,optionPtr,notifyMode,valuePtr);
if (number < 0) {
return TCL_ERROR;
}
if (flags & CROSSING) {
event.xcrossing.mode = number;
} else if (flags & FOCUS) {
event.xfocus.mode = number;
} else {
goto badopt;
}
break;
case EVENT_OVERRIDE:
if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & CREATE) {
event.xcreatewindow.override_redirect = number;
} else if (flags & MAP) {
event.xmap.override_redirect = number;
} else if (flags & REPARENT) {
event.xreparent.override_redirect = number;
} else if (flags & CONFIG) {
event.xconfigure.override_redirect = number;
} else {
goto badopt;
}
break;
case EVENT_PLACE:
number = TkFindStateNumObj(interp, optionPtr, circPlace, valuePtr);
if (number < 0) {
return TCL_ERROR;
}
if (flags & CIRC) {
event.xcirculate.place = number;
} else {
goto badopt;
}
break;
case EVENT_ROOT:
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.root = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
case EVENT_ROOTX:
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.x_root = number;
} else {
goto badopt;
}
break;
case EVENT_ROOTY:
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.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.xany.send_event = number;
break;
}
case EVENT_SERIAL:
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
event.xany.serial = number;
break;
case EVENT_STATE:
if (flags & KEY_BUTTON_MOTION_CROSSING) {
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
event.xkey.state = number;
} else {
event.xcrossing.state = number;
}
} else if (flags & VISIBILITY) {
number = TkFindStateNumObj(interp, optionPtr, visNotify,
valuePtr);
if (number < 0) {
return TCL_ERROR;
}
event.xvisibility.state = number;
} else {
goto badopt;
}
break;
case EVENT_SUBWINDOW:
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.subwindow = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
case EVENT_TIME:
if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.time = (Time) number;
} else if (flags & PROP) {
event.xproperty.time = (Time) number;
} else {
goto badopt;
}
break;
case EVENT_WIDTH:
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & EXPOSE) {
event.xexpose.width = number;
} else if (flags & (CREATE|CONFIG)) {
event.xcreatewindow.width = number;
} else {
goto badopt;
}
break;
case EVENT_WINDOW:
if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
event.xcreatewindow.window = Tk_WindowId(tkwin2);
} else {
goto badopt;
}
break;
case EVENT_X:
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.x = number;
/*
* Only modify rootx as well if it hasn't been changed.
*/
if (event.xkey.x_root == -1) {
int rootX, rootY;
Tk_GetRootCoords(tkwin, &rootX, &rootY);
event.xkey.x_root = rootX + number;
}
} else if (flags & EXPOSE) {
event.xexpose.x = number;
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
event.xcreatewindow.x = number;
} else if (flags & REPARENT) {
event.xreparent.x = number;
} else {
goto badopt;
}
break;
case EVENT_Y:
if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
return TCL_ERROR;
}
if (flags & KEY_BUTTON_MOTION_CROSSING) {
event.xkey.y = number;
/*
* Only modify rooty as well if it hasn't been changed.
*/
if (event.xkey.y_root == -1) {
int rootX, rootY;
Tk_GetRootCoords(tkwin, &rootX, &rootY);
event.xkey.y_root = rootY + number;
}
} else if (flags & EXPOSE) {
event.xexpose.y = number;
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
event.xcreatewindow.y = number;
} else if (flags & REPARENT) {
event.xreparent.y = number;
} else {
goto badopt;
}
break;
}
continue;
badopt:
Tcl_AppendResult(interp, name, " event doesn't accept \"",
Tcl_GetString(optionPtr), "\" option", NULL);
return TCL_ERROR;
}
if (userDataObj != NULL) {
XVirtualEvent *vePtr = (XVirtualEvent *) &event;
/*
* 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.
*/
vePtr->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);
} else {
Tk_QueueWindowEvent(&event, pos);
}
/*
* We only allow warping if the window is mapped.
*/
if ((warp != 0) && Tk_IsMapped(tkwin)) {
TkDisplay *dispPtr = TkGetDisplay(event.xmotion.display);
if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
Tcl_DoWhenIdle(DoWarp, dispPtr);
dispPtr->flags |= TK_DISPLAY_IN_WARP;
}
dispPtr->warpWindow = event.xany.window;
dispPtr->warpX = event.xkey.x;
dispPtr->warpY = event.xkey.y;
}
Tcl_ResetResult(interp);
return TCL_OK;
}
static int
NameToWindow(
Tcl_Interp *interp, /* Interp for error return and name lookup. */
Tk_Window mainWin, /* Main window of application. */
Tcl_Obj *objPtr, /* Contains name or id string of window. */
Tk_Window *tkwinPtr) /* Filled with token for window. */
{
char *name = 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_AppendResult(interp, "bad window name/identifier \"",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;
XWarpPointer(dispPtr->display, (Window) None,
(Window) dispPtr->warpWindow, 0, 0, 0, 0,
(int) dispPtr->warpX, (int) dispPtr->warpY);
XForceScreenSaver(dispPtr->display, ScreenSaverReset);
dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
}
/*
*-------------------------------------------------------------------------
*
* GetVirtualEventUid --
*
* Determine if the given string is in the proper format for a virtual
* event.
*
* Results:
* The return value is NULL if the virtual event string was not in the
* proper format. In this case, an error message will be left in the
* interp's result. Otherwise the return value is a Tk_Uid that
* represents the virtual event.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static Tk_Uid
GetVirtualEventUid(
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_AppendResult(interp, "virtual event \"", virtString,
"\" is badly formed", 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. */
{
Pattern pats[EVENT_BUFFER_SIZE];
int numPats, virtualFound;
const char *p;
Pattern *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_SetResult(interp,
"virtual event not allowed in definition of another virtual event",
TCL_STATIC);
return NULL;
}
virtualFound = 1;
}
/*
* Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
*/
while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
flags |= PAT_NEARBY;
patPtr[-1] = patPtr[0];
patPtr--;
numPats++;
}
}
/*
*-------------------------------------------------------------
* Step 2: find the sequence in the binding table if it exists, and add a
* new sequence to the table if it doesn't.
*-------------------------------------------------------------
*/
if (numPats == 0) {
Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
return NULL;
}
if ((numPats > 1) && (virtualFound != 0)) {
Tcl_SetResult(interp, "virtual events may not be composed",
TCL_STATIC);
return NULL;
}
patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
memset(&key, 0, sizeof(key));
key.object = object;
key.type = patPtr->eventType;
key.detail = patPtr->detail;
hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &isNew);
sequenceSize = numPats*sizeof(Pattern);
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 = (PatSeq *) ckalloc((unsigned)
(sizeof(PatSeq) + (numPats-1)*sizeof(Pattern)));
psPtr->numPats = numPats;
psPtr->eventProc = NULL;
psPtr->freeProc = NULL;
psPtr->clientData = NULL;
psPtr->flags = flags;
psPtr->refCount = 0;
psPtr->nextSeqPtr = 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. */
Pattern *patPtr, /* Filled with the pattern parsed from the
* event string. */
unsigned long *eventMaskPtr)/* Filled with event mask of matched event. */
{
char *p;
unsigned long eventMask;
int count, eventFlags;
#define FIELD_SIZE 48
char field[FIELD_SIZE];
Tcl_HashEntry *hPtr;
Tcl_DString copy;
Tcl_DStringInit(©);
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)));
count = 0;
goto done;
}
}
p++;
goto end;
}
/*
* A fancier event description. This can be either a virtual event or a
* physical event.
*
* A virtual event description consists of:
*
* 1. double open angle brackets.
* 2. virtual event name.
* 3. double close angle brackets.
*
* A physical event description consists of:
*
* 1. open angle bracket.
* 2. any number of modifiers, each followed by spaces or dashes.
* 3. an optional event name.
* 4. an option button or keysym name. Either this or item 3 *must* be
* present; if both are present then they are separated by spaces or
* dashes.
* 5. a close angle bracket.
*/
p++;
if (*p == '<') {
/*
* This is a virtual event: soak up all the characters up to the next
* '>'.
*/
char *field = p + 1;
p = strchr(field, '>');
if (p == field) {
Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
TCL_STATIC);
count = 0;
goto done;
}
if ((p == NULL) || (p[1] != '>')) {
Tcl_SetResult(interp, "missing \">\" in virtual binding",
TCL_STATIC);
count = 0;
goto done;
}
*p = '\0';
patPtr->eventType = VirtualEvent;
eventMask = VirtualEventMask;
patPtr->detail.name = Tk_GetUid(field);
*p = '>';
p += 2;
goto end;
}
while (1) {
ModInfo *modPtr;
p = GetField(p, field, FIELD_SIZE);
if (*p == '>') {
/*
* This solves the problem of, e.g., <Control-M> being
* misinterpreted as Control + Meta + missing keysym instead of
* Control + KeyPress + M.
*/
break;
}
hPtr = Tcl_FindHashEntry(&modTable, field);
if (hPtr == NULL) {
break;
}
modPtr = Tcl_GetHashValue(hPtr);
patPtr->needMods |= modPtr->mask;
if (modPtr->flags & MULT_CLICKS) {
int i = modPtr->flags & MULT_CLICKS;
count = 2;
while (i >>= 1) {
count++;
}
}
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
}
}
eventFlags = 0;
hPtr = Tcl_FindHashEntry(&eventTable, field);
if (hPtr != NULL) {
EventInfo *eiPtr = Tcl_GetHashValue(hPtr);
patPtr->eventType = eiPtr->type;
eventFlags = flagArray[eiPtr->type];
eventMask = eiPtr->eventMask;
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
}
p = GetField(p, field, FIELD_SIZE);
}
if (*field != '\0') {
if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
if (eventFlags == 0) {
patPtr->eventType = ButtonPress;
eventMask = ButtonPressMask;
} else if (eventFlags & KEY) {
goto getKeysym;
} else if ((eventFlags & BUTTON) == 0) {
Tcl_AppendResult(interp, "specified button \"", field,
"\" for non-button event", NULL);
count = 0;
goto done;
}
patPtr->detail.button = (*field - '0');
} else {
getKeysym:
patPtr->detail.keySym = TkStringToKeysym(field);
if (patPtr->detail.keySym == NoSymbol) {
Tcl_AppendResult(interp, "bad event type or keysym \"",
field, "\"", NULL);
count = 0;
goto done;
}
if (eventFlags == 0) {
patPtr->eventType = KeyPress;
eventMask = KeyPressMask;
} else if ((eventFlags & KEY) == 0) {
Tcl_AppendResult(interp, "specified keysym \"", field,
"\" for non-key event", NULL);
count = 0;
goto done;
}
}
} else if (eventFlags == 0) {
Tcl_SetResult(interp, "no event type or button # or keysym",
TCL_STATIC);
count = 0;
goto done;
}
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
}
if (*p != '>') {
while (*p != '\0') {
p++;
if (*p == '>') {
Tcl_SetResult(interp,
"extra characters after detail in binding",
TCL_STATIC);
count = 0;
goto done;
}
}
Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
count = 0;
goto done;
}
p++;
end:
*eventStringPtr += (p - Tcl_DStringValue(©));
*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;
}
/*
*---------------------------------------------------------------------------
*
* GetPatternString --
*
* Produce a string version of the given event, for displaying to the
* user.
*
* Results:
* The string is left in dsPtr.
*
* Side effects:
* It is the caller's responsibility to initialize the DString before and
* to free it after calling this function.
*
*---------------------------------------------------------------------------
*/
static void
GetPatternString(
PatSeq *psPtr,
Tcl_DString *dsPtr)
{
Pattern *patPtr;
char c, buffer[TCL_INTEGER_SPACE];
int patsLeft, needMods;
const ModInfo *modPtr;
EventInfo *eiPtr;
/*
* The order of the patterns in the sequence is backwards from the order
* in which they must be output.
*/
for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
patsLeft > 0; patsLeft--, patPtr--) {
/*
* Check for simple case of an ASCII character.
*/
if ((patPtr->eventType == KeyPress)
&& ((psPtr->flags & PAT_NEARBY) == 0)
&& (patPtr->needMods == 0)
&& (patPtr->detail.keySym < 128)
&& isprint(UCHAR(patPtr->detail.keySym))
&& (patPtr->detail.keySym != '<')
&& (patPtr->detail.keySym != ' ')) {
c = (char) patPtr->detail.keySym;
Tcl_DStringAppend(dsPtr, &c, 1);
continue;
}
/*
* Check for virtual event.
*/
if (patPtr->eventType == VirtualEvent) {
Tcl_DStringAppend(dsPtr, "<<", 2);
Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
Tcl_DStringAppend(dsPtr, ">>", 2);
continue;
}
/*
* It's a more general event specification. First check for "Double",
* "Triple", "Quadruple", then modifiers, then event type, then keysym
* or button detail.
*/
Tcl_DStringAppend(dsPtr, "<", 1);
if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
&& (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
if ((patsLeft > 1) &&
(memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
if ((patsLeft > 1) &&
(memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
} else {
Tcl_DStringAppend(dsPtr, "Triple-", 7);
}
} else {
Tcl_DStringAppend(dsPtr, "Double-", 7);
}
}
for (needMods = patPtr->needMods, modPtr = modArray;
needMods != 0; modPtr++) {
if (modPtr->mask & needMods) {
needMods &= ~modPtr->mask;
Tcl_DStringAppend(dsPtr, modPtr->name, -1);
Tcl_DStringAppend(dsPtr, "-", 1);
}
}
for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
if (eiPtr->type == patPtr->eventType) {
Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
if (patPtr->detail.clientData != 0) {
Tcl_DStringAppend(dsPtr, "-", 1);
}
break;
}
}
if (patPtr->detail.clientData != 0) {
if ((patPtr->eventType == KeyPress)
|| (patPtr->eventType == KeyRelease)) {
char *string = TkKeysymToString(patPtr->detail.keySym);
if (string != NULL) {
Tcl_DStringAppend(dsPtr, string, -1);
}
} else {
sprintf(buffer, "%d", patPtr->detail.button);
Tcl_DStringAppend(dsPtr, buffer, -1);
}
}
Tcl_DStringAppend(dsPtr, ">", 1);
}
}
/*
*---------------------------------------------------------------------------
*
* EvalTclBinding --
*
* The function that is invoked by Tk_BindEvent when a Tcl binding is
* fired.
*
* Results:
* A standard Tcl result code, the result of globally evaluating the
* percent-substitued binding string.
*
* Side effects:
* Normal side effects due to eval.
*
*---------------------------------------------------------------------------
*/
static void
FreeTclBinding(
ClientData clientData)
{
ckfree((char *) clientData);
}
/*
*----------------------------------------------------------------------
*
* 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(
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.
*
*----------------------------------------------------------------------
*/
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);
}
/*
*----------------------------------------------------------------------
*
* TkCopyAndGlobalEval --
*
* This function makes a copy of a script then calls Tcl_GlobalEval to
* evaluate it. It's used in situations where the execution of a command
* may cause the original command string to be reallocated.
*
* Results:
* Returns the result of evaluating script, including both a standard Tcl
* completion code and a string in the interp's result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TkCopyAndGlobalEval(
Tcl_Interp *interp, /* Interpreter in which to evaluate script. */
char *script) /* Script to evaluate. */
{
Tcl_DString buffer;
int code;
Tcl_DStringInit(&buffer);
Tcl_DStringAppend(&buffer, script, -1);
code = Tcl_EvalEx(interp, Tcl_DStringValue(&buffer),
Tcl_DStringLength(&buffer), TCL_EVAL_GLOBAL);
Tcl_DStringFree(&buffer);
return code;
}
/*
*----------------------------------------------------------------------
*
* 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 = (BindingTable *) winPtr->mainPtr->bindingTable;
return &(bindPtr->eventRing[bindPtr->curEvent]);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/