tkBind.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:133k
- /*
- * tkBind.c --
- *
- * This file provides procedures that associate Tcl commands
- * with X events or sequences of X events.
- *
- * Copyright (c) 1989-1994 The Regents of the University of California.
- * Copyright (c) 1994-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.28.2.4 2006/07/21 06:26:54 das Exp $
- */
- #include "tkPort.h"
- #include "tkInt.h"
- #ifdef __WIN32__
- #include "tkWinInt.h"
- #endif
- #if !(defined(__WIN32__) || defined(MAC_TCL) || 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).
- * "bind" command implementation.
- * "bind" implementation helpers.
- *
- * Tcl "event" command.
- * "event" command implementation.
- * "event" implementation helpers.
- *
- * Package-specific common helpers.
- *
- * Non-package-specific helpers.
- */
- /*
- * The following union is used to hold the detail information from an
- * XEvent (including Tk's XVirtualEvent extension).
- */
- typedef union {
- KeySym keySym; /* KeySym that corresponds to xkey.keycode. */
- int button; /* Button that was pressed (xbutton.button). */
- Tk_Uid name; /* Tk_Uid of virtual event. */
- ClientData clientData; /* Used when type of Detail is unknown, and to
- * ensure that all bytes of Detail are initialized
- * when this structure is used in a hash key. */
- } Detail;
- /*
- * The structure below represents a binding table. A binding table
- * represents a domain in which event bindings may occur. It includes
- * a space of objects relative to which events occur (usually windows,
- * but not always), a history of recent events in the domain, and
- * a set of mappings that associate particular Tcl commands with sequences
- * of events in the domain. Multiple binding tables may exist at once,
- * either because there are multiple applications open, or because there
- * are multiple domains within an application with separate event
- * bindings for each (for example, each canvas widget has a separate
- * binding table for associating events with the items in the canvas).
- *
- * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
- * below 30. To see this, consider a triple mouse button click while
- * the Shift key is down (and auto-repeating). There may be as many
- * as 3 auto-repeat events after each mouse button press or release
- * (see the first large comment block within Tk_BindEvent for more on
- * this), for a total of 20 events to cover the three button presses
- * and two intervening releases. If you reduce EVENT_BUFFER_SIZE too
- * much, shift multi-clicks will be lost.
- *
- */
- #define EVENT_BUFFER_SIZE 30
- typedef struct BindingTable {
- XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
- * (higher indices are for more recent
- * events). */
- Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym,
- * button, Tk_Uid, or 0) for each
- * entry in eventRing. */
- int curEvent; /* Index in eventRing of most recent
- * event. Newer events have higher
- * indices. */
- Tcl_HashTable patternTable; /* Used to map from an event to a
- * list of patterns that may match that
- * event. Keys are PatternTableKey
- * structs, values are (PatSeq *). */
- Tcl_HashTable objectTable; /* Used to map from an object to a
- * list of patterns associated with
- * that object. Keys are ClientData,
- * values are (PatSeq *). */
- Tcl_Interp *interp; /* Interpreter in which commands are
- * executed. */
- } BindingTable;
- /*
- * The following structure represents virtual event table. A virtual event
- * table provides a way to map from platform-specific physical events such
- * as button clicks or key presses to virtual events such as <<Paste>>,
- * <<Close>>, or <<ScrollWindow>>.
- *
- * A virtual event is usually never part of the event stream, but instead is
- * synthesized inline by matching low-level events. However, a virtual
- * event may be generated by platform-specific code or by Tcl scripts. In
- * that case, no lookup of the virtual event will need to be done using
- * this table, because the virtual event is actually in the event stream.
- */
- typedef struct VirtualEventTable {
- Tcl_HashTable patternTable; /* Used to map from a physical event to
- * a list of patterns that may match that
- * event. Keys are PatternTableKey
- * structs, values are (PatSeq *). */
- Tcl_HashTable nameTable; /* Used to map a virtual event name to
- * the array of physical events that can
- * trigger it. Keys are the Tk_Uid names
- * of the virtual events, values are
- * PhysicalsOwned structs. */
- } VirtualEventTable;
- /*
- * The following structure is used as a key in a patternTable for both
- * binding tables and a virtual event tables.
- *
- * In a binding table, the object field corresponds to the binding tag
- * for the widget whose bindings are being accessed.
- *
- * In a virtual event table, the object field is always NULL. Virtual
- * events are a global definiton and are not tied to a particular
- * binding tag.
- *
- * The same key is used for both types of pattern tables so that the
- * helper functions that traverse and match patterns will work for both
- * binding tables and virtual event tables.
- */
- typedef struct PatternTableKey {
- ClientData object; /* For binding table, identifies the binding
- * tag of the object (or class of objects)
- * relative to which the event occurred.
- * For virtual event table, always NULL. */
- int type; /* Type of event (from X). */
- Detail detail; /* Additional information, such as keysym,
- * button, Tk_Uid, or 0 if nothing
- * additional. */
- } PatternTableKey;
- /*
- * The following structure defines a pattern, which is matched against X
- * events as part of the process of converting X events into Tcl commands.
- */
- typedef struct Pattern {
- int eventType; /* Type of X event, e.g. ButtonPress. */
- int needMods; /* Mask of modifiers that must be
- * present (0 means no modifiers are
- * required). */
- Detail detail; /* Additional information that must
- * match event. Normally this is 0,
- * meaning no additional information
- * must match. For KeyPress and
- * KeyRelease events, a keySym may
- * be specified to select a
- * particular keystroke (0 means any
- * keystrokes). For button events,
- * specifies a particular button (0
- * means any buttons are OK). For virtual
- * events, specifies the Tk_Uid of the
- * virtual event name (never 0). */
- } Pattern;
- /*
- * The following structure defines a pattern sequence, which consists of one
- * or more patterns. In order to trigger, a pattern sequence must match
- * the most recent X events (first pattern to most recent event, next
- * pattern to next event, and so on). It is used as the hash value in a
- * patternTable for both binding tables and virtual event tables.
- *
- * In a binding table, it is the sequence of physical events that make up
- * a binding for an object.
- *
- * In a virtual event table, it is the sequence of physical events that
- * define a virtual event.
- *
- * The same structure is used for both types of pattern tables so that the
- * helper functions that traverse and match patterns will work for both
- * binding tables and virtual event tables.
- */
- typedef struct PatSeq {
- int numPats; /* Number of patterns in sequence (usually
- * 1). */
- TkBindEvalProc *eventProc; /* The procedure that will be invoked on
- * the clientData when this pattern sequence
- * matches. */
- TkBindFreeProc *freeProc; /* The procedure that will be invoked to
- * release the clientData when this pattern
- * sequence is freed. */
- ClientData clientData; /* Arbitray data passed to eventProc and
- * freeProc when sequence matches. */
- int flags; /* Miscellaneous flag values; see below for
- * definitions. */
- int refCount; /* Number of times that this binding is in
- * the midst of executing. If greater than 1,
- * then a recursive invocation is happening.
- * Only when this is zero can the binding
- * actually be freed. */
- struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences
- * that have the same initial pattern. NULL
- * means end of list. */
- Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the
- * initial pattern. This is the head of the
- * list of which nextSeqPtr forms a part. */
- struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
- * virtual event table, identifies the array
- * of virtual events that can be triggered by
- * this event. */
- struct PatSeq *nextObjPtr; /* In a binding table, next in list of all
- * pattern sequences for the same object (NULL
- * for end of list). Needed to implement
- * Tk_DeleteAllBindings. In a virtual event
- * table, always NULL. */
- Pattern pats[1]; /* Array of "numPats" patterns. Only one
- * element is declared here but in actuality
- * enough space will be allocated for "numPats"
- * patterns. To match, pats[0] must match
- * event n, pats[1] must match event n-1, etc.
- */
- } PatSeq;
- /*
- * Flag values for PatSeq structures:
- *
- * PAT_NEARBY 1 means that all of the events matching
- * this sequence must occur with nearby X
- * and Y mouse coordinates and close in time.
- * This is typically used to restrict multiple
- * button presses.
- * MARKED_DELETED 1 means that this binding has been marked as deleted
- * and removed from the binding table, but its memory
- * could not be released because it was already queued for
- * execution. When the binding is actually about to be
- * executed, this flag will be checked and the binding
- * skipped if set.
- */
- #define PAT_NEARBY 0x1
- #define MARKED_DELETED 0x2
- /*
- * Constants that define how close together two events must be
- * in milliseconds or pixels to meet the PAT_NEARBY constraint:
- */
- #define NEARBY_PIXELS 5
- #define NEARBY_MS 500
- /*
- * The following structure keeps track of all the virtual events that are
- * associated with a particular physical event. It is pointed to by the
- * voPtr field in a PatSeq in the patternTable of a virtual event table.
- */
- typedef struct VirtualOwners {
- int numOwners; /* Number of virtual events to trigger. */
- Tcl_HashEntry *owners[1]; /* Array of pointers to entries in
- * nameTable. Enough space will
- * actually be allocated for numOwners
- * hash entries. */
- } VirtualOwners;
- /*
- * The following structure is used in the nameTable of a virtual event
- * table to associate a virtual event with all the physical events that can
- * trigger it.
- */
- typedef struct PhysicalsOwned {
- int numOwned; /* Number of physical events owned. */
- PatSeq *patSeqs[1]; /* Array of pointers to physical event
- * patterns. Enough space will actually
- * be allocated to hold numOwned. */
- } PhysicalsOwned;
- /*
- * One of the following structures exists for each interpreter. This
- * structure keeps track of the current display and screen in the
- * interpreter, so that a script can be invoked whenever the display/screen
- * changes (the script does things like point 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 {
- char *name; /* Name of keysym. */
- KeySym value; /* Numeric identifier for keysym. */
- } KeySymInfo;
- static KeySymInfo keyArray[] = {
- #ifndef lint
- #include "ks_names.h"
- #endif
- {(char *) NULL, 0}
- };
- static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
- static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
- #endif /* REDO_KEYSYM_LOOKUP */
- /*
- * Set to non-zero when the package-wide static variables have been
- * initialized.
- */
- static int initialized = 0;
- 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 {
- 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 ModInfo modArray[] = {
- {"Control", ControlMask, 0},
- {"Shift", ShiftMask, 0},
- {"Lock", LockMask, 0},
- {"Meta", META_MASK, 0},
- {"M", META_MASK, 0},
- {"Alt", ALT_MASK, 0},
- {"B1", Button1Mask, 0},
- {"Button1", Button1Mask, 0},
- {"B2", Button2Mask, 0},
- {"Button2", Button2Mask, 0},
- {"B3", Button3Mask, 0},
- {"Button3", Button3Mask, 0},
- {"B4", Button4Mask, 0},
- {"Button4", Button4Mask, 0},
- {"B5", Button5Mask, 0},
- {"Button5", Button5Mask, 0},
- {"Mod1", Mod1Mask, 0},
- {"M1", Mod1Mask, 0},
- {"Command", Mod1Mask, 0},
- {"Mod2", Mod2Mask, 0},
- {"M2", Mod2Mask, 0},
- {"Option", Mod2Mask, 0},
- {"Mod3", Mod3Mask, 0},
- {"M3", Mod3Mask, 0},
- {"Mod4", Mod4Mask, 0},
- {"M4", Mod4Mask, 0},
- {"Mod5", Mod5Mask, 0},
- {"M5", Mod5Mask, 0},
- {"Double", 0, DOUBLE},
- {"Triple", 0, TRIPLE},
- {"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 {
- 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},
- {(char *) NULL, 0, 0}
- };
- static Tcl_HashTable eventTable;
- /*
- * The defines and table below are used to classify events into
- * various groups. The reason for this is that logically identical
- * fields (e.g. "state") appear at different places in different
- * types of events. The classification masks can be used to figure
- * out quickly where to extract information from events.
- */
- #define KEY 0x1
- #define BUTTON 0x2
- #define MOTION 0x4
- #define CROSSING 0x8
- #define FOCUS 0x10
- #define EXPOSE 0x20
- #define VISIBILITY 0x40
- #define CREATE 0x80
- #define DESTROY 0x100
- #define UNMAP 0x200
- #define MAP 0x400
- #define REPARENT 0x800
- #define CONFIG 0x1000
- #define GRAVITY 0x2000
- #define CIRC 0x4000
- #define PROP 0x8000
- #define COLORMAP 0x10000
- #define VIRTUAL 0x20000
- #define ACTIVATE 0x40000
- #define 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|CROSSING|VIRTUAL)
- static int flagArray[TK_LASTEVENT] = {
- /* Not used */ 0,
- /* Not used */ 0,
- /* KeyPress */ KEY,
- /* KeyRelease */ KEY,
- /* ButtonPress */ BUTTON,
- /* ButtonRelease */ BUTTON,
- /* MotionNotify */ MOTION,
- /* EnterNotify */ CROSSING,
- /* LeaveNotify */ CROSSING,
- /* FocusIn */ FOCUS,
- /* FocusOut */ FOCUS,
- /* KeymapNotify */ 0,
- /* Expose */ EXPOSE,
- /* GraphicsExpose */ EXPOSE,
- /* NoExpose */ 0,
- /* VisibilityNotify */ VISIBILITY,
- /* CreateNotify */ CREATE,
- /* DestroyNotify */ DESTROY,
- /* UnmapNotify */ UNMAP,
- /* MapNotify */ MAP,
- /* MapRequest */ 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 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 TkStateMap notifyMode[] = {
- {NotifyNormal, "NotifyNormal"},
- {NotifyGrab, "NotifyGrab"},
- {NotifyUngrab, "NotifyUngrab"},
- {NotifyWhileGrabbed, "NotifyWhileGrabbed"},
- {-1, NULL}
- };
- static TkStateMap notifyDetail[] = {
- {NotifyAncestor, "NotifyAncestor"},
- {NotifyVirtual, "NotifyVirtual"},
- {NotifyInferior, "NotifyInferior"},
- {NotifyNonlinear, "NotifyNonlinear"},
- {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
- {NotifyPointer, "NotifyPointer"},
- {NotifyPointerRoot, "NotifyPointerRoot"},
- {NotifyDetailNone, "NotifyDetailNone"},
- {-1, NULL}
- };
- static TkStateMap circPlace[] = {
- {PlaceOnTop, "PlaceOnTop"},
- {PlaceOnBottom, "PlaceOnBottom"},
- {-1, NULL}
- };
- static TkStateMap visNotify[] = {
- {VisibilityUnobscured, "VisibilityUnobscured"},
- {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
- {VisibilityFullyObscured, "VisibilityFullyObscured"},
- {-1, NULL}
- };
- static TkStateMap configureRequestDetail[] = {
- {None, "None"},
- {Above, "Above"},
- {Below, "Below"},
- {BottomIf, "BottomIf"},
- {TopIf, "TopIf"},
- {Opposite, "Opposite"},
- {-1, NULL}
- };
- static TkStateMap propNotify[] = {
- {PropertyNewValue, "NewValue"},
- {PropertyDelete, "Delete"},
- {-1, NULL}
- };
- /*
- * Prototypes for local procedures defined in this file:
- */
- static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
- char *dispName, int screenIndex));
- static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
- VirtualEventTable *vetPtr, char *virtString,
- char *eventString));
- static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
- VirtualEventTable *vetPtr, char *virtString,
- char *eventString));
- static void DeleteVirtualEventTable _ANSI_ARGS_((
- VirtualEventTable *vetPtr));
- static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
- CONST char *before, XEvent *eventPtr, KeySym keySym,
- Tcl_DString *dsPtr));
- static void FreeTclBinding _ANSI_ARGS_((ClientData clientData));
- static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_HashTable *patternTablePtr, ClientData object,
- CONST char *eventString, int create,
- int allowVirtual, unsigned long *maskPtr));
- static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
- VirtualEventTable *vetPtr));
- static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
- static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
- Tcl_DString *dsPtr));
- static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
- VirtualEventTable *vetPtr, char *virtString));
- static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
- char *virtString));
- static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window main, int objc,
- Tcl_Obj *CONST objv[]));
- static void InitVirtualEventTable _ANSI_ARGS_((
- VirtualEventTable *vetPtr));
- static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
- BindingTable *bindPtr, PatSeq *psPtr,
- PatSeq *bestPtr, ClientData *objectPtr,
- PatSeq **sourcePtrPtr));
- static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window main, Tcl_Obj *objPtr,
- Tk_Window *tkwinPtr));
- static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char **eventStringPtr, Pattern *patPtr,
- unsigned long *eventMaskPtr));
- static void DoWarp _ANSI_ARGS_((ClientData clientData));
- /*
- * The following define is used as a short circuit for the callback
- * procedure to evaluate a TclBinding. The actual evaluation of the
- * binding is handled inline, because special things have to be done
- * with a Tcl binding before evaluation time.
- */
- #define EvalTclBinding ((TkBindEvalProc *) 1)
- /*
- *---------------------------------------------------------------------------
- *
- * TkBindInit --
- *
- * This procedure is called when an application is created. It
- * initializes all the structures used by bindings and virtual
- * events. It must be called before any other functions in this
- * file are called.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory allocated.
- *
- *---------------------------------------------------------------------------
- */
- void
- TkBindInit(mainPtr)
- TkMainInfo *mainPtr; /* The newly created application. */
- {
- BindInfo *bindInfoPtr;
- if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
- panic("TkBindInit: virtual events can't be supported");
- }
- /*
- * Initialize the static data structures used by the binding package.
- * They are only initialized once, no matter how many interps are
- * created.
- */
- if (!initialized) {
- Tcl_MutexLock(&bindMutex);
- if (!initialized) {
- Tcl_HashEntry *hPtr;
- 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 procedure is called when an application is deleted. It
- * deletes all the structures used by bindings and virtual events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory freed.
- *
- *---------------------------------------------------------------------------
- */
- void
- TkBindFree(mainPtr)
- TkMainInfo *mainPtr; /* The newly created application. */
- {
- BindInfo *bindInfoPtr;
-
- Tk_DeleteBindingTable(mainPtr->bindingTable);
- mainPtr->bindingTable = NULL;
- bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
- DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
- bindInfoPtr->deleted = 1;
- Tcl_EventuallyFree((ClientData) 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 procedures like Tk_CreateBinding.
- *
- * Side effects:
- * Memory is allocated for the new table.
- *
- *--------------------------------------------------------------
- */
- Tk_BindingTable
- Tk_CreateBindingTable(interp)
- Tcl_Interp *interp; /* Interpreter to associate with the binding
- * table: commands are executed in this
- * interpreter. */
- {
- BindingTable *bindPtr;
- int i;
- /*
- * Create and initialize a new binding table.
- */
- bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
- for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
- bindPtr->eventRing[i].type = -1;
- }
- bindPtr->curEvent = 0;
- Tcl_InitHashTable(&bindPtr->patternTable,
- sizeof(PatternTableKey)/sizeof(int));
- Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
- bindPtr->interp = interp;
- return (Tk_BindingTable) bindPtr;
- }
- /*
- *--------------------------------------------------------------
- *
- * Tk_DeleteBindingTable --
- *
- * Destroy a binding table and free up all its memory.
- * The caller should not use bindingTable again after
- * this procedure returns.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory is freed.
- *
- *--------------------------------------------------------------
- */
- void
- Tk_DeleteBindingTable(bindingTable)
- Tk_BindingTable bindingTable; /* Token for the binding table to
- * destroy. */
- {
- BindingTable *bindPtr = (BindingTable *) bindingTable;
- PatSeq *psPtr, *nextPtr;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
- /*
- * Find and delete all of the patterns associated with the binding
- * table.
- */
- for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- psPtr != NULL; psPtr = nextPtr) {
- nextPtr = psPtr->nextSeqPtr;
- psPtr->flags |= MARKED_DELETED;
- if (psPtr->refCount == 0) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
- }
- }
- /*
- * Clean up the rest of the information associated with the
- * binding table.
- */
- Tcl_DeleteHashTable(&bindPtr->patternTable);
- Tcl_DeleteHashTable(&bindPtr->objectTable);
- ckfree((char *) bindPtr);
- }
- /*
- *--------------------------------------------------------------
- *
- * Tk_CreateBinding --
- *
- * Add a binding to a binding table, so that future calls to
- * Tk_BindEvent may execute the command in the binding.
- *
- * Results:
- * The return value is 0 if an error occurred while setting
- * up the binding. In this case, an error message will be
- * left in 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(interp, bindingTable, object, eventString, command, append)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tk_BindingTable bindingTable;
- /* Table in which to create binding. */
- ClientData object; /* Token for object with which binding is
- * associated. */
- 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 *new, *old;
- psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
- 1, 1, &eventMask);
- if (psPtr == NULL) {
- return 0;
- }
- if (psPtr->eventProc == NULL) {
- int new;
- Tcl_HashEntry *hPtr;
-
- /*
- * This pattern sequence was just created.
- * Link the pattern into the list associated with the object, so
- * that if the object goes away, these bindings will all
- * automatically be deleted.
- */
- hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
- &new);
- if (new) {
- psPtr->nextObjPtr = NULL;
- } else {
- psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- }
- Tcl_SetHashValue(hPtr, psPtr);
- } else if (psPtr->eventProc != EvalTclBinding) {
- /*
- * Free existing procedural binding.
- */
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- psPtr->clientData = NULL;
- append = 0;
- }
- old = (char *) psPtr->clientData;
- if ((append != 0) && (old != NULL)) {
- int length;
- length = strlen(old) + strlen(command) + 2;
- new = (char *) ckalloc((unsigned) length);
- sprintf(new, "%sn%s", old, command);
- } else {
- new = (char *) ckalloc((unsigned) strlen(command) + 1);
- strcpy(new, command);
- }
- if (old != NULL) {
- ckfree(old);
- }
- psPtr->eventProc = EvalTclBinding;
- psPtr->freeProc = FreeTclBinding;
- psPtr->clientData = (ClientData) new;
- return eventMask;
- }
- /*
- *---------------------------------------------------------------------------
- *
- * TkCreateBindingProcedure --
- *
- * Add a C binding to a binding table, so that future calls to
- * Tk_BindEvent may callback the procedure in the binding.
- *
- * Results:
- * The return value is 0 if an error occurred while setting
- * up the binding. In this case, an error message will be
- * left in 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(interp, bindingTable, object, eventString,
- eventProc, freeProc, clientData)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tk_BindingTable bindingTable;
- /* Table in which to create binding. */
- ClientData object; /* Token for object with which binding is
- * associated. */
- CONST char *eventString; /* String describing event sequence that
- * triggers binding. */
- TkBindEvalProc *eventProc; /* Procedure to invoke when binding
- * triggers. Must not be NULL. */
- TkBindFreeProc *freeProc; /* Procedure to invoke when binding is
- * freed. May be NULL for no procedure. */
- ClientData clientData; /* Arbitrary ClientData to pass to eventProc
- * and freeProc. */
- {
- BindingTable *bindPtr = (BindingTable *) bindingTable;
- PatSeq *psPtr;
- unsigned long eventMask;
- psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
- 1, 1, &eventMask);
- if (psPtr == NULL) {
- return 0;
- }
- if (psPtr->eventProc == NULL) {
- int new;
- Tcl_HashEntry *hPtr;
-
- /*
- * This pattern sequence was just created.
- * Link the pattern into the list associated with the object, so
- * that if the object goes away, these bindings will all
- * automatically be deleted.
- */
- hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
- &new);
- if (new) {
- psPtr->nextObjPtr = NULL;
- } else {
- psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- }
- Tcl_SetHashValue(hPtr, psPtr);
- } else {
- /*
- * Free existing callback.
- */
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- }
- psPtr->eventProc = eventProc;
- psPtr->freeProc = freeProc;
- psPtr->clientData = clientData;
- return eventMask;
- }
- /*
- *--------------------------------------------------------------
- *
- * Tk_DeleteBinding --
- *
- * Remove an event binding from a binding table.
- *
- * Results:
- * The result is a standard Tcl return value. If an error
- * occurs then 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(interp, bindingTable, object, eventString)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tk_BindingTable bindingTable; /* Table in which to delete binding. */
- ClientData object; /* Token for object with which binding
- * is associated. */
- 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) {
- panic("Tk_DeleteBinding couldn't find object table entry");
- }
- prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- if (prevPtr == psPtr) {
- Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
- } else {
- for ( ; ; prevPtr = prevPtr->nextObjPtr) {
- if (prevPtr == NULL) {
- panic("Tk_DeleteBinding couldn't find on object list");
- }
- if (prevPtr->nextObjPtr == psPtr) {
- prevPtr->nextObjPtr = psPtr->nextObjPtr;
- break;
- }
- }
- }
- prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
- if (prevPtr == psPtr) {
- if (psPtr->nextSeqPtr == NULL) {
- Tcl_DeleteHashEntry(psPtr->hPtr);
- } else {
- Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
- }
- } else {
- for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
- if (prevPtr == NULL) {
- panic("Tk_DeleteBinding couldn't find on hash chain");
- }
- if (prevPtr->nextSeqPtr == psPtr) {
- prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
- break;
- }
- }
- }
- psPtr->flags |= MARKED_DELETED;
- if (psPtr->refCount == 0) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
- return TCL_OK;
- }
- /*
- *--------------------------------------------------------------
- *
- * Tk_GetBinding --
- *
- * Return the command associated with a given event string.
- *
- * Results:
- * The return value is a pointer to the command string
- * associated with eventString for object in the domain
- * given by bindingTable. If there is no binding for
- * eventString, or if eventString is improperly formed,
- * then NULL is returned and an error message is left in
- * 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(interp, bindingTable, object, eventString)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- Tk_BindingTable bindingTable; /* Table in which to look for
- * binding. */
- ClientData object; /* Token for object with which binding
- * is associated. */
- 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(interp, bindingTable, object)
- Tcl_Interp *interp; /* Interpreter returning result or
- * error. */
- Tk_BindingTable bindingTable; /* Table in which to look for
- * bindings. */
- ClientData object; /* Token for object. */
- {
- BindingTable *bindPtr = (BindingTable *) bindingTable;
- PatSeq *psPtr;
- Tcl_HashEntry *hPtr;
- Tcl_DString ds;
- hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
- if (hPtr == NULL) {
- return;
- }
- Tcl_DStringInit(&ds);
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
- psPtr = psPtr->nextObjPtr) {
- /*
- * For each binding, output information about each of the
- * patterns in its sequence.
- */
-
- Tcl_DStringSetLength(&ds, 0);
- GetPatternString(psPtr, &ds);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
- }
- Tcl_DStringFree(&ds);
- }
- /*
- *--------------------------------------------------------------
- *
- * Tk_DeleteAllBindings --
- *
- * Remove all bindings associated with a given object in a
- * given binding table.
- *
- * Results:
- * All bindings associated with object are removed from
- * bindingTable.
- *
- * Side effects:
- * None.
- *
- *--------------------------------------------------------------
- */
- void
- Tk_DeleteAllBindings(bindingTable, object)
- Tk_BindingTable bindingTable; /* Table in which to delete
- * bindings. */
- ClientData object; /* Token for object. */
- {
- BindingTable *bindPtr = (BindingTable *) bindingTable;
- PatSeq *psPtr, *prevPtr;
- PatSeq *nextPtr;
- Tcl_HashEntry *hPtr;
- hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
- if (hPtr == NULL) {
- return;
- }
- for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
- psPtr = nextPtr) {
- nextPtr = psPtr->nextObjPtr;
- /*
- * Be sure to remove each binding from its hash chain in the
- * pattern table. If this is the last pattern in the chain,
- * then delete the hash entry too.
- */
- prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
- if (prevPtr == psPtr) {
- if (psPtr->nextSeqPtr == NULL) {
- Tcl_DeleteHashEntry(psPtr->hPtr);
- } else {
- Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
- }
- } else {
- for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
- if (prevPtr == NULL) {
- panic("Tk_DeleteAllBindings couldn't find on hash chain");
- }
- if (prevPtr->nextSeqPtr == psPtr) {
- prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
- break;
- }
- }
- }
- psPtr->flags |= MARKED_DELETED;
- if (psPtr->refCount == 0) {
- if (psPtr->freeProc != NULL) {
- (*psPtr->freeProc)(psPtr->clientData);
- }
- ckfree((char *) psPtr);
- }
- }
- Tcl_DeleteHashEntry(hPtr);
- }
- /*
- *---------------------------------------------------------------------------
- *
- * Tk_BindEvent --
- *
- * This procedure is invoked to process an X event. The
- * event is added to those recorded for the binding table.
- * Then each of the objects at *objectPtr is checked in
- * order to see if it has a binding that matches the recent
- * events. If so, the most specific binding is invoked for
- * each object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Depends on the command associated with the matching binding.
- *
- * All Tcl bindings scripts for each object are accumulated before
- * the first binding is evaluated. If the action of a Tcl binding
- * is to change or delete a binding, or delete the window associated
- * with the binding, all the original Tcl binding scripts will still
- * fire. Contrast this with C binding procedures. If a pending C
- * binding (one that hasn't fired yet, but is queued to be fired for
- * this window) is deleted, it will not be called, and if it is
- * changed, then the new binding procedure will be called. If the
- * window itself is deleted, no further C binding procedures will be
- * called for this window. When both Tcl binding scripts and C binding
- * procedures are interleaved, the above rules still apply.
- *
- *---------------------------------------------------------------------------
- */
- void
- Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
- Tk_BindingTable bindingTable; /* Table in which to look for
- * bindings. */
- XEvent *eventPtr; /* What actually happened. */
- Tk_Window tkwin; /* Window on display where event
- * occurred (needed in order to
- * locate display information). */
- int numObjects; /* Number of objects at *objectPtr. */
- ClientData *objectPtr; /* Array of one or more objects
- * to check for a matching binding. */
- {
- BindingTable *bindPtr;
- TkDisplay *dispPtr;
- 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 *pendingPtr;
- PendingBinding staticPending;
- 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((VOID *) ringPtr, (VOID *) 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;
- Tcl_HashEntry *hPtr;
- veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
- key.object = NULL;
- key.type = ringPtr->type;
- key.detail = detail;
- hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
- if (hPtr != NULL) {
- vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
- }
- if (key.detail.clientData != 0) {
- key.detail.clientData = 0;
- hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
- if (hPtr != NULL) {
- vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
- }
- }
- }
- /*
- * Loop over all the binding tags, finding the binding script or
- * callback for each one. Append all of the binding scripts, with
- * %-sequences expanded, to "scripts", with null characters separating
- * the scripts for each object. Append all the callbacks to the array
- * of pending callbacks.
- */
-
- pendingPtr = &staticPending;
- matchCount = 0;
- matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
- Tcl_DStringInit(&scripts);
- for ( ; numObjects > 0; numObjects--, objectPtr++) {
- PatSeq *matchPtr, *sourcePtr;
- Tcl_HashEntry *hPtr;
- matchPtr = NULL;
- sourcePtr = NULL;
- /*
- * Match the new event against those recorded in the pattern table,
- * saving the longest matching pattern. For events with details
- * (button and key events), look for a binding for the specific
- * key or button. First see if the event matches a physical event
- * that the object is interested in, then look for a virtual event.
- */
- key.object = *objectPtr;
- key.type = ringPtr->type;
- key.detail = detail;
- hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
- if (hPtr != NULL) {
- matchPtr = MatchPatterns(dispPtr, bindPtr,
- (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
- &sourcePtr);
- }
- if (vMatchDetailList != NULL) {
- matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
- matchPtr, objectPtr, &sourcePtr);
- }
- /*
- * If no match was found, look for a binding for all keys or buttons
- * (detail of 0). Again, first match on a virtual event.
- */
- if ((detail.clientData != 0) && (matchPtr == NULL)) {
- key.detail.clientData = 0;
- hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
- if (hPtr != NULL) {
- matchPtr = MatchPatterns(dispPtr, bindPtr,
- (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
- &sourcePtr);
- }
- if (vMatchNoDetailList != NULL) {
- matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
- matchPtr, objectPtr, &sourcePtr);
- }
- }
-
- if (matchPtr != NULL) {
- if (sourcePtr->eventProc == NULL) {
- panic("Tk_BindEvent: missing command");
- }
- if (sourcePtr->eventProc == EvalTclBinding) {
- ExpandPercents(winPtr, (char *) sourcePtr->clientData,
- eventPtr, detail.keySym, &scripts);
- } else {
- if (matchCount >= matchSpace) {
- PendingBinding *new;
- unsigned int oldSize, newSize;
-
- oldSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
- matchSpace *= 2;
- newSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
- new = (PendingBinding *) ckalloc(newSize);
- memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
- if (pendingPtr != &staticPending) {
- ckfree((char *) pendingPtr);
- }
- pendingPtr = new;
- }
- sourcePtr->refCount++;
- pendingPtr->matchArray[matchCount] = sourcePtr;
- matchCount++;
- }
- /*
- * A "" is added to the scripts string to separate the
- * various scripts that should be invoked.
- */
- Tcl_DStringAppend(&scripts, "", 1);
- }
- }
- if (Tcl_DStringLength(&scripts) == 0) {
- return;
- }
- /*
- * Now go back through and evaluate the binding for each object,
- * in order, dealing with "break" and "continue" exceptions
- * appropriately.
- *
- * There are two tricks here:
- * 1. Bindings can be invoked from in the middle of Tcl commands,
- * where 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((ClientData) bindInfoPtr);
- while (p < end) {
- int code;
-
- if (!bindInfoPtr->deleted) {
- screenPtr->bindingDepth++;
- }
- Tcl_AllowExceptions(interp);
- if (*p == ' ') {
- 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((ClientData) bindInfoPtr);
- }
- /*
- *---------------------------------------------------------------------------
- *
- * TkBindDeadWindow --
- *
- * This procedure is invoked when it is determined that a window is
- * dead. It cleans up bind-related information about the window
- *
- * Results:
- * None.
- *
- * Side effects:
- * Any pending C bindings for this window are cancelled.
- *
- *---------------------------------------------------------------------------
- */
-
- void
- TkBindDeadWindow(winPtr)
- TkWindow *winPtr; /* The window that is being deleted. */
- {
- BindInfo *bindInfoPtr;
- PendingBinding *curPtr;
- /*
- * 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 procedure is used in two different ways. In the simplest
- * use, "object" is NULL and psPtr is a list of pattern sequences,
- * each of which corresponds to a binding. In this case, the
- * procedure finds the pattern sequences that match the event list
- * and returns the most specific of those, if there is more than one.
- *
- * In the second case, psPtr is a list of pattern sequences, each
- * of which corresponds to a definition for a virtual binding.
- * In order for one of these sequences to "match", it must match
- * the events (as above) but in addition there must be a binding
- * for its associated virtual event on the current object. The
- * "object" argument indicates which object the binding must be for.
- *
- * Results:
- * The return value is NULL if bestPtr is NULL and no pattern matches
- * the recent events from bindPtr. Otherwise the return value is
- * the most specific pattern sequence among bestPtr and all those
- * at psPtr that match the event list and object. If a pattern
- * sequence other than bestPtr is returned, then *bestCommandPtr
- * is filled in with a pointer to the command from the best sequence.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- static PatSeq *
- MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
- TkDisplay *dispPtr; /* Display from which the event came. */
- BindingTable *bindPtr; /* Information about binding table, such as
- * ring of recent events. */
- PatSeq *psPtr; /* List of pattern sequences. */
- PatSeq *bestPtr; /* The best match seen so far, from a
- * previous call to this procedure. NULL
- * means no prior best match. */
- ClientData *objectPtr; /* If NULL, the sequences at psPtr
- * correspond to "normal" bindings. If
- * non-NULL, the sequences at psPtr correspond
- * to virtual bindings; in order to match each
- * sequence must correspond to a virtual
- * binding for which a binding exists for
- * object in bindPtr. */
- PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that
- * contains the eventProc and clientData
- * associated with the best match. If this
- * differs from the return value, it is the
- * virtual event that most closely matched the
- * return value (a physical event). Not
- * modified unless a result other than bestPtr
- * is returned. */
- {
- PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
- bestSourcePtr = *sourcePtrPtr;
- /*
- * Iterate over all the pattern sequences.
- */
- for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
- XEvent *eventPtr;
- Pattern *patPtr;
- Window window;
- Detail *detailPtr;
- int patCount, ringCount, flags, state;
- int modMask;
- /*
- * Iterate over all the patterns in a sequence to be
- * sure that they all match.
- */
- eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
- detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
- window = eventPtr->xany.window;
- patPtr = psPtr->pats;
- patCount = psPtr->numPats;
- ringCount = EVENT_BUFFER_SIZE;
- while (patCount > 0) {
- if (ringCount <= 0) {
- goto nextSequence;
- }
- if (eventPtr->xany.type != patPtr->eventType) {
- /*
- * Most of the event types are considered superfluous
- * in that they are ignored if they occur in the middle
- * of a pattern sequence and have mismatching types. The
- * only ones that cannot be ignored are ButtonPress and
- * ButtonRelease events (if the next event in the pattern
- * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
- * events (if the next pattern event is a ButtonPress or
- * ButtonRelease). Here are some tricky cases to consider:
- * 1. Double-Button or Double-Key events.
- * 2. Double-ButtonRelease or Double-KeyRelease events.
- * 3. The arrival of various events like Enter and Leave
- * and FocusIn and GraphicsExpose between two button
- * presses or key presses.
- * 4. Modifier keys like Shift and Control shouldn't
- * generate conflicts with button events.
- */
- if ((patPtr->eventType == KeyPress)
- || (patPtr->eventType == KeyRelease)) {
- if ((eventPtr->xany.type == ButtonPress)
- || (eventPtr->xany.type == ButtonRelease)) {
- goto nextSequence;
- }
- } else if ((patPtr->eventType == ButtonPress)
- || (patPtr->eventType == ButtonRelease)) {
- if ((eventPtr->xany.type == KeyPress)
- || (eventPtr->xany.type == KeyRelease)) {
- int i;
- /*
- * Ignore key events if they are modifier keys.
- */
- for (i = 0; i < dispPtr->numModKeyCodes; i++) {
- if (dispPtr->modKeyCodes[i]
- == eventPtr->xkey.keycode) {
- /*
- * This key is a modifier key, so ignore it.
- */
- goto nextEvent;
- }
- }
- goto nextSequence;
- }
- }
- goto nextEvent;
- }
- if (eventPtr->xany.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) {
- int i;
- for (i = 0; i < dispPtr->numModKeyCodes; i++) {
- if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
- goto nextEvent;
- }
- }
- }
- goto nextSequence;
- }
- flags = flagArray[eventPtr->type];
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
- state = eventPtr->xkey.state;
- } else if (flags & CROSSING) {
- state = eventPtr->xcrossing.state;
- } else {
- state = 0;
- }
- if (patPtr->needMods != 0) {
- modMask = patPtr->needMods;
- if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
- modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
- }
- if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
- modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
- }
- if ((state & 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;
- int timeDiff;
- firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
- timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
- if ((firstPtr->xkey.x_root
- < (eventPtr->xkey.x_root - NEARBY_PIXELS))
- || (firstPtr->xkey.x_root
- > (eventPtr->xkey.x_root + NEARBY_PIXELS))
- || (firstPtr->xkey.y_root
- < (eventPtr->xkey.y_root - NEARBY_PIXELS))
- || (firstPtr->xkey.y_root
- > (eventPtr->xkey.y_root + NEARBY_PIXELS))
- || (timeDiff > NEARBY_MS)) {
- goto nextSequence;
- }
- }
- patPtr++;
- patCount--;
- nextEvent:
- if (eventPtr == bindPtr->eventRing) {
- eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
- detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
- } else {
- eventPtr--;
- detailPtr--;
- }
- ringCount--;
- }
- matchPtr = psPtr;
- sourcePtr = psPtr;
- if (objectPtr != NULL) {
- int iVirt;
- VirtualOwners *voPtr;
- PatternTableKey key;
- /*
- * The sequence matches the physical constraints.
- * Is this object interested in any of the virtual events
- * that correspond to this sequence?
- */
- voPtr = psPtr->voPtr;
- memset(&key, 0, sizeof(key));
- key.object = *objectPtr;
- key.type = VirtualEvent;
- key.detail.clientData = 0;
- for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
- Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
- key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
- hPtr);
- hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
- (char *) &key);
- if (hPtr != NULL) {
- /*
- * This tag is interested in this virtual event and its
- * corresponding physical event is a good match with the
- * virtual event's definition.
- */
- PatSeq *virtMatchPtr;
- virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
- if ((virtMatchPtr->numPats != 1)
- || (virtMatchPtr->nextSeqPtr != NULL)) {
- panic("MatchPattern: badly constructed virtual event");
- }
- sourcePtr = virtMatchPtr;
- goto match;
- }
- }
- /*
- * The physical event matches a virtual event's definition, but
- * the tag isn't interested in it.
- */
- goto nextSequence;
- }
- match:
- /*
- * This sequence matches. If we've already got another match,
- * pick whichever is most specific. Detail is most important,
- * then needMods.
- */
- if (bestPtr != NULL) {
- Pattern *patPtr2;
- int i;
- if (matchPtr->numPats != bestPtr->numPats) {
- if (bestPtr->numPats > matchPtr->numPats) {
- goto nextSequence;
- } else {
- goto newBest;
- }
- }
- for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
- i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
- if (patPtr->detail.clientData != patPtr2->detail.clientData) {
- if (patPtr->detail.clientData == 0) {
- goto nextSequence;
- } else {
- goto newBest;
- }
- }
- if (patPtr->needMods != patPtr2->needMods) {
- if ((patPtr->needMods & patPtr2->needMods)
- == patPtr->needMods) {
- goto nextSequence;
- } else if ((patPtr->needMods & patPtr2->needMods)
- == patPtr2->needMods) {
- goto newBest;
- }
- }
- }
- /*
- * Tie goes to current best pattern.
- *
- * (1) For virtual vs. virtual, the least recently defined
- * virtual wins, because virtuals are examined in order of
- * definition. This order is _not_ guaranteed in the
- * documentation.
- *
- * (2) For virtual vs. physical, the physical wins because all
- * the physicals are examined before the virtuals. This order
- * is guaranteed in the documentation.
- *
- * (3) For physical vs. physical pattern, the most recently
- * defined physical wins, because physicals are examined in
- * reverse order of definition. This order is guaranteed in
- * the documentation.
- */
- goto nextSequence;
- }
- newBest:
- bestPtr = matchPtr;
- bestSourcePtr = sourcePtr;
- nextSequence:
- continue;
- }
- *sourcePtrPtr = bestSourcePtr;
- return bestPtr;
- }
- /*
- *--------------------------------------------------------------
- *
- * ExpandPercents --
- *
- * Given a command and an event, produce a new command
- * by replacing % constructs in the original command
- * with information from the X event.
- *
- * Results:
- * The new expanded command is appended to the dynamic string
- * given by dsPtr.
- *
- * Side effects:
- * None.
- *
- *--------------------------------------------------------------
- */
- static void
- ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
- TkWindow *winPtr; /* Window where event occurred: needed to
- * get input context. */
- 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;
- }