4744 lines
134 KiB
C
4744 lines
134 KiB
C
/*
|
||
* tkBind.c --
|
||
*
|
||
* This file provides procedures that associate Tcl commands
|
||
* with X events or sequences of X events.
|
||
*
|
||
* Copyright (c) 1989-1994 The Regents of the University of California.
|
||
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||
*
|
||
* See the file "license.terms" for information on usage and redistribution
|
||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||
*
|
||
* SCCS: @(#) tkBind.c 1.133 97/07/01 17:59:53
|
||
*/
|
||
|
||
#include "tkPort.h"
|
||
#include "tkInt.h"
|
||
|
||
#ifdef BGLk_CODE
|
||
# define STk_add_callback SCM_add_callback
|
||
#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 tkPriv at a display-specific
|
||
* structure).
|
||
*/
|
||
|
||
typedef struct {
|
||
TkDisplay *curDispPtr; /* Display for last binding command invoked
|
||
* in this application. */
|
||
int curScreenIndex; /* Index of screen for last binding command. */
|
||
int bindingDepth; /* Number of active instances of Tk_BindEvent
|
||
* in this application. */
|
||
} ScreenInfo;
|
||
|
||
/*
|
||
* The following structure is used to keep track of all the C bindings that
|
||
* are awaiting invocation and whether the window they refer to has been
|
||
* destroyed. If the window is destroyed, then all pending callbacks for
|
||
* that window will be cancelled. The Tcl bindings will still all be
|
||
* invoked, however.
|
||
*/
|
||
|
||
typedef struct PendingBinding {
|
||
struct PendingBinding *nextPtr;
|
||
/* Next in chain of pending bindings, in
|
||
* case a recursive binding evaluation is in
|
||
* progress. */
|
||
Tk_Window tkwin; /* The window that the following bindings
|
||
* depend upon. */
|
||
int deleted; /* Set to non-zero by window cleanup code
|
||
* if tkwin is deleted. */
|
||
PatSeq *matchArray[5]; /* Array of pending C bindings. The actual
|
||
* size of this depends on how many C bindings
|
||
* matched the event passed to Tk_BindEvent.
|
||
* THIS FIELD MUST BE THE LAST IN THE
|
||
* STRUCTURE. */
|
||
} PendingBinding;
|
||
|
||
/*
|
||
* The following structure keeps track of all the information local to
|
||
* the binding package on a per interpreter basis.
|
||
*/
|
||
|
||
typedef struct BindInfo {
|
||
VirtualEventTable virtualEventTable;
|
||
/* The virtual events that exist in this
|
||
* interpreter. */
|
||
ScreenInfo screenInfo; /* Keeps track of the current display and
|
||
* screen, so it can be restored after
|
||
* a binding has executed. */
|
||
PendingBinding *pendingList;/* The list of pending C bindings, kept in
|
||
* case a C or Tcl binding causes the target
|
||
* window to be deleted. */
|
||
} BindInfo;
|
||
|
||
/*
|
||
* In X11R4 and earlier versions, XStringToKeysym is ridiculously
|
||
* slow. The data structure and hash table below, along with the
|
||
* code that uses them, implement a fast mapping from strings to
|
||
* keysyms. In X11R5 and later releases XStringToKeysym is plenty
|
||
* fast so this stuff isn't needed. The #define REDO_KEYSYM_LOOKUP
|
||
* is normally undefined, so that XStringToKeysym gets used. It
|
||
* can be set in the Makefile to enable the use of the hash table
|
||
* below.
|
||
*/
|
||
|
||
#ifdef REDO_KEYSYM_LOOKUP
|
||
typedef struct {
|
||
char *name; /* Name of keysym. */
|
||
KeySym value; /* Numeric identifier for keysym. */
|
||
} KeySymInfo;
|
||
static KeySymInfo keyArray[] = {
|
||
#ifndef lint
|
||
#include "ks_names.h"
|
||
#endif
|
||
{(char *) NULL, 0}
|
||
};
|
||
static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
|
||
static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
|
||
#endif /* REDO_KEYSYM_LOOKUP */
|
||
|
||
/*
|
||
* Set to non-zero when the package-wide static variables have been
|
||
* initialized.
|
||
*/
|
||
|
||
static int initialized = 0;
|
||
|
||
/*
|
||
* A hash table is kept to map from the string names of event
|
||
* modifiers to information about those modifiers. The structure
|
||
* for storing this information, and the hash table built at
|
||
* initialization time, are defined below.
|
||
*/
|
||
|
||
typedef struct {
|
||
char *name; /* Name of modifier. */
|
||
int mask; /* Button/modifier mask value, * such as Button1Mask. */
|
||
int flags; /* Various flags; see below for
|
||
* definitions. */
|
||
} ModInfo;
|
||
|
||
/*
|
||
* Flags for ModInfo structures:
|
||
*
|
||
* DOUBLE - Non-zero means duplicate this event,
|
||
* e.g. for double-clicks.
|
||
* TRIPLE - Non-zero means triplicate this event,
|
||
* e.g. for triple-clicks.
|
||
*/
|
||
|
||
#define DOUBLE 1
|
||
#define TRIPLE 2
|
||
|
||
/*
|
||
* The following special modifier mask bits are defined, to indicate
|
||
* logical modifiers such as Meta and Alt that may float among the
|
||
* actual modifier bits.
|
||
*/
|
||
|
||
#define META_MASK (AnyModifier<<1)
|
||
#define ALT_MASK (AnyModifier<<2)
|
||
|
||
static ModInfo modArray[] = {
|
||
{"Control", ControlMask, 0},
|
||
{"Shift", ShiftMask, 0},
|
||
{"Lock", LockMask, 0},
|
||
{"Meta", META_MASK, 0},
|
||
{"M", META_MASK, 0},
|
||
{"Alt", ALT_MASK, 0},
|
||
{"B1", Button1Mask, 0},
|
||
{"Button1", Button1Mask, 0},
|
||
{"B2", Button2Mask, 0},
|
||
{"Button2", Button2Mask, 0},
|
||
{"B3", Button3Mask, 0},
|
||
{"Button3", Button3Mask, 0},
|
||
{"B4", Button4Mask, 0},
|
||
{"Button4", Button4Mask, 0},
|
||
{"B5", Button5Mask, 0},
|
||
{"Button5", Button5Mask, 0},
|
||
{"Mod1", Mod1Mask, 0},
|
||
{"M1", Mod1Mask, 0},
|
||
{"Command", Mod1Mask, 0},
|
||
{"Mod2", Mod2Mask, 0},
|
||
{"M2", Mod2Mask, 0},
|
||
{"Option", Mod2Mask, 0},
|
||
{"Mod3", Mod3Mask, 0},
|
||
{"M3", Mod3Mask, 0},
|
||
{"Mod4", Mod4Mask, 0},
|
||
{"M4", Mod4Mask, 0},
|
||
{"Mod5", Mod5Mask, 0},
|
||
{"M5", Mod5Mask, 0},
|
||
{"Double", 0, DOUBLE},
|
||
{"Triple", 0, TRIPLE},
|
||
{"Any", 0, 0}, /* Ignored: historical relic. */
|
||
{NULL, 0, 0}
|
||
};
|
||
static Tcl_HashTable modTable;
|
||
|
||
/*
|
||
* This module also keeps a hash table mapping from event names
|
||
* to information about those events. The structure, an array
|
||
* to use to initialize the hash table, and the hash table are
|
||
* all defined below.
|
||
*/
|
||
|
||
typedef struct {
|
||
char *name; /* Name of event. */
|
||
int type; /* Event type for X, such as
|
||
* ButtonPress. */
|
||
int eventMask; /* Mask bits (for XSelectInput)
|
||
* for this event type. */
|
||
} EventInfo;
|
||
|
||
/*
|
||
* Note: some of the masks below are an OR-ed combination of
|
||
* several masks. This is necessary because X doesn't report
|
||
* up events unless you also ask for down events. Also, X
|
||
* doesn't report button state in motion events unless you've
|
||
* asked about button events.
|
||
*/
|
||
|
||
static EventInfo eventArray[] = {
|
||
{"Key", KeyPress, KeyPressMask},
|
||
{"KeyPress", KeyPress, KeyPressMask},
|
||
{"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
|
||
{"Button", ButtonPress, ButtonPressMask},
|
||
{"ButtonPress", ButtonPress, ButtonPressMask},
|
||
{"ButtonRelease", ButtonRelease,
|
||
ButtonPressMask|ButtonReleaseMask},
|
||
{"Motion", MotionNotify,
|
||
ButtonPressMask|PointerMotionMask},
|
||
{"Enter", EnterNotify, EnterWindowMask},
|
||
{"Leave", LeaveNotify, LeaveWindowMask},
|
||
{"FocusIn", FocusIn, FocusChangeMask},
|
||
{"FocusOut", FocusOut, FocusChangeMask},
|
||
{"Expose", Expose, ExposureMask},
|
||
{"Visibility", VisibilityNotify, VisibilityChangeMask},
|
||
{"Destroy", DestroyNotify, StructureNotifyMask},
|
||
{"Unmap", UnmapNotify, StructureNotifyMask},
|
||
{"Map", MapNotify, StructureNotifyMask},
|
||
{"Reparent", ReparentNotify, StructureNotifyMask},
|
||
{"Configure", ConfigureNotify, StructureNotifyMask},
|
||
{"Gravity", GravityNotify, StructureNotifyMask},
|
||
{"Circulate", CirculateNotify, StructureNotifyMask},
|
||
{"Property", PropertyNotify, PropertyChangeMask},
|
||
{"Colormap", ColormapNotify, ColormapChangeMask},
|
||
{"Activate", ActivateNotify, ActivateMask},
|
||
{"Deactivate", DeactivateNotify, ActivateMask},
|
||
{(char *) NULL, 0, 0}
|
||
};
|
||
static Tcl_HashTable eventTable;
|
||
|
||
/*
|
||
* The defines and table below are used to classify events into
|
||
* various groups. The reason for this is that logically identical
|
||
* fields (e.g. "state") appear at different places in different
|
||
* types of events. The classification masks can be used to figure
|
||
* out quickly where to extract information from events.
|
||
*/
|
||
|
||
#define KEY 0x1
|
||
#define BUTTON 0x2
|
||
#define MOTION 0x4
|
||
#define CROSSING 0x8
|
||
#define FOCUS 0x10
|
||
#define EXPOSE 0x20
|
||
#define VISIBILITY 0x40
|
||
#define CREATE 0x80
|
||
#define DESTROY 0x100
|
||
#define UNMAP 0x200
|
||
#define MAP 0x400
|
||
#define REPARENT 0x800
|
||
#define CONFIG 0x1000
|
||
#define GRAVITY 0x2000
|
||
#define CIRC 0x4000
|
||
#define PROP 0x8000
|
||
#define COLORMAP 0x10000
|
||
#define VIRTUAL 0x20000
|
||
#define ACTIVATE 0x40000
|
||
|
||
#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
|
||
|
||
static int flagArray[TK_LASTEVENT] = {
|
||
/* Not used */ 0,
|
||
/* Not used */ 0,
|
||
/* KeyPress */ KEY,
|
||
/* KeyRelease */ KEY,
|
||
/* ButtonPress */ BUTTON,
|
||
/* ButtonRelease */ BUTTON,
|
||
/* MotionNotify */ MOTION,
|
||
/* EnterNotify */ CROSSING,
|
||
/* LeaveNotify */ CROSSING,
|
||
/* FocusIn */ FOCUS,
|
||
/* FocusOut */ FOCUS,
|
||
/* KeymapNotify */ 0,
|
||
/* Expose */ EXPOSE,
|
||
/* GraphicsExpose */ EXPOSE,
|
||
/* NoExpose */ 0,
|
||
/* VisibilityNotify */ VISIBILITY,
|
||
/* CreateNotify */ CREATE,
|
||
/* DestroyNotify */ DESTROY,
|
||
/* UnmapNotify */ UNMAP,
|
||
/* MapNotify */ MAP,
|
||
/* MapRequest */ 0,
|
||
/* ReparentNotify */ REPARENT,
|
||
/* ConfigureNotify */ CONFIG,
|
||
/* ConfigureRequest */ 0,
|
||
/* GravityNotify */ GRAVITY,
|
||
/* ResizeRequest */ 0,
|
||
/* CirculateNotify */ CIRC,
|
||
/* CirculateRequest */ 0,
|
||
/* PropertyNotify */ PROP,
|
||
/* SelectionClear */ 0,
|
||
/* SelectionRequest */ 0,
|
||
/* SelectionNotify */ 0,
|
||
/* ColormapNotify */ COLORMAP,
|
||
/* ClientMessage */ 0,
|
||
/* MappingNotify */ 0,
|
||
/* VirtualEvent */ VIRTUAL,
|
||
/* Activate */ ACTIVATE,
|
||
/* Deactivate */ ACTIVATE
|
||
};
|
||
|
||
/*
|
||
* The following tables are used as a two-way map between X's internal
|
||
* numeric values for fields in an XEvent and the strings used in Tcl. The
|
||
* tables are used both when constructing an XEvent from user input and
|
||
* when providing data from an XEvent to the user.
|
||
*/
|
||
|
||
static TkStateMap notifyMode[] = {
|
||
{NotifyNormal, "NotifyNormal"},
|
||
{NotifyGrab, "NotifyGrab"},
|
||
{NotifyUngrab, "NotifyUngrab"},
|
||
{NotifyWhileGrabbed, "NotifyWhileGrabbed"},
|
||
{-1, NULL}
|
||
};
|
||
|
||
static TkStateMap notifyDetail[] = {
|
||
{NotifyAncestor, "NotifyAncestor"},
|
||
{NotifyVirtual, "NotifyVirtual"},
|
||
{NotifyInferior, "NotifyInferior"},
|
||
{NotifyNonlinear, "NotifyNonlinear"},
|
||
{NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
|
||
{NotifyPointer, "NotifyPointer"},
|
||
{NotifyPointerRoot, "NotifyPointerRoot"},
|
||
{NotifyDetailNone, "NotifyDetailNone"},
|
||
{-1, NULL}
|
||
};
|
||
|
||
static TkStateMap circPlace[] = {
|
||
{PlaceOnTop, "PlaceOnTop"},
|
||
{PlaceOnBottom, "PlaceOnBottom"},
|
||
{-1, NULL}
|
||
};
|
||
|
||
static TkStateMap visNotify[] = {
|
||
{VisibilityUnobscured, "VisibilityUnobscured"},
|
||
{VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
|
||
{VisibilityFullyObscured, "VisibilityFullyObscured"},
|
||
{-1, NULL}
|
||
};
|
||
|
||
/*
|
||
* Prototypes for local procedures defined in this file:
|
||
*/
|
||
|
||
static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
|
||
char *dispName, int screenIndex));
|
||
static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
|
||
VirtualEventTable *vetPtr, char *virtString,
|
||
char *eventString));
|
||
static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
|
||
VirtualEventTable *vetPtr, char *virtString,
|
||
char *eventString));
|
||
static void DeleteVirtualEventTable _ANSI_ARGS_((
|
||
VirtualEventTable *vetPtr));
|
||
static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
|
||
char *before, XEvent *eventPtr, KeySym keySym,
|
||
Tcl_DString *dsPtr));
|
||
static void FreeTclBinding _ANSI_ARGS_((ClientData clientData));
|
||
static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
|
||
Tcl_HashTable *patternTablePtr, ClientData object,
|
||
char *eventString, int create, int allowVirtual,
|
||
unsigned long *maskPtr));
|
||
static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
|
||
VirtualEventTable *vetPtr));
|
||
static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
|
||
static KeySym GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
|
||
XEvent *eventPtr));
|
||
static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
|
||
Tcl_DString *dsPtr));
|
||
static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
|
||
VirtualEventTable *vetPtr, char *virtString));
|
||
static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
|
||
char *virtString));
|
||
static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
|
||
Tk_Window main, int argc, char **argv));
|
||
static void InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
|
||
static void InitVirtualEventTable _ANSI_ARGS_((
|
||
VirtualEventTable *vetPtr));
|
||
static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
|
||
BindingTable *bindPtr, PatSeq *psPtr,
|
||
PatSeq *bestPtr, ClientData *objectPtr,
|
||
PatSeq **sourcePtrPtr));
|
||
static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
|
||
char **eventStringPtr, Pattern *patPtr,
|
||
unsigned long *eventMaskPtr));
|
||
|
||
/*
|
||
* The following define is used as a short circuit for the callback
|
||
* procedure to evaluate a TclBinding. The actual evaluation of the
|
||
* binding is handled inline, because special things have to be done
|
||
* with a Tcl binding before evaluation time.
|
||
*/
|
||
|
||
#define EvalTclBinding ((TkBindEvalProc *) 1)
|
||
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* TkBindInit --
|
||
*
|
||
* This procedure is called when an application is created. It
|
||
* initializes all the structures used by bindings and virtual
|
||
* events. It must be called before any other functions in this
|
||
* file are called.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Memory allocated.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
TkBindInit(mainPtr)
|
||
TkMainInfo *mainPtr; /* The newly created application. */
|
||
{
|
||
BindInfo *bindInfoPtr;
|
||
|
||
if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
|
||
panic("TkBindInit: virtual events can't be supported");
|
||
}
|
||
|
||
/*
|
||
* Initialize the static data structures used by the binding package.
|
||
* They are only initialized once, no matter how many interps are
|
||
* created.
|
||
*/
|
||
|
||
if (!initialized) {
|
||
Tcl_HashEntry *hPtr;
|
||
ModInfo *modPtr;
|
||
EventInfo *eiPtr;
|
||
int dummy;
|
||
|
||
#ifdef REDO_KEYSYM_LOOKUP
|
||
KeySymInfo *kPtr;
|
||
|
||
Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
|
||
Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
|
||
for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
|
||
hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
|
||
Tcl_SetHashValue(hPtr, kPtr->value);
|
||
hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
|
||
&dummy);
|
||
Tcl_SetHashValue(hPtr, kPtr->name);
|
||
}
|
||
#endif /* REDO_KEYSYM_LOOKUP */
|
||
|
||
Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
|
||
for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
|
||
hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
|
||
Tcl_SetHashValue(hPtr, modPtr);
|
||
}
|
||
|
||
Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
|
||
for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
|
||
hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
|
||
Tcl_SetHashValue(hPtr, eiPtr);
|
||
}
|
||
initialized = 1;
|
||
}
|
||
|
||
mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
|
||
|
||
bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
|
||
InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
|
||
bindInfoPtr->screenInfo.curDispPtr = NULL;
|
||
bindInfoPtr->screenInfo.curScreenIndex = -1;
|
||
bindInfoPtr->screenInfo.bindingDepth = 0;
|
||
bindInfoPtr->pendingList = NULL;
|
||
mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
|
||
|
||
TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* TkBindFree --
|
||
*
|
||
* This procedure is called when an application is deleted. It
|
||
* deletes all the structures used by bindings and virtual events.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Memory freed.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
TkBindFree(mainPtr)
|
||
TkMainInfo *mainPtr; /* The newly created application. */
|
||
{
|
||
BindInfo *bindInfoPtr;
|
||
|
||
Tk_DeleteBindingTable(mainPtr->bindingTable);
|
||
mainPtr->bindingTable = NULL;
|
||
|
||
bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
|
||
DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
|
||
mainPtr->bindInfo = NULL;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CreateBindingTable --
|
||
*
|
||
* Set up a new domain in which event bindings may be created.
|
||
*
|
||
* Results:
|
||
* The return value is a token for the new table, which must
|
||
* be passed to procedures like Tk_CreatBinding.
|
||
*
|
||
* Side effects:
|
||
* Memory is allocated for the new table.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
Tk_BindingTable
|
||
Tk_CreateBindingTable(interp)
|
||
Tcl_Interp *interp; /* Interpreter to associate with the binding
|
||
* table: commands are executed in this
|
||
* interpreter. */
|
||
{
|
||
BindingTable *bindPtr;
|
||
int i;
|
||
|
||
/*
|
||
* Create and initialize a new binding table.
|
||
*/
|
||
|
||
bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
|
||
for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
|
||
bindPtr->eventRing[i].type = -1;
|
||
}
|
||
bindPtr->curEvent = 0;
|
||
Tcl_InitHashTable(&bindPtr->patternTable,
|
||
sizeof(PatternTableKey)/sizeof(int));
|
||
Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
|
||
bindPtr->interp = interp;
|
||
return (Tk_BindingTable) bindPtr;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_DeleteBindingTable --
|
||
*
|
||
* Destroy a binding table and free up all its memory.
|
||
* The caller should not use bindingTable again after
|
||
* this procedure returns.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Memory is freed.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
Tk_DeleteBindingTable(bindingTable)
|
||
Tk_BindingTable bindingTable; /* Token for the binding table to
|
||
* destroy. */
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr, *nextPtr;
|
||
Tcl_HashEntry *hPtr;
|
||
Tcl_HashSearch search;
|
||
|
||
/*
|
||
* Find and delete all of the patterns associated with the binding
|
||
* table.
|
||
*/
|
||
|
||
for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
|
||
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
|
||
for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
psPtr != NULL; psPtr = nextPtr) {
|
||
nextPtr = psPtr->nextSeqPtr;
|
||
psPtr->flags |= MARKED_DELETED;
|
||
if (psPtr->refCount == 0) {
|
||
if (psPtr->freeProc != NULL) {
|
||
(*psPtr->freeProc)(psPtr->clientData);
|
||
}
|
||
ckfree((char *) psPtr);
|
||
}
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Clean up the rest of the information associated with the
|
||
* binding table.
|
||
*/
|
||
|
||
Tcl_DeleteHashTable(&bindPtr->patternTable);
|
||
Tcl_DeleteHashTable(&bindPtr->objectTable);
|
||
ckfree((char *) bindPtr);
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_CreateBinding --
|
||
*
|
||
* Add a binding to a binding table, so that future calls to
|
||
* Tk_BindEvent may execute the command in the binding.
|
||
*
|
||
* Results:
|
||
* The return value is 0 if an error occurred while setting
|
||
* up the binding. In this case, an error message will be
|
||
* left in interp->result. If all went well then the return
|
||
* value is a mask of the event types that must be made
|
||
* available to Tk_BindEvent in order to properly detect when
|
||
* this binding triggers. This value can be used to determine
|
||
* what events to select for in a window, for example.
|
||
*
|
||
* Side effects:
|
||
* An existing binding on the same event sequence may be
|
||
* replaced.
|
||
* The new binding may cause future calls to Tk_BindEvent to
|
||
* behave differently than they did previously.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
#ifdef SCM_CODE
|
||
unsigned long
|
||
Tk_CreateBinding(interp, bindingTable, object, eventString, command, key1, key3)
|
||
Tcl_Interp *interp; /* Used for error reporting. */
|
||
Tk_BindingTable bindingTable;
|
||
/* Table in which to create binding. */
|
||
ClientData object; /* Token for object with which binding is
|
||
* associated. */
|
||
char *eventString; /* String describing event sequence that
|
||
* triggers binding. */
|
||
char *command; /* Contains Tcl command to execute when
|
||
* binding triggers. */
|
||
char *key1; /* Widget's name */
|
||
char *key3; /* Inset ID */
|
||
#else
|
||
unsigned long
|
||
Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
|
||
Tcl_Interp *interp; /* Used for error reporting. */
|
||
Tk_BindingTable bindingTable;
|
||
/* Table in which to create binding. */
|
||
ClientData object; /* Token for object with which binding is
|
||
* associated. */
|
||
char *eventString; /* String describing event sequence that
|
||
* triggers binding. */
|
||
char *command; /* Contains Tcl command to execute when
|
||
* binding triggers. */
|
||
int append; /* 0 means replace any existing binding for
|
||
* eventString; 1 means append to that
|
||
* binding. If the existing binding is for a
|
||
* callback function and not a Tcl command
|
||
* string, the existing binding will always be
|
||
* replaced. */
|
||
#endif
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr;
|
||
unsigned long eventMask;
|
||
char *new, *old;
|
||
#ifdef SCM_CODE
|
||
SCM p;
|
||
|
||
# ifdef STk_CODE
|
||
if (!STk_valid_callback(command, &p) || (p == NULL)) {
|
||
# else
|
||
if (!SCM_valid_callback(command, &p) || (p == NULL)) {
|
||
# endif
|
||
BadSpec:
|
||
Tcl_AppendResult(interp, "bad closure specification \"",
|
||
command, "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
#endif
|
||
#ifdef STk_CODE
|
||
if (p != NULL) {
|
||
/*
|
||
* Modify the binding to tranform it in a call with parameters set.
|
||
* It's a hack but this avoid to do this work at each binding
|
||
* execution
|
||
*/
|
||
if ((new=STk_append_callback_parameters(p)) == NULL) goto BadSpec;
|
||
/* new will be automatically GC'ed. */
|
||
command = new;
|
||
}
|
||
#endif
|
||
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;
|
||
#ifndef SCM_CODE
|
||
append = 0;
|
||
#endif
|
||
}
|
||
|
||
old = (char *) psPtr->clientData;
|
||
#ifndef SCM_CODE
|
||
if ((append != 0) && (old != NULL)) {
|
||
int length;
|
||
|
||
length = strlen(old) + strlen(command) + 2;
|
||
new = (char *) ckalloc((unsigned) length);
|
||
sprintf(new, "%s\n%s", old, command);
|
||
} else {
|
||
#endif
|
||
new = (char *) ckalloc((unsigned) strlen(command) + 1);
|
||
strcpy(new, command);
|
||
#ifndef SCM_CODE
|
||
}
|
||
#endif
|
||
if (old != NULL) {
|
||
ckfree(old);
|
||
}
|
||
psPtr->eventProc = EvalTclBinding;
|
||
psPtr->freeProc = FreeTclBinding;
|
||
psPtr->clientData = (ClientData) new;
|
||
#ifdef SCM_CODE
|
||
if( p )
|
||
if (eventMask) STk_add_callback(key1, eventString, key3, p);
|
||
#endif
|
||
return eventMask;
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* TkCreateBindingProcedure --
|
||
*
|
||
* Add a C binding to a binding table, so that future calls to
|
||
* Tk_BindEvent may callback the procedure in the binding.
|
||
*
|
||
* Results:
|
||
* The return value is 0 if an error occurred while setting
|
||
* up the binding. In this case, an error message will be
|
||
* left in interp->result. If all went well then the return
|
||
* value is a mask of the event types that must be made
|
||
* available to Tk_BindEvent in order to properly detect when
|
||
* this binding triggers. This value can be used to determine
|
||
* what events to select for in a window, for example.
|
||
*
|
||
* Side effects:
|
||
* Any existing binding on the same event sequence will be
|
||
* replaced.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
unsigned long
|
||
TkCreateBindingProcedure(interp, bindingTable, object, eventString,
|
||
eventProc, freeProc, clientData)
|
||
Tcl_Interp *interp; /* Used for error reporting. */
|
||
Tk_BindingTable bindingTable;
|
||
/* Table in which to create binding. */
|
||
ClientData object; /* Token for object with which binding is
|
||
* associated. */
|
||
char *eventString; /* String describing event sequence that
|
||
* triggers binding. */
|
||
TkBindEvalProc *eventProc; /* Procedure to invoke when binding
|
||
* triggers. Must not be NULL. */
|
||
TkBindFreeProc *freeProc; /* Procedure to invoke when binding is
|
||
* freed. May be NULL for no procedure. */
|
||
ClientData clientData; /* Arbitrary ClientData to pass to eventProc
|
||
* and freeProc. */
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr;
|
||
unsigned long eventMask;
|
||
|
||
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
|
||
1, 1, &eventMask);
|
||
if (psPtr == NULL) {
|
||
return 0;
|
||
}
|
||
if (psPtr->eventProc == NULL) {
|
||
int new;
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
/*
|
||
* This pattern sequence was just created.
|
||
* Link the pattern into the list associated with the object, so
|
||
* that if the object goes away, these bindings will all
|
||
* automatically be deleted.
|
||
*/
|
||
|
||
hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
|
||
&new);
|
||
if (new) {
|
||
psPtr->nextObjPtr = NULL;
|
||
} else {
|
||
psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
}
|
||
Tcl_SetHashValue(hPtr, psPtr);
|
||
} else {
|
||
|
||
/*
|
||
* Free existing callback.
|
||
*/
|
||
|
||
if (psPtr->freeProc != NULL) {
|
||
(*psPtr->freeProc)(psPtr->clientData);
|
||
}
|
||
}
|
||
|
||
psPtr->eventProc = eventProc;
|
||
psPtr->freeProc = freeProc;
|
||
psPtr->clientData = clientData;
|
||
return eventMask;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_DeleteBinding --
|
||
*
|
||
* Remove an event binding from a binding table.
|
||
*
|
||
* Results:
|
||
* The result is a standard Tcl return value. If an error
|
||
* occurs then interp->result will contain an error message.
|
||
*
|
||
* Side effects:
|
||
* The binding given by object and eventString is removed
|
||
* from bindingTable.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_DeleteBinding(interp, bindingTable, object, eventString)
|
||
Tcl_Interp *interp; /* Used for error reporting. */
|
||
Tk_BindingTable bindingTable; /* Table in which to delete binding. */
|
||
ClientData object; /* Token for object with which binding
|
||
* is associated. */
|
||
char *eventString; /* String describing event sequence
|
||
* that triggers binding. */
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr, *prevPtr;
|
||
unsigned long eventMask;
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
|
||
0, 1, &eventMask);
|
||
if (psPtr == NULL) {
|
||
Tcl_ResetResult(interp);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
* Unlink the binding from the list for its object, then from the
|
||
* list for its pattern.
|
||
*/
|
||
|
||
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
|
||
if (hPtr == NULL) {
|
||
panic("Tk_DeleteBinding couldn't find object table entry");
|
||
}
|
||
prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
if (prevPtr == psPtr) {
|
||
Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
|
||
} else {
|
||
for ( ; ; prevPtr = prevPtr->nextObjPtr) {
|
||
if (prevPtr == NULL) {
|
||
panic("Tk_DeleteBinding couldn't find on object list");
|
||
}
|
||
if (prevPtr->nextObjPtr == psPtr) {
|
||
prevPtr->nextObjPtr = psPtr->nextObjPtr;
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
|
||
if (prevPtr == psPtr) {
|
||
if (psPtr->nextSeqPtr == NULL) {
|
||
Tcl_DeleteHashEntry(psPtr->hPtr);
|
||
} else {
|
||
Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
|
||
}
|
||
} else {
|
||
for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
|
||
if (prevPtr == NULL) {
|
||
panic("Tk_DeleteBinding couldn't find on hash chain");
|
||
}
|
||
if (prevPtr->nextSeqPtr == psPtr) {
|
||
prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
|
||
psPtr->flags |= MARKED_DELETED;
|
||
if (psPtr->refCount == 0) {
|
||
if (psPtr->freeProc != NULL) {
|
||
(*psPtr->freeProc)(psPtr->clientData);
|
||
}
|
||
ckfree((char *) psPtr);
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetBinding --
|
||
*
|
||
* Return the command associated with a given event string.
|
||
*
|
||
* Results:
|
||
* The return value is a pointer to the command string
|
||
* associated with eventString for object in the domain
|
||
* given by bindingTable. If there is no binding for
|
||
* eventString, or if eventString is improperly formed,
|
||
* then NULL is returned and an error message is left in
|
||
* interp->result. The return value is semi-static: it
|
||
* will persist until the binding is changed or deleted.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
char *
|
||
Tk_GetBinding(interp, bindingTable, object, eventString)
|
||
Tcl_Interp *interp; /* Interpreter for error reporting. */
|
||
Tk_BindingTable bindingTable; /* Table in which to look for
|
||
* binding. */
|
||
ClientData object; /* Token for object with which binding
|
||
* is associated. */
|
||
char *eventString; /* String describing event sequence
|
||
* that triggers binding. */
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr;
|
||
unsigned long eventMask;
|
||
|
||
psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
|
||
0, 1, &eventMask);
|
||
if (psPtr == NULL) {
|
||
return NULL;
|
||
}
|
||
if (psPtr->eventProc == EvalTclBinding) {
|
||
return (char *) psPtr->clientData;
|
||
}
|
||
#ifdef SCM_CODE
|
||
return "#f";
|
||
#else
|
||
return "";
|
||
#endif
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetAllBindings --
|
||
*
|
||
* Return a list of event strings for all the bindings
|
||
* associated with a given object.
|
||
*
|
||
* Results:
|
||
* There is no return value. Interp->result is modified to
|
||
* hold a Tcl list with one entry for each binding associated
|
||
* with object in bindingTable. Each entry in the list
|
||
* contains the event string associated with one binding.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
Tk_GetAllBindings(interp, bindingTable, object)
|
||
Tcl_Interp *interp; /* Interpreter returning result or
|
||
* error. */
|
||
Tk_BindingTable bindingTable; /* Table in which to look for
|
||
* bindings. */
|
||
ClientData object; /* Token for object. */
|
||
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr;
|
||
Tcl_HashEntry *hPtr;
|
||
Tcl_DString ds;
|
||
|
||
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
|
||
if (hPtr == NULL) {
|
||
return;
|
||
}
|
||
Tcl_DStringInit(&ds);
|
||
#ifdef SCM_CODE
|
||
Tcl_AppendResult(interp, "(", NULL);
|
||
#endif
|
||
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));
|
||
}
|
||
#ifdef SCM_CODE
|
||
Tcl_AppendResult(interp, ")", NULL);
|
||
#endif
|
||
Tcl_DStringFree(&ds);
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_DeleteAllBindings --
|
||
*
|
||
* Remove all bindings associated with a given object in a
|
||
* given binding table.
|
||
*
|
||
* Results:
|
||
* All bindings associated with object are removed from
|
||
* bindingTable.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
Tk_DeleteAllBindings(bindingTable, object)
|
||
Tk_BindingTable bindingTable; /* Table in which to delete
|
||
* bindings. */
|
||
ClientData object; /* Token for object. */
|
||
{
|
||
BindingTable *bindPtr = (BindingTable *) bindingTable;
|
||
PatSeq *psPtr, *prevPtr;
|
||
PatSeq *nextPtr;
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
|
||
if (hPtr == NULL) {
|
||
return;
|
||
}
|
||
for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
|
||
psPtr = nextPtr) {
|
||
nextPtr = psPtr->nextObjPtr;
|
||
|
||
/*
|
||
* Be sure to remove each binding from its hash chain in the
|
||
* pattern table. If this is the last pattern in the chain,
|
||
* then delete the hash entry too.
|
||
*/
|
||
|
||
prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
|
||
if (prevPtr == psPtr) {
|
||
if (psPtr->nextSeqPtr == NULL) {
|
||
Tcl_DeleteHashEntry(psPtr->hPtr);
|
||
} else {
|
||
Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
|
||
}
|
||
} else {
|
||
for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
|
||
if (prevPtr == NULL) {
|
||
panic("Tk_DeleteAllBindings couldn't find on hash chain");
|
||
}
|
||
if (prevPtr->nextSeqPtr == psPtr) {
|
||
prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
psPtr->flags |= MARKED_DELETED;
|
||
|
||
if (psPtr->refCount == 0) {
|
||
if (psPtr->freeProc != NULL) {
|
||
(*psPtr->freeProc)(psPtr->clientData);
|
||
}
|
||
ckfree((char *) psPtr);
|
||
}
|
||
}
|
||
Tcl_DeleteHashEntry(hPtr);
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* Tk_BindEvent --
|
||
*
|
||
* This procedure is invoked to process an X event. The
|
||
* event is added to those recorded for the binding table.
|
||
* Then each of the objects at *objectPtr is checked in
|
||
* order to see if it has a binding that matches the recent
|
||
* events. If so, the most specific binding is invoked for
|
||
* each object.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Depends on the command associated with the matching binding.
|
||
*
|
||
* All Tcl bindings scripts for each object are accumulated before
|
||
* the first binding is evaluated. If the action of a Tcl binding
|
||
* is to change or delete a binding, or delete the window associated
|
||
* with the binding, all the original Tcl binding scripts will still
|
||
* fire. Contrast this with C binding procedures. If a pending C
|
||
* binding (one that hasn't fired yet, but is queued to be fired for
|
||
* this window) is deleted, it will not be called, and if it is
|
||
* changed, then the new binding procedure will be called. If the
|
||
* window itself is deleted, no further C binding procedures will be
|
||
* called for this window. When both Tcl binding scripts and C binding
|
||
* procedures are interleaved, the above rules still apply.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
|
||
Tk_BindingTable bindingTable; /* Table in which to look for
|
||
* bindings. */
|
||
XEvent *eventPtr; /* What actually happened. */
|
||
Tk_Window tkwin; /* Window on display where event
|
||
* occurred (needed in order to
|
||
* locate display information). */
|
||
int numObjects; /* Number of objects at *objectPtr. */
|
||
ClientData *objectPtr; /* Array of one or more objects
|
||
* to check for a matching binding. */
|
||
{
|
||
BindingTable *bindPtr;
|
||
TkDisplay *dispPtr;
|
||
BindInfo *bindInfoPtr;
|
||
TkDisplay *oldDispPtr;
|
||
ScreenInfo *screenPtr;
|
||
XEvent *ringPtr;
|
||
PatSeq *vMatchDetailList, *vMatchNoDetailList;
|
||
int flags, oldScreen, i, deferModal;
|
||
unsigned int matchCount, matchSpace;
|
||
Tcl_Interp *interp;
|
||
Tcl_DString scripts, savedResult;
|
||
Detail detail;
|
||
char *p, *end;
|
||
PendingBinding *pendingPtr;
|
||
PendingBinding staticPending;
|
||
TkWindow *winPtr = (TkWindow *)tkwin;
|
||
PatternTableKey key;
|
||
|
||
/*
|
||
* Ignore events on windows that don't have names: these are windows
|
||
* like wrapper windows that shouldn't be visible to the
|
||
* application.
|
||
*/
|
||
|
||
if (winPtr->pathName == NULL) {
|
||
return;
|
||
}
|
||
|
||
/*
|
||
* Ignore the event completely if it is an Enter, Leave, FocusIn,
|
||
* or FocusOut event with detail NotifyInferior. The reason for
|
||
* ignoring these events is that we don't want transitions between
|
||
* a window and its children to visible to bindings on the parent:
|
||
* this would cause problems for mega-widgets, since the internal
|
||
* structure of a mega-widget isn't supposed to be visible to
|
||
* people watching the parent.
|
||
*/
|
||
|
||
if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
|
||
if (eventPtr->xcrossing.detail == NotifyInferior) {
|
||
return;
|
||
}
|
||
}
|
||
if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
|
||
if (eventPtr->xfocus.detail == NotifyInferior) {
|
||
return;
|
||
}
|
||
}
|
||
|
||
bindPtr = (BindingTable *) bindingTable;
|
||
dispPtr = ((TkWindow *) tkwin)->dispPtr;
|
||
bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
|
||
|
||
/*
|
||
* Add the new event to the ring of saved events for the
|
||
* binding table. Two tricky points:
|
||
*
|
||
* 1. Combine consecutive MotionNotify events. Do this by putting
|
||
* the new event *on top* of the previous event.
|
||
* 2. If a modifier key is held down, it auto-repeats to generate
|
||
* continuous KeyPress and KeyRelease events. These can flush
|
||
* the event ring so that valuable information is lost (such
|
||
* as repeated button clicks). To handle this, check for the
|
||
* special case of a modifier KeyPress arriving when the previous
|
||
* two events are a KeyRelease and KeyPress of the same key.
|
||
* If this happens, mark the most recent event (the KeyRelease)
|
||
* invalid and put the new event on top of the event before that
|
||
* (the KeyPress).
|
||
*/
|
||
|
||
if ((eventPtr->type == MotionNotify)
|
||
&& (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
|
||
/*
|
||
* Don't advance the ring pointer.
|
||
*/
|
||
} else if (eventPtr->type == KeyPress) {
|
||
int i;
|
||
for (i = 0; ; i++) {
|
||
if (i >= dispPtr->numModKeyCodes) {
|
||
goto advanceRingPointer;
|
||
}
|
||
if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
|
||
break;
|
||
}
|
||
}
|
||
ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
|
||
if ((ringPtr->type != KeyRelease)
|
||
|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
|
||
goto advanceRingPointer;
|
||
}
|
||
if (bindPtr->curEvent <= 0) {
|
||
i = EVENT_BUFFER_SIZE - 1;
|
||
} else {
|
||
i = bindPtr->curEvent - 1;
|
||
}
|
||
ringPtr = &bindPtr->eventRing[i];
|
||
if ((ringPtr->type != KeyPress)
|
||
|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
|
||
goto advanceRingPointer;
|
||
}
|
||
bindPtr->eventRing[bindPtr->curEvent].type = -1;
|
||
bindPtr->curEvent = i;
|
||
} else {
|
||
advanceRingPointer:
|
||
bindPtr->curEvent++;
|
||
if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
|
||
bindPtr->curEvent = 0;
|
||
}
|
||
}
|
||
ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
|
||
memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
|
||
detail.clientData = 0;
|
||
flags = flagArray[ringPtr->type];
|
||
if (flags & KEY) {
|
||
detail.keySym = GetKeySym(dispPtr, ringPtr);
|
||
if (detail.keySym == NoSymbol) {
|
||
detail.keySym = 0;
|
||
}
|
||
} else if (flags & BUTTON) {
|
||
detail.button = ringPtr->xbutton.button;
|
||
} else if (flags & VIRTUAL) {
|
||
detail.name = ((XVirtualEvent *) ringPtr)->name;
|
||
}
|
||
bindPtr->detailRing[bindPtr->curEvent] = detail;
|
||
|
||
/*
|
||
* Find out if there are any virtual events that correspond to this
|
||
* physical event (or sequence of physical events).
|
||
*/
|
||
|
||
vMatchDetailList = NULL;
|
||
vMatchNoDetailList = NULL;
|
||
memset(&key, 0, sizeof(key));
|
||
|
||
if (ringPtr->type != VirtualEvent) {
|
||
Tcl_HashTable *veptPtr;
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
|
||
|
||
key.object = NULL;
|
||
key.type = ringPtr->type;
|
||
key.detail = detail;
|
||
|
||
hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
|
||
if (hPtr != NULL) {
|
||
vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
}
|
||
|
||
if (key.detail.clientData != 0) {
|
||
key.detail.clientData = 0;
|
||
hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
|
||
if (hPtr != NULL) {
|
||
vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
}
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Loop over all the binding tags, finding the binding script or
|
||
* callback for each one. Append all of the binding scripts, with
|
||
* %-sequences expanded, to "scripts", with null characters separating
|
||
* the scripts for each object. Append all the callbacks to the array
|
||
* of pending callbacks.
|
||
*/
|
||
|
||
pendingPtr = &staticPending;
|
||
matchCount = 0;
|
||
matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
|
||
Tcl_DStringInit(&scripts);
|
||
|
||
for ( ; numObjects > 0; numObjects--, objectPtr++) {
|
||
PatSeq *matchPtr, *sourcePtr;
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
matchPtr = NULL;
|
||
sourcePtr = NULL;
|
||
|
||
/*
|
||
* Match the new event against those recorded in the pattern table,
|
||
* saving the longest matching pattern. For events with details
|
||
* (button and key events), look for a binding for the specific
|
||
* key or button. First see if the event matches a physical event
|
||
* that the object is interested in, then look for a virtual event.
|
||
*/
|
||
|
||
key.object = *objectPtr;
|
||
key.type = ringPtr->type;
|
||
key.detail = detail;
|
||
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
|
||
if (hPtr != NULL) {
|
||
matchPtr = MatchPatterns(dispPtr, bindPtr,
|
||
(PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
|
||
&sourcePtr);
|
||
}
|
||
|
||
if (vMatchDetailList != NULL) {
|
||
matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
|
||
matchPtr, objectPtr, &sourcePtr);
|
||
}
|
||
|
||
/*
|
||
* If no match was found, look for a binding for all keys or buttons
|
||
* (detail of 0). Again, first match on a virtual event.
|
||
*/
|
||
|
||
if ((detail.clientData != 0) && (matchPtr == NULL)) {
|
||
key.detail.clientData = 0;
|
||
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
|
||
if (hPtr != NULL) {
|
||
matchPtr = MatchPatterns(dispPtr, bindPtr,
|
||
(PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
|
||
&sourcePtr);
|
||
}
|
||
|
||
if (vMatchNoDetailList != NULL) {
|
||
matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
|
||
matchPtr, objectPtr, &sourcePtr);
|
||
}
|
||
|
||
}
|
||
|
||
if (matchPtr != NULL) {
|
||
if (sourcePtr->eventProc == NULL) {
|
||
panic("Tk_BindEvent: missing command");
|
||
}
|
||
if (sourcePtr->eventProc == EvalTclBinding) {
|
||
ExpandPercents(winPtr, (char *) sourcePtr->clientData,
|
||
eventPtr, detail.keySym, &scripts);
|
||
} else {
|
||
if (matchCount >= matchSpace) {
|
||
PendingBinding *new;
|
||
unsigned int oldSize, newSize;
|
||
|
||
oldSize = sizeof(staticPending)
|
||
- sizeof(staticPending.matchArray)
|
||
+ matchSpace * sizeof(PatSeq*);
|
||
matchSpace *= 2;
|
||
newSize = sizeof(staticPending)
|
||
- sizeof(staticPending.matchArray)
|
||
+ matchSpace * sizeof(PatSeq*);
|
||
new = (PendingBinding *) ckalloc(newSize);
|
||
memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
|
||
if (pendingPtr != &staticPending) {
|
||
ckfree((char *) pendingPtr);
|
||
}
|
||
pendingPtr = new;
|
||
}
|
||
sourcePtr->refCount++;
|
||
pendingPtr->matchArray[matchCount] = sourcePtr;
|
||
matchCount++;
|
||
}
|
||
/*
|
||
* A "" is added to the scripts string to separate the
|
||
* various scripts that should be invoked.
|
||
*/
|
||
|
||
Tcl_DStringAppend(&scripts, "", 1);
|
||
}
|
||
}
|
||
if (Tcl_DStringLength(&scripts) == 0) {
|
||
return;
|
||
}
|
||
|
||
/*
|
||
* Now go back through and evaluate the binding for each object,
|
||
* in order, dealing with "break" and "continue" exceptions
|
||
* appropriately.
|
||
*
|
||
* There are two tricks here:
|
||
* 1. Bindings can be invoked from in the middle of Tcl commands,
|
||
* where interp->result is significant (for example, a widget
|
||
* might be deleted because of an error in creating it, so the
|
||
* result contains an error message that is eventually going to
|
||
* be returned by the creating command). To preserve the result,
|
||
* we save it in a dynamic string.
|
||
* 2. The binding's action can potentially delete the binding,
|
||
* so bindPtr may not point to anything valid once the action
|
||
* completes. Thus we have to save bindPtr->interp in a
|
||
* local variable in order to restore the result.
|
||
*/
|
||
|
||
interp = bindPtr->interp;
|
||
Tcl_DStringInit(&savedResult);
|
||
|
||
/*
|
||
* Save information about the current screen, then invoke a script
|
||
* if the screen has changed.
|
||
*/
|
||
|
||
Tcl_DStringGetResult(interp, &savedResult);
|
||
screenPtr = &bindInfoPtr->screenInfo;
|
||
oldDispPtr = screenPtr->curDispPtr;
|
||
oldScreen = screenPtr->curScreenIndex;
|
||
if ((dispPtr != screenPtr->curDispPtr)
|
||
|| (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
|
||
screenPtr->curDispPtr = dispPtr;
|
||
screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
|
||
ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
|
||
}
|
||
|
||
if (matchCount > 0) {
|
||
pendingPtr->nextPtr = bindInfoPtr->pendingList;
|
||
pendingPtr->tkwin = tkwin;
|
||
pendingPtr->deleted = 0;
|
||
bindInfoPtr->pendingList = pendingPtr;
|
||
}
|
||
|
||
/*
|
||
* Save the current value of the TK_DEFER_MODAL flag so we can
|
||
* restore it at the end of the loop. Clear the flag so we can
|
||
* detect any recursive requests for a modal loop.
|
||
*/
|
||
|
||
flags = winPtr->flags;
|
||
winPtr->flags &= ~TK_DEFER_MODAL;
|
||
|
||
p = Tcl_DStringValue(&scripts);
|
||
end = p + Tcl_DStringLength(&scripts);
|
||
i = 0;
|
||
|
||
while (p < end) {
|
||
int code;
|
||
|
||
screenPtr->bindingDepth++;
|
||
Tcl_AllowExceptions(interp);
|
||
|
||
if (*p == '\0') {
|
||
PatSeq *psPtr;
|
||
|
||
psPtr = pendingPtr->matchArray[i];
|
||
i++;
|
||
code = TCL_OK;
|
||
if ((pendingPtr->deleted == 0)
|
||
&& ((psPtr->flags & MARKED_DELETED) == 0)) {
|
||
code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
|
||
tkwin, detail.keySym);
|
||
}
|
||
psPtr->refCount--;
|
||
if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
|
||
if (psPtr->freeProc != NULL) {
|
||
(*psPtr->freeProc)(psPtr->clientData);
|
||
}
|
||
ckfree((char *) psPtr);
|
||
}
|
||
} else {
|
||
code = Tcl_GlobalEval(interp, p);
|
||
p += strlen(p);
|
||
}
|
||
p++;
|
||
screenPtr->bindingDepth--;
|
||
if (code != TCL_OK) {
|
||
if (code == TCL_CONTINUE) {
|
||
/*
|
||
* Do nothing: just go on to the next command.
|
||
*/
|
||
} else if (code == TCL_BREAK) {
|
||
break;
|
||
} else {
|
||
Tcl_AddErrorInfo(interp, "\n (command bound to event)");
|
||
Tcl_BackgroundError(interp);
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
|
||
if (matchCount > 0 && !pendingPtr->deleted) {
|
||
/*
|
||
* Restore the original modal flag value and invoke the modal loop
|
||
* if needed.
|
||
*/
|
||
|
||
deferModal = winPtr->flags & TK_DEFER_MODAL;
|
||
winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL)
|
||
| (flags & TK_DEFER_MODAL);
|
||
if (deferModal) {
|
||
(*winPtr->classProcsPtr->modalProc)(tkwin, eventPtr);
|
||
}
|
||
}
|
||
|
||
if ((screenPtr->bindingDepth != 0) &&
|
||
((oldDispPtr != screenPtr->curDispPtr)
|
||
|| (oldScreen != screenPtr->curScreenIndex))) {
|
||
|
||
/*
|
||
* Some other binding script is currently executing, but its
|
||
* screen is no longer current. Change the current display
|
||
* back again.
|
||
*/
|
||
|
||
screenPtr->curDispPtr = oldDispPtr;
|
||
screenPtr->curScreenIndex = oldScreen;
|
||
ChangeScreen(interp, oldDispPtr->name, oldScreen);
|
||
}
|
||
Tcl_DStringResult(interp, &savedResult);
|
||
Tcl_DStringFree(&scripts);
|
||
|
||
if (matchCount > 0) {
|
||
PendingBinding **curPtrPtr;
|
||
|
||
for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
|
||
if (*curPtrPtr == pendingPtr) {
|
||
*curPtrPtr = pendingPtr->nextPtr;
|
||
break;
|
||
}
|
||
curPtrPtr = &(*curPtrPtr)->nextPtr;
|
||
}
|
||
if (pendingPtr != &staticPending) {
|
||
ckfree((char *) pendingPtr);
|
||
}
|
||
}
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* TkBindDeadWindow --
|
||
*
|
||
* This procedure is invoked when it is determined that a window is
|
||
* dead. It cleans up bind-related information about the window
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Any pending C bindings for this window are cancelled.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
void
|
||
TkBindDeadWindow(winPtr)
|
||
TkWindow *winPtr; /* The window that is being deleted. */
|
||
{
|
||
BindInfo *bindInfoPtr;
|
||
PendingBinding *curPtr;
|
||
|
||
bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
|
||
curPtr = bindInfoPtr->pendingList;
|
||
while (curPtr != NULL) {
|
||
if (curPtr->tkwin == (Tk_Window) winPtr) {
|
||
curPtr->deleted = 1;
|
||
}
|
||
curPtr = curPtr->nextPtr;
|
||
}
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* MatchPatterns --
|
||
*
|
||
* Given a list of pattern sequences and a list of recent events,
|
||
* return the pattern sequence that best matches the event list,
|
||
* if there is one.
|
||
*
|
||
* This procedure is used in two different ways. In the simplest
|
||
* use, "object" is NULL and psPtr is a list of pattern sequences,
|
||
* each of which corresponds to a binding. In this case, the
|
||
* procedure finds the pattern sequences that match the event list
|
||
* and returns the most specific of those, if there is more than one.
|
||
*
|
||
* In the second case, psPtr is a list of pattern sequences, each
|
||
* of which corresponds to a definition for a virtual binding.
|
||
* In order for one of these sequences to "match", it must match
|
||
* the events (as above) but in addition there must be a binding
|
||
* for its associated virtual event on the current object. The
|
||
* "object" argument indicates which object the binding must be for.
|
||
*
|
||
* Results:
|
||
* The return value is NULL if bestPtr is NULL and no pattern matches
|
||
* the recent events from bindPtr. Otherwise the return value is
|
||
* the most specific pattern sequence among bestPtr and all those
|
||
* at psPtr that match the event list and object. If a pattern
|
||
* sequence other than bestPtr is returned, then *bestCommandPtr
|
||
* is filled in with a pointer to the command from the best sequence.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
static PatSeq *
|
||
MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
|
||
TkDisplay *dispPtr; /* Display from which the event came. */
|
||
BindingTable *bindPtr; /* Information about binding table, such as
|
||
* ring of recent events. */
|
||
PatSeq *psPtr; /* List of pattern sequences. */
|
||
PatSeq *bestPtr; /* The best match seen so far, from a
|
||
* previous call to this procedure. NULL
|
||
* means no prior best match. */
|
||
ClientData *objectPtr; /* If NULL, the sequences at psPtr
|
||
* correspond to "normal" bindings. If
|
||
* non-NULL, the sequences at psPtr correspond
|
||
* to virtual bindings; in order to match each
|
||
* sequence must correspond to a virtual
|
||
* binding for which a binding exists for
|
||
* object in bindPtr. */
|
||
PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that
|
||
* contains the eventProc and clientData
|
||
* associated with the best match. If this
|
||
* differs from the return value, it is the
|
||
* virtual event that most closely matched the
|
||
* return value (a physical event). Not
|
||
* modified unless a result other than bestPtr
|
||
* is returned. */
|
||
{
|
||
PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
|
||
|
||
bestSourcePtr = *sourcePtrPtr;
|
||
|
||
/*
|
||
* Iterate over all the pattern sequences.
|
||
*/
|
||
|
||
for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
|
||
XEvent *eventPtr;
|
||
Pattern *patPtr;
|
||
Window window;
|
||
Detail *detailPtr;
|
||
int patCount, ringCount, flags, state;
|
||
int modMask;
|
||
|
||
/*
|
||
* Iterate over all the patterns in a sequence to be
|
||
* sure that they all match.
|
||
*/
|
||
|
||
eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
|
||
detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
|
||
window = eventPtr->xany.window;
|
||
patPtr = psPtr->pats;
|
||
patCount = psPtr->numPats;
|
||
ringCount = EVENT_BUFFER_SIZE;
|
||
while (patCount > 0) {
|
||
if (ringCount <= 0) {
|
||
goto nextSequence;
|
||
}
|
||
if (eventPtr->xany.type != patPtr->eventType) {
|
||
/*
|
||
* Most of the event types are considered superfluous
|
||
* in that they are ignored if they occur in the middle
|
||
* of a pattern sequence and have mismatching types. The
|
||
* only ones that cannot be ignored are ButtonPress and
|
||
* ButtonRelease events (if the next event in the pattern
|
||
* is a KeyPress or KeyRelease) and KeyPress and KeyRelease
|
||
* events (if the next pattern event is a ButtonPress or
|
||
* ButtonRelease). Here are some tricky cases to consider:
|
||
* 1. Double-Button or Double-Key events.
|
||
* 2. Double-ButtonRelease or Double-KeyRelease events.
|
||
* 3. The arrival of various events like Enter and Leave
|
||
* and FocusIn and GraphicsExpose between two button
|
||
* presses or key presses.
|
||
* 4. Modifier keys like Shift and Control shouldn't
|
||
* generate conflicts with button events.
|
||
*/
|
||
|
||
if ((patPtr->eventType == KeyPress)
|
||
|| (patPtr->eventType == KeyRelease)) {
|
||
if ((eventPtr->xany.type == ButtonPress)
|
||
|| (eventPtr->xany.type == ButtonRelease)) {
|
||
goto nextSequence;
|
||
}
|
||
} else if ((patPtr->eventType == ButtonPress)
|
||
|| (patPtr->eventType == ButtonRelease)) {
|
||
if ((eventPtr->xany.type == KeyPress)
|
||
|| (eventPtr->xany.type == KeyRelease)) {
|
||
int i;
|
||
|
||
/*
|
||
* Ignore key events if they are modifier keys.
|
||
*/
|
||
|
||
for (i = 0; i < dispPtr->numModKeyCodes; i++) {
|
||
if (dispPtr->modKeyCodes[i]
|
||
== eventPtr->xkey.keycode) {
|
||
/*
|
||
* This key is a modifier key, so ignore it.
|
||
*/
|
||
goto nextEvent;
|
||
}
|
||
}
|
||
goto nextSequence;
|
||
}
|
||
}
|
||
goto nextEvent;
|
||
}
|
||
if (eventPtr->xany.window != window) {
|
||
goto nextSequence;
|
||
}
|
||
|
||
/*
|
||
* Note: it's important for the keysym check to go before
|
||
* the modifier check, so we can ignore unwanted modifier
|
||
* keys before choking on the modifier check.
|
||
*/
|
||
|
||
if ((patPtr->detail.clientData != 0)
|
||
&& (patPtr->detail.clientData != detailPtr->clientData)) {
|
||
/*
|
||
* The detail appears not to match. However, if the event
|
||
* is a KeyPress for a modifier key then just ignore the
|
||
* event. Otherwise event sequences like "aD" never match
|
||
* because the shift key goes down between the "a" and the
|
||
* "D".
|
||
*/
|
||
|
||
if (eventPtr->xany.type == KeyPress) {
|
||
int i;
|
||
|
||
for (i = 0; i < dispPtr->numModKeyCodes; i++) {
|
||
if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
|
||
goto nextEvent;
|
||
}
|
||
}
|
||
}
|
||
goto nextSequence;
|
||
}
|
||
flags = flagArray[eventPtr->type];
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
state = eventPtr->xkey.state;
|
||
} else if (flags & CROSSING) {
|
||
state = eventPtr->xcrossing.state;
|
||
} else {
|
||
state = 0;
|
||
}
|
||
if (patPtr->needMods != 0) {
|
||
modMask = patPtr->needMods;
|
||
if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
|
||
modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
|
||
}
|
||
if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
|
||
modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
|
||
}
|
||
if ((state & modMask) != modMask) {
|
||
goto nextSequence;
|
||
}
|
||
}
|
||
if (psPtr->flags & PAT_NEARBY) {
|
||
XEvent *firstPtr;
|
||
int timeDiff;
|
||
|
||
firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
|
||
timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
|
||
if ((firstPtr->xkey.x_root
|
||
< (eventPtr->xkey.x_root - NEARBY_PIXELS))
|
||
|| (firstPtr->xkey.x_root
|
||
> (eventPtr->xkey.x_root + NEARBY_PIXELS))
|
||
|| (firstPtr->xkey.y_root
|
||
< (eventPtr->xkey.y_root - NEARBY_PIXELS))
|
||
|| (firstPtr->xkey.y_root
|
||
> (eventPtr->xkey.y_root + NEARBY_PIXELS))
|
||
|| (timeDiff > NEARBY_MS)) {
|
||
goto nextSequence;
|
||
}
|
||
}
|
||
patPtr++;
|
||
patCount--;
|
||
nextEvent:
|
||
if (eventPtr == bindPtr->eventRing) {
|
||
eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
|
||
detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
|
||
} else {
|
||
eventPtr--;
|
||
detailPtr--;
|
||
}
|
||
ringCount--;
|
||
}
|
||
|
||
matchPtr = psPtr;
|
||
sourcePtr = psPtr;
|
||
|
||
if (objectPtr != NULL) {
|
||
int iVirt;
|
||
VirtualOwners *voPtr;
|
||
PatternTableKey key;
|
||
|
||
/*
|
||
* The sequence matches the physical constraints.
|
||
* Is this object interested in any of the virtual events
|
||
* that correspond to this sequence?
|
||
*/
|
||
|
||
voPtr = psPtr->voPtr;
|
||
|
||
memset(&key, 0, sizeof(key));
|
||
key.object = *objectPtr;
|
||
key.type = VirtualEvent;
|
||
key.detail.clientData = 0;
|
||
|
||
for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
|
||
Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
|
||
|
||
key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
|
||
hPtr);
|
||
hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
|
||
(char *) &key);
|
||
if (hPtr != NULL) {
|
||
|
||
/*
|
||
* This tag is interested in this virtual event and its
|
||
* corresponding physical event is a good match with the
|
||
* virtual event's definition.
|
||
*/
|
||
|
||
PatSeq *virtMatchPtr;
|
||
|
||
virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
if ((virtMatchPtr->numPats != 1)
|
||
|| (virtMatchPtr->nextSeqPtr != NULL)) {
|
||
panic("MatchPattern: badly constructed virtual event");
|
||
}
|
||
sourcePtr = virtMatchPtr;
|
||
goto match;
|
||
}
|
||
}
|
||
|
||
/*
|
||
* The physical event matches a virtual event's definition, but
|
||
* the tag isn't interested in it.
|
||
*/
|
||
goto nextSequence;
|
||
}
|
||
match:
|
||
|
||
/*
|
||
* This sequence matches. If we've already got another match,
|
||
* pick whichever is most specific. Detail is most important,
|
||
* then needMods.
|
||
*/
|
||
|
||
if (bestPtr != NULL) {
|
||
Pattern *patPtr2;
|
||
int i;
|
||
|
||
if (matchPtr->numPats != bestPtr->numPats) {
|
||
if (bestPtr->numPats > matchPtr->numPats) {
|
||
goto nextSequence;
|
||
} else {
|
||
goto newBest;
|
||
}
|
||
}
|
||
for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
|
||
i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
|
||
if (patPtr->detail.clientData != patPtr2->detail.clientData) {
|
||
if (patPtr->detail.clientData == 0) {
|
||
goto nextSequence;
|
||
} else {
|
||
goto newBest;
|
||
}
|
||
}
|
||
if (patPtr->needMods != patPtr2->needMods) {
|
||
if ((patPtr->needMods & patPtr2->needMods)
|
||
== patPtr->needMods) {
|
||
goto nextSequence;
|
||
} else if ((patPtr->needMods & patPtr2->needMods)
|
||
== patPtr2->needMods) {
|
||
goto newBest;
|
||
}
|
||
}
|
||
}
|
||
/*
|
||
* Tie goes to current best pattern.
|
||
*
|
||
* (1) For virtual vs. virtual, the least recently defined
|
||
* virtual wins, because virtuals are examined in order of
|
||
* definition. This order is _not_ guaranteed in the
|
||
* documentation.
|
||
*
|
||
* (2) For virtual vs. physical, the physical wins because all
|
||
* the physicals are examined before the virtuals. This order
|
||
* is guaranteed in the documentation.
|
||
*
|
||
* (3) For physical vs. physical pattern, the most recently
|
||
* defined physical wins, because physicals are examined in
|
||
* reverse order of definition. This order is guaranteed in
|
||
* the documentation.
|
||
*/
|
||
|
||
goto nextSequence;
|
||
}
|
||
newBest:
|
||
bestPtr = matchPtr;
|
||
bestSourcePtr = sourcePtr;
|
||
|
||
nextSequence: continue;
|
||
}
|
||
|
||
*sourcePtrPtr = bestSourcePtr;
|
||
return bestPtr;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* ExpandPercents --
|
||
*
|
||
* Given a command and an event, produce a new command
|
||
* by replacing % constructs in the original command
|
||
* with information from the X event.
|
||
*
|
||
* Results:
|
||
* The new expanded command is appended to the dynamic string
|
||
* given by dsPtr.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
|
||
TkWindow *winPtr; /* Window where event occurred: needed to
|
||
* get input context. */
|
||
char *before; /* Command containing percent expressions
|
||
* to be replaced. */
|
||
XEvent *eventPtr; /* X event containing information to be
|
||
* used in % replacements. */
|
||
KeySym keySym; /* KeySym: only relevant for KeyPress and
|
||
* KeyRelease events). */
|
||
Tcl_DString *dsPtr; /* Dynamic string in which to append new
|
||
* command. */
|
||
{
|
||
#ifdef SCM_CODE
|
||
int number, flags;
|
||
#else
|
||
int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl
|
||
* list element. */
|
||
int number, flags, length;
|
||
#endif
|
||
|
||
#define NUM_SIZE 40
|
||
char *string;
|
||
char numStorage[NUM_SIZE+1];
|
||
|
||
if (eventPtr->type < TK_LASTEVENT) {
|
||
flags = flagArray[eventPtr->type];
|
||
} else {
|
||
flags = 0;
|
||
}
|
||
#ifdef SCM_CODE
|
||
/*
|
||
* Binding is something like "(#p123abc x y)" or "(#p123abc)"
|
||
* Skip the function "name"
|
||
*/
|
||
for (string=before;
|
||
(*string != 0) && (*string != ' ') && (*string != ')');
|
||
string++) {
|
||
/* Empty loop body. */
|
||
}
|
||
Tcl_DStringAppend(dsPtr, before, string-before);
|
||
before = string;
|
||
#endif
|
||
|
||
while (1) {
|
||
#ifndef SCM_CODE
|
||
/*
|
||
* Find everything up to the next % character and append it
|
||
* to the result string.
|
||
*/
|
||
|
||
for (string = before; (*string != 0) && (*string != '%'); string++) {
|
||
/* Empty loop body. */
|
||
}
|
||
if (string != before) {
|
||
Tcl_DStringAppend(dsPtr, before, string-before);
|
||
before = string;
|
||
}
|
||
#endif
|
||
|
||
if (*before == 0) {
|
||
break;
|
||
}
|
||
|
||
/*
|
||
* There's a percent sequence here. Process it.
|
||
*/
|
||
|
||
number = 0;
|
||
string = "??";
|
||
#ifdef SCM_CODE
|
||
switch (before[0]) {
|
||
#else
|
||
switch (before[1]) {
|
||
#endif
|
||
case '#':
|
||
number = eventPtr->xany.serial;
|
||
goto doNumber;
|
||
case 'a':
|
||
TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
|
||
string = numStorage;
|
||
goto doString;
|
||
case 'b':
|
||
number = eventPtr->xbutton.button;
|
||
goto doNumber;
|
||
case 'c':
|
||
if (flags & EXPOSE) {
|
||
number = eventPtr->xexpose.count;
|
||
}
|
||
goto doNumber;
|
||
case 'd':
|
||
if (flags & (CROSSING|FOCUS)) {
|
||
if (flags & FOCUS) {
|
||
number = eventPtr->xfocus.detail;
|
||
} else {
|
||
number = eventPtr->xcrossing.detail;
|
||
}
|
||
string = TkFindStateString(notifyDetail, number);
|
||
}
|
||
goto doString;
|
||
case 'f':
|
||
#ifdef SCM_CODE
|
||
string = (eventPtr->xcrossing.focus) ? "#t" : "#f";
|
||
goto doSymbol;
|
||
#else
|
||
number = eventPtr->xcrossing.focus;
|
||
goto doNumber;
|
||
#endif
|
||
case 'h':
|
||
if (flags & EXPOSE) {
|
||
number = eventPtr->xexpose.height;
|
||
} else if (flags & (CONFIG)) {
|
||
number = eventPtr->xconfigure.height;
|
||
}
|
||
goto doNumber;
|
||
case 'k':
|
||
number = eventPtr->xkey.keycode;
|
||
goto doNumber;
|
||
case 'm':
|
||
if (flags & CROSSING) {
|
||
number = eventPtr->xcrossing.mode;
|
||
} else if (flags & FOCUS) {
|
||
number = eventPtr->xfocus.mode;
|
||
}
|
||
string = TkFindStateString(notifyMode, number);
|
||
goto doString;
|
||
case 'o':
|
||
if (flags & CREATE) {
|
||
number = eventPtr->xcreatewindow.override_redirect;
|
||
} else if (flags & MAP) {
|
||
number = eventPtr->xmap.override_redirect;
|
||
} else if (flags & REPARENT) {
|
||
number = eventPtr->xreparent.override_redirect;
|
||
} else if (flags & CONFIG) {
|
||
number = eventPtr->xconfigure.override_redirect;
|
||
}
|
||
#ifdef SCM_CODE
|
||
string = number ? "#t" : "#f";
|
||
goto doSymbol;
|
||
#else
|
||
goto doNumber;
|
||
#endif
|
||
case 'p':
|
||
string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
|
||
goto doString;
|
||
case 's':
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
number = eventPtr->xkey.state;
|
||
} else if (flags & CROSSING) {
|
||
number = eventPtr->xcrossing.state;
|
||
} else if (flags & VISIBILITY) {
|
||
string = TkFindStateString(visNotify,
|
||
eventPtr->xvisibility.state);
|
||
goto doString;
|
||
}
|
||
goto doNumber;
|
||
case 't':
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
number = (int) eventPtr->xkey.time;
|
||
} else if (flags & CROSSING) {
|
||
number = (int) eventPtr->xcrossing.time;
|
||
} else if (flags & PROP) {
|
||
number = (int) eventPtr->xproperty.time;
|
||
}
|
||
goto doNumber;
|
||
case 'v':
|
||
number = eventPtr->xconfigurerequest.value_mask;
|
||
goto doNumber;
|
||
case 'w':
|
||
if (flags & EXPOSE) {
|
||
number = eventPtr->xexpose.width;
|
||
} else if (flags & CONFIG) {
|
||
number = eventPtr->xconfigure.width;
|
||
}
|
||
goto doNumber;
|
||
case 'x':
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
number = eventPtr->xkey.x;
|
||
} else if (flags & CROSSING) {
|
||
number = eventPtr->xcrossing.x;
|
||
} else if (flags & EXPOSE) {
|
||
number = eventPtr->xexpose.x;
|
||
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
|
||
number = eventPtr->xcreatewindow.x;
|
||
} else if (flags & REPARENT) {
|
||
number = eventPtr->xreparent.x;
|
||
}
|
||
goto doNumber;
|
||
case 'y':
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
number = eventPtr->xkey.y;
|
||
} else if (flags & EXPOSE) {
|
||
number = eventPtr->xexpose.y;
|
||
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
|
||
number = eventPtr->xcreatewindow.y;
|
||
} else if (flags & REPARENT) {
|
||
number = eventPtr->xreparent.y;
|
||
} else if (flags & CROSSING) {
|
||
number = eventPtr->xcrossing.y;
|
||
|
||
}
|
||
goto doNumber;
|
||
case 'A':
|
||
if (flags & KEY) {
|
||
int numChars;
|
||
|
||
/*
|
||
* If we're using input methods and this is a keypress
|
||
* event, invoke XmbTkFindStateString. Otherwise just use
|
||
* the older XTkFindStateString.
|
||
*/
|
||
|
||
#ifdef TK_USE_INPUT_METHODS
|
||
Status status;
|
||
if ((winPtr->inputContext != NULL)
|
||
&& (eventPtr->type == KeyPress)) {
|
||
numChars = XmbLookupString(winPtr->inputContext,
|
||
&eventPtr->xkey, numStorage, NUM_SIZE,
|
||
(KeySym *) NULL, &status);
|
||
if ((status != XLookupChars)
|
||
&& (status != XLookupBoth)) {
|
||
numChars = 0;
|
||
}
|
||
} else {
|
||
numChars = XLookupString(&eventPtr->xkey, numStorage,
|
||
NUM_SIZE, (KeySym *) NULL,
|
||
(XComposeStatus *) NULL);
|
||
}
|
||
#else /* TK_USE_INPUT_METHODS */
|
||
numChars = XLookupString(&eventPtr->xkey, numStorage,
|
||
NUM_SIZE, (KeySym *) NULL,
|
||
(XComposeStatus *) NULL);
|
||
#endif /* TK_USE_INPUT_METHODS */
|
||
numStorage[numChars] = '\0';
|
||
string = numStorage;
|
||
}
|
||
goto doString;
|
||
case 'B':
|
||
number = eventPtr->xcreatewindow.border_width;
|
||
goto doNumber;
|
||
case 'E':
|
||
number = (int) eventPtr->xany.send_event;
|
||
goto doNumber;
|
||
case 'K':
|
||
if (flags & KEY) {
|
||
char *name;
|
||
|
||
name = TkKeysymToString(keySym);
|
||
if (name != NULL) {
|
||
string = name;
|
||
}
|
||
}
|
||
goto doString;
|
||
case 'N':
|
||
number = (int) keySym;
|
||
goto doNumber;
|
||
case 'R':
|
||
TkpPrintWindowId(numStorage, eventPtr->xkey.root);
|
||
string = numStorage;
|
||
goto doString;
|
||
case 'S':
|
||
TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
|
||
string = numStorage;
|
||
goto doString;
|
||
case 'T':
|
||
number = eventPtr->type;
|
||
goto doNumber;
|
||
case 'W': {
|
||
Tk_Window tkwin;
|
||
|
||
tkwin = Tk_IdToWindow(eventPtr->xany.display,
|
||
eventPtr->xany.window);
|
||
if (tkwin != NULL) {
|
||
string = Tk_PathName(tkwin);
|
||
#ifdef BGLK_CODE
|
||
string = SCM_procedure_to_tk_string(
|
||
tcl_lookup_command( Tk_PathName(tkwin) ) );
|
||
#endif
|
||
#ifdef STk_CODE
|
||
if (string[1] == '\0') string = "*root*";
|
||
#endif
|
||
} else {
|
||
string = "??";
|
||
}
|
||
#ifdef SCM_CODE
|
||
goto doSymbol;
|
||
#else
|
||
goto doString;
|
||
#endif
|
||
}
|
||
case 'X': {
|
||
Tk_Window tkwin;
|
||
int x, y;
|
||
int width, height;
|
||
|
||
number = eventPtr->xkey.x_root;
|
||
tkwin = Tk_IdToWindow(eventPtr->xany.display,
|
||
eventPtr->xany.window);
|
||
if (tkwin != NULL) {
|
||
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
|
||
number -= x;
|
||
}
|
||
goto doNumber;
|
||
}
|
||
case 'Y': {
|
||
Tk_Window tkwin;
|
||
int x, y;
|
||
int width, height;
|
||
|
||
number = eventPtr->xkey.y_root;
|
||
tkwin = Tk_IdToWindow(eventPtr->xany.display,
|
||
eventPtr->xany.window);
|
||
if (tkwin != NULL) {
|
||
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
|
||
number -= y;
|
||
}
|
||
goto doNumber;
|
||
}
|
||
default:
|
||
#ifdef SCM_CODE
|
||
/* Just append the current character in the result string */
|
||
Tcl_DStringAppend(dsPtr, before, 1);
|
||
before += 1;
|
||
continue;
|
||
#else
|
||
numStorage[0] = before[1];
|
||
numStorage[1] = '\0';
|
||
string = numStorage;
|
||
goto doString;
|
||
#endif
|
||
}
|
||
#ifdef SCM_CODE
|
||
doSymbol:
|
||
{
|
||
Tcl_DStringAppend(dsPtr, string, -1);
|
||
before += 1;
|
||
continue;
|
||
}
|
||
doString:
|
||
{
|
||
char *s;
|
||
|
||
# ifdef STk_CODE
|
||
s = STk_stringify(string, 0);
|
||
# else
|
||
s = SCM_stringify(string, 0);
|
||
# endif
|
||
Tcl_DStringAppend(dsPtr, s, -1);
|
||
# ifndef BGLK_CODE
|
||
ckfree(s);
|
||
# endif
|
||
before += 1;
|
||
continue;
|
||
}
|
||
doNumber:
|
||
{
|
||
sprintf(numStorage, "%d", number);
|
||
Tcl_DStringAppend(dsPtr, numStorage, -1);
|
||
before += 1;
|
||
}
|
||
/* skip the characters after the first character of the
|
||
* variable name (i.e. only the fisrt character is significant
|
||
* This is not pretty but we cannot do much here since this
|
||
* is void function.
|
||
*/
|
||
while (*before && *before != ' ' && *before !=')') before++;
|
||
#else
|
||
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;
|
||
#endif
|
||
}
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ChangeScreen --
|
||
*
|
||
* This procedure is invoked whenever the current screen changes
|
||
* in an application. It invokes a Tcl procedure named
|
||
* "tkScreenChanged", passing it the screen name as argument.
|
||
* tkScreenChanged does things like making the tkPriv variable
|
||
* point to an array for the current display.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Depends on what tkScreenChanged does. If an error occurs
|
||
* them tkError will be invoked.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
ChangeScreen(interp, dispName, screenIndex)
|
||
Tcl_Interp *interp; /* Interpreter in which to invoke
|
||
* command. */
|
||
char *dispName; /* Name of new display. */
|
||
int screenIndex; /* Index of new screen. */
|
||
{
|
||
#ifdef SCM_CODE
|
||
# ifdef STk_CODE
|
||
char command[200];
|
||
int code;
|
||
|
||
sprintf(command, "(Tk-screen-changed \"%s.%d\")", dispName, screenIndex);
|
||
code = Tcl_GlobalEval(interp, command);
|
||
# endif
|
||
#else
|
||
Tcl_DString cmd;
|
||
int code;
|
||
char screen[30];
|
||
|
||
Tcl_DStringInit(&cmd);
|
||
Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
|
||
Tcl_DStringAppend(&cmd, dispName, -1);
|
||
sprintf(screen, ".%d", screenIndex);
|
||
Tcl_DStringAppend(&cmd, screen, -1);
|
||
|
||
code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));
|
||
#endif
|
||
|
||
#ifndef BGLK_CODE
|
||
if (code != TCL_OK) {
|
||
Tcl_AddErrorInfo(interp,
|
||
"\n (changing screen in event binding)");
|
||
Tcl_BackgroundError(interp);
|
||
}
|
||
#endif
|
||
}
|
||
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tk_EventCmd --
|
||
*
|
||
* This procedure is invoked to process the "event" Tcl command.
|
||
* It is used to define and generate events.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_EventCmd(clientData, interp, argc, argv)
|
||
ClientData clientData; /* Main window associated with
|
||
* interpreter. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
int i;
|
||
size_t length;
|
||
char *option;
|
||
Tk_Window tkwin;
|
||
VirtualEventTable *vetPtr;
|
||
TkBindInfo bindInfo;
|
||
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"",
|
||
argv[0], " option ?arg1?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
option = argv[1];
|
||
length = strlen(option);
|
||
if (length == 0) {
|
||
goto badopt;
|
||
}
|
||
|
||
tkwin = (Tk_Window) clientData;
|
||
bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
|
||
vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
|
||
|
||
if (strncmp(option, "add", length) == 0) {
|
||
if (argc < 4) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" add virtual sequence ?sequence ...?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
for (i = 3; i < argc; i++) {
|
||
if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i])
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
} else if (strncmp(option, "delete", length) == 0) {
|
||
if (argc < 3) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" delete virtual ?sequence sequence ...?\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (argc == 3) {
|
||
return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL);
|
||
}
|
||
for (i = 3; i < argc; i++) {
|
||
if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i])
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
} else if (strncmp(option, "generate", length) == 0) {
|
||
if (argc < 4) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" generate window event ?options?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2);
|
||
} else if (strncmp(option, "info", length) == 0) {
|
||
if (argc == 2) {
|
||
GetAllVirtualEvents(interp, vetPtr);
|
||
return TCL_OK;
|
||
} else if (argc == 3) {
|
||
return GetVirtualEvent(interp, vetPtr, argv[2]);
|
||
} else {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" info ?virtual?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
} else {
|
||
badopt:
|
||
Tcl_AppendResult(interp, "bad option \"", argv[1],
|
||
"\": should be add, delete, generate, info", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* InitVirtualEventTable --
|
||
*
|
||
* Given storage for a virtual event table, set up the fields to
|
||
* prepare a new domain in which virtual events may be defined.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* *vetPtr is now initialized.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
InitVirtualEventTable(vetPtr)
|
||
VirtualEventTable *vetPtr; /* Pointer to virtual event table. Memory
|
||
* is supplied by the caller. */
|
||
{
|
||
Tcl_InitHashTable(&vetPtr->patternTable,
|
||
sizeof(PatternTableKey) / sizeof(int));
|
||
Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* DeleteVirtualEventTable --
|
||
*
|
||
* Delete the contents of a virtual event table. The caller is
|
||
* responsible for freeing any memory used by the table itself.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Memory is freed.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
DeleteVirtualEventTable(vetPtr)
|
||
VirtualEventTable *vetPtr; /* The virtual event table to delete. */
|
||
{
|
||
Tcl_HashEntry *hPtr;
|
||
Tcl_HashSearch search;
|
||
PatSeq *psPtr, *nextPtr;
|
||
|
||
hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
|
||
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
|
||
psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
for ( ; psPtr != NULL; psPtr = nextPtr) {
|
||
nextPtr = psPtr->nextSeqPtr;
|
||
ckfree((char *) psPtr->voPtr);
|
||
ckfree((char *) psPtr);
|
||
}
|
||
}
|
||
Tcl_DeleteHashTable(&vetPtr->patternTable);
|
||
|
||
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
|
||
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
|
||
ckfree((char *) Tcl_GetHashValue(hPtr));
|
||
}
|
||
Tcl_DeleteHashTable(&vetPtr->nameTable);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* CreateVirtualEvent --
|
||
*
|
||
* Add a new definition for a virtual event. If the virtual event
|
||
* is already defined, the new definition augments those that
|
||
* already exist.
|
||
*
|
||
* Results:
|
||
* The return value is TCL_ERROR if an error occured while
|
||
* creating the virtual binding. In this case, an error message
|
||
* will be left in interp->result. If all went well then the return
|
||
* value is TCL_OK.
|
||
*
|
||
* Side effects:
|
||
* The virtual event may cause future calls to Tk_BindEvent to
|
||
* behave differently than they did previously.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
CreateVirtualEvent(interp, vetPtr, virtString, eventString)
|
||
Tcl_Interp *interp; /* Used for error reporting. */
|
||
VirtualEventTable *vetPtr;/* Table in which to augment virtual event. */
|
||
char *virtString; /* Name of new virtual event. */
|
||
char *eventString; /* String describing physical event that
|
||
* triggers virtual event. */
|
||
{
|
||
PatSeq *psPtr;
|
||
int dummy;
|
||
Tcl_HashEntry *vhPtr;
|
||
unsigned long eventMask;
|
||
PhysicalsOwned *poPtr;
|
||
VirtualOwners *voPtr;
|
||
Tk_Uid virtUid;
|
||
|
||
virtUid = GetVirtualEventUid(interp, virtString);
|
||
if (virtUid == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
* Find/create physical event
|
||
*/
|
||
|
||
psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
|
||
1, 0, &eventMask);
|
||
if (psPtr == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
* Find/create virtual event.
|
||
*/
|
||
|
||
vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
|
||
|
||
/*
|
||
* Make virtual event own the physical event.
|
||
*/
|
||
|
||
poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
|
||
if (poPtr == NULL) {
|
||
poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
|
||
poPtr->numOwned = 0;
|
||
} else {
|
||
/*
|
||
* See if this virtual event is already defined for this physical
|
||
* event and just return if it is.
|
||
*/
|
||
|
||
int i;
|
||
for (i = 0; i < poPtr->numOwned; i++) {
|
||
if (poPtr->patSeqs[i] == psPtr) {
|
||
return TCL_OK;
|
||
}
|
||
}
|
||
poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
|
||
sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
|
||
}
|
||
Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
|
||
poPtr->patSeqs[poPtr->numOwned] = psPtr;
|
||
poPtr->numOwned++;
|
||
|
||
/*
|
||
* Make physical event so it can trigger the virtual event.
|
||
*/
|
||
|
||
voPtr = psPtr->voPtr;
|
||
if (voPtr == NULL) {
|
||
voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
|
||
voPtr->numOwners = 0;
|
||
} else {
|
||
voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
|
||
sizeof(VirtualOwners)
|
||
+ voPtr->numOwners * sizeof(Tcl_HashEntry *));
|
||
}
|
||
psPtr->voPtr = voPtr;
|
||
voPtr->owners[voPtr->numOwners] = vhPtr;
|
||
voPtr->numOwners++;
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* DeleteVirtualEvent --
|
||
*
|
||
* Remove the definition of a given virtual event. If the
|
||
* event string is NULL, all definitions of the virtual event
|
||
* will be removed. Otherwise, just the specified definition
|
||
* of the virtual event will be removed.
|
||
*
|
||
* Results:
|
||
* The result is a standard Tcl return value. If an error
|
||
* occurs then interp->result will contain an error message.
|
||
* It is not an error to attempt to delete a virtual event that
|
||
* does not exist or a definition that does not exist.
|
||
*
|
||
* Side effects:
|
||
* The virtual event given by virtString may be removed from the
|
||
* virtual event table.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
|
||
Tcl_Interp *interp; /* Used for error reporting. */
|
||
VirtualEventTable *vetPtr;/* Table in which to delete event. */
|
||
char *virtString; /* String describing event sequence that
|
||
* triggers binding. */
|
||
char *eventString; /* The event sequence that should be deleted,
|
||
* or NULL to delete all event sequences for
|
||
* the entire virtual event. */
|
||
{
|
||
int iPhys;
|
||
Tk_Uid virtUid;
|
||
Tcl_HashEntry *vhPtr;
|
||
PhysicalsOwned *poPtr;
|
||
PatSeq *eventPSPtr;
|
||
|
||
virtUid = GetVirtualEventUid(interp, virtString);
|
||
if (virtUid == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
|
||
if (vhPtr == NULL) {
|
||
return TCL_OK;
|
||
}
|
||
poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
|
||
|
||
eventPSPtr = NULL;
|
||
if (eventString != NULL) {
|
||
unsigned long eventMask;
|
||
|
||
/*
|
||
* Delete only the specific physical event associated with the
|
||
* virtual event. If the physical event doesn't already exist, or
|
||
* the virtual event doesn't own that physical event, return w/o
|
||
* doing anything.
|
||
*/
|
||
|
||
eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
|
||
eventString, 0, 0, &eventMask);
|
||
if (eventPSPtr == NULL) {
|
||
return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK;
|
||
}
|
||
}
|
||
|
||
for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
|
||
PatSeq *psPtr = poPtr->patSeqs[iPhys];
|
||
if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
|
||
int iVirt;
|
||
VirtualOwners *voPtr;
|
||
|
||
/*
|
||
* Remove association between this physical event and the given
|
||
* virtual event that it triggers.
|
||
*/
|
||
|
||
voPtr = psPtr->voPtr;
|
||
for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
|
||
if (voPtr->owners[iVirt] == vhPtr) {
|
||
break;
|
||
}
|
||
}
|
||
if (iVirt == voPtr->numOwners) {
|
||
panic("DeleteVirtualEvent: couldn't find owner");
|
||
}
|
||
voPtr->numOwners--;
|
||
if (voPtr->numOwners == 0) {
|
||
/*
|
||
* Removed last reference to this physical event, so
|
||
* remove it from physical->virtual map.
|
||
*/
|
||
PatSeq *prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
|
||
if (prevPtr == psPtr) {
|
||
if (psPtr->nextSeqPtr == NULL) {
|
||
Tcl_DeleteHashEntry(psPtr->hPtr);
|
||
} else {
|
||
Tcl_SetHashValue(psPtr->hPtr,
|
||
psPtr->nextSeqPtr);
|
||
}
|
||
} else {
|
||
for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
|
||
if (prevPtr == NULL) {
|
||
panic("Tk_DeleteVirtualEvent couldn't find on hash chain");
|
||
}
|
||
if (prevPtr->nextSeqPtr == psPtr) {
|
||
prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
ckfree((char *) psPtr->voPtr);
|
||
ckfree((char *) psPtr);
|
||
} else {
|
||
/*
|
||
* This physical event still triggers some other virtual
|
||
* event(s). Consolidate the list of virtual owners for
|
||
* this physical event so it no longer triggers the
|
||
* given virtual event.
|
||
*/
|
||
voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
|
||
}
|
||
|
||
/*
|
||
* Now delete the virtual event's reference to the physical
|
||
* event.
|
||
*/
|
||
|
||
poPtr->numOwned--;
|
||
if (eventPSPtr != NULL && poPtr->numOwned != 0) {
|
||
/*
|
||
* Just deleting this one physical event. Consolidate list
|
||
* of owned physical events and return.
|
||
*/
|
||
|
||
poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
|
||
return TCL_OK;
|
||
}
|
||
}
|
||
}
|
||
|
||
if (poPtr->numOwned == 0) {
|
||
/*
|
||
* All the physical events for this virtual event were deleted,
|
||
* either because there was only one associated physical event or
|
||
* because the caller was deleting the entire virtual event. Now
|
||
* the virtual event itself should be deleted.
|
||
*/
|
||
|
||
ckfree((char *) poPtr);
|
||
Tcl_DeleteHashEntry(vhPtr);
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* GetVirtualEvent --
|
||
*
|
||
* Return the list of physical events that can invoke the
|
||
* given virtual event.
|
||
*
|
||
* Results:
|
||
* The return value is TCL_OK and interp->result is filled with the
|
||
* string representation of the physical events associated with the
|
||
* virtual event; if there are no physical events for the given virtual
|
||
* event, interp->result is filled with and empty string. If the
|
||
* virtual event string is improperly formed, then TCL_ERROR is
|
||
* returned and an error message is left in interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
GetVirtualEvent(interp, vetPtr, virtString)
|
||
Tcl_Interp *interp; /* Interpreter for reporting. */
|
||
VirtualEventTable *vetPtr;/* Table in which to look for event. */
|
||
char *virtString; /* String describing virtual event. */
|
||
{
|
||
Tcl_HashEntry *vhPtr;
|
||
Tcl_DString ds;
|
||
int iPhys;
|
||
PhysicalsOwned *poPtr;
|
||
Tk_Uid virtUid;
|
||
|
||
virtUid = GetVirtualEventUid(interp, virtString);
|
||
if (virtUid == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
|
||
if (vhPtr == NULL) {
|
||
return TCL_OK;
|
||
}
|
||
|
||
Tcl_DStringInit(&ds);
|
||
|
||
poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
|
||
for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
|
||
Tcl_DStringSetLength(&ds, 0);
|
||
GetPatternString(poPtr->patSeqs[iPhys], &ds);
|
||
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
|
||
}
|
||
Tcl_DStringFree(&ds);
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* GetAllVirtualEvents --
|
||
*
|
||
* Return a list that contains the names of all the virtual
|
||
* event defined.
|
||
*
|
||
* Results:
|
||
* There is no return value. Interp->result is modified to
|
||
* hold a Tcl list with one entry for each virtual event in
|
||
* nameTable.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
#ifdef STk_CODE
|
||
/*
|
||
* There are no more '%' in STk, but since this function is not too much modified,
|
||
* I prefer do the modification in place, rather than rewrite it in an #ifdef.
|
||
* Furthermore, patch command can be run easily on it
|
||
*/
|
||
#endif
|
||
|
||
static void
|
||
GetAllVirtualEvents(interp, vetPtr)
|
||
Tcl_Interp *interp; /* Interpreter returning result. */
|
||
VirtualEventTable *vetPtr;/* Table containing events. */
|
||
{
|
||
Tcl_HashEntry *hPtr;
|
||
Tcl_HashSearch search;
|
||
Tcl_DString ds;
|
||
|
||
Tcl_DStringInit(&ds);
|
||
|
||
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
|
||
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
|
||
Tcl_DStringSetLength(&ds, 0);
|
||
#ifdef SCM_CODE
|
||
Tcl_DStringAppend(&ds, "\"<<", 3);
|
||
#else
|
||
Tcl_DStringAppend(&ds, "<<", 2);
|
||
#endif
|
||
Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
|
||
#ifdef SCM_CODE
|
||
Tcl_DStringAppend(&ds, ">>\"", 3);
|
||
#else
|
||
Tcl_DStringAppend(&ds, ">>", 2);
|
||
#endif
|
||
Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
|
||
}
|
||
|
||
Tcl_DStringFree(&ds);
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* HandleEventGenerate --
|
||
*
|
||
* Helper function for the "event generate" command. Generate and
|
||
* process an XEvent, constructed from information parsed from the
|
||
* event description string and its optional arguments.
|
||
*
|
||
* argv[0] contains name of the target window.
|
||
* argv[1] contains pattern string for one event (e.g, <Control-v>).
|
||
* argv[2..argc-1] contains -field/option pairs for specifying
|
||
* additional detail in the generated event.
|
||
*
|
||
* Either virtual or physical events can be generated this way.
|
||
* The event description string must contain the specification
|
||
* for only one event.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* When constructing the event,
|
||
* event.xany.serial is filled with the current X serial number.
|
||
* event.xany.window is filled with the target window.
|
||
* event.xany.display is filled with the target window's display.
|
||
* Any other fields in eventPtr which are not specified by the pattern
|
||
* string or the optional arguments, are set to 0.
|
||
*
|
||
* The event may be handled sychronously or asynchronously, depending
|
||
* on the value specified by the optional "-when" option. The
|
||
* default setting is synchronous.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
static int
|
||
HandleEventGenerate(interp, mainwin, argc, argv)
|
||
Tcl_Interp *interp; /* Interp for error messages and name lookup. */
|
||
Tk_Window mainwin; /* Main window associated with interp. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
Pattern pat;
|
||
Tk_Window tkwin;
|
||
char *p;
|
||
unsigned long eventMask;
|
||
int count, i, state, flags, synch;
|
||
Tcl_QueuePosition pos;
|
||
XEvent event;
|
||
|
||
if (argv[0][0] == '.') {
|
||
tkwin = Tk_NameToWindow(interp, argv[0], mainwin);
|
||
if (tkwin == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
} else {
|
||
if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) {
|
||
Tcl_AppendResult(interp, "bad window name/identifier \"",
|
||
argv[0], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
tkwin = Tk_IdToWindow(Tk_Display(mainwin), (Window) i);
|
||
if ((tkwin == NULL) || (((TkWindow *) mainwin)->mainPtr
|
||
!= ((TkWindow *) tkwin)->mainPtr)) {
|
||
Tcl_AppendResult(interp, "window id \"", argv[0],
|
||
"\" doesn't exist in this application", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
|
||
p = argv[1];
|
||
count = ParseEventDescription(interp, &p, &pat, &eventMask);
|
||
if (count == 0) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (count != 1) {
|
||
interp->result = "Double or Triple modifier not allowed";
|
||
return TCL_ERROR;
|
||
}
|
||
if (*p != '\0') {
|
||
interp->result = "only one event specification allowed";
|
||
return TCL_ERROR;
|
||
}
|
||
if (argc & 1) {
|
||
Tcl_AppendResult(interp, "value for \"", argv[argc - 1],
|
||
"\" missing", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
memset((VOID *) &event, 0, sizeof(event));
|
||
event.xany.type = pat.eventType;
|
||
event.xany.serial = NextRequest(Tk_Display(tkwin));
|
||
event.xany.send_event = False;
|
||
event.xany.window = Tk_WindowId(tkwin);
|
||
event.xany.display = Tk_Display(tkwin);
|
||
|
||
flags = flagArray[event.xany.type];
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
event.xkey.state = pat.needMods;
|
||
if (flags & KEY) {
|
||
/*
|
||
* When mapping from a keysym to a keycode, need information about
|
||
* the modifier state that should be used so that when they call
|
||
* XKeycodeToKeysym taking into account the xkey.state, they will
|
||
* get back the original keysym.
|
||
*/
|
||
|
||
if (pat.detail.keySym == NoSymbol) {
|
||
event.xkey.keycode = 0;
|
||
} else {
|
||
event.xkey.keycode = XKeysymToKeycode(event.xany.display,
|
||
pat.detail.keySym);
|
||
}
|
||
if (event.xkey.keycode != 0) {
|
||
for (state = 0; state < 4; state++) {
|
||
if (XKeycodeToKeysym(event.xany.display,
|
||
event.xkey.keycode, state) == pat.detail.keySym) {
|
||
if (state & 1) {
|
||
event.xkey.state |= ShiftMask;
|
||
}
|
||
if (state & 2) {
|
||
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
|
||
event.xkey.state |= dispPtr->modeModMask;
|
||
}
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
} else if (flags & BUTTON) {
|
||
event.xbutton.button = pat.detail.button;
|
||
} else if (flags & VIRTUAL) {
|
||
((XVirtualEvent *) &event)->name = pat.detail.name;
|
||
}
|
||
}
|
||
if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
|
||
event.xcreatewindow.window = event.xany.window;
|
||
}
|
||
|
||
/*
|
||
* Process the remaining arguments to fill in additional fields
|
||
* of the event.
|
||
*/
|
||
|
||
synch = 1;
|
||
pos = TCL_QUEUE_TAIL;
|
||
for (i = 2; i < argc; i += 2) {
|
||
char *field, *value;
|
||
Tk_Window tkwin2;
|
||
int number;
|
||
KeySym keysym;
|
||
|
||
field = argv[i];
|
||
value = argv[i+1];
|
||
|
||
if (strcmp(field, "-when") == 0) {
|
||
if (strcmp(value, "now") == 0) {
|
||
synch = 1;
|
||
} else if (strcmp(value, "head") == 0) {
|
||
pos = TCL_QUEUE_HEAD;
|
||
synch = 0;
|
||
} else if (strcmp(value, "mark") == 0) {
|
||
pos = TCL_QUEUE_MARK;
|
||
synch = 0;
|
||
} else if (strcmp(value, "tail") == 0) {
|
||
pos = TCL_QUEUE_TAIL;
|
||
synch = 0;
|
||
} else {
|
||
Tcl_AppendResult(interp, "bad position \"", value,
|
||
"\": should be now, head, mark, tail", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
} else if (strcmp(field, "-above") == 0) {
|
||
if (value[0] == '.') {
|
||
tkwin2 = Tk_NameToWindow(interp, value, mainwin);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
number = Tk_WindowId(tkwin2);
|
||
} else if (TkpScanWindowId(interp, value, &number)
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CONFIG) {
|
||
event.xconfigure.above = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-borderwidth") == 0) {
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (CREATE|CONFIG)) {
|
||
event.xcreatewindow.border_width = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-button") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & BUTTON) {
|
||
event.xbutton.button = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-count") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & EXPOSE) {
|
||
event.xexpose.count = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-detail") == 0) {
|
||
number = TkFindStateNum(interp, field, notifyDetail, value);
|
||
if (number < 0) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & FOCUS) {
|
||
event.xfocus.detail = number;
|
||
} else if (flags & CROSSING) {
|
||
event.xcrossing.detail = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-focus") == 0) {
|
||
if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CROSSING) {
|
||
event.xcrossing.focus = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-height") == 0) {
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & EXPOSE) {
|
||
event.xexpose.height = number;
|
||
} else if (flags & CONFIG) {
|
||
event.xconfigure.height = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-keycode") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & KEY) {
|
||
event.xkey.keycode = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-keysym") == 0) {
|
||
keysym = TkStringToKeysym(value);
|
||
if (keysym == NoSymbol) {
|
||
Tcl_AppendResult(interp, "unknown keysym \"", value,
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
/*
|
||
* When mapping from a keysym to a keycode, need information about
|
||
* the modifier state that should be used so that when they call
|
||
* XKeycodeToKeysym taking into account the xkey.state, they will
|
||
* get back the original keysym.
|
||
*/
|
||
|
||
number = XKeysymToKeycode(event.xany.display, keysym);
|
||
if (number == 0) {
|
||
Tcl_AppendResult(interp, "no keycode for keysym \"", value,
|
||
"\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
for (state = 0; state < 4; state++) {
|
||
if (XKeycodeToKeysym(event.xany.display, (unsigned) number,
|
||
state) == keysym) {
|
||
if (state & 1) {
|
||
event.xkey.state |= ShiftMask;
|
||
}
|
||
if (state & 2) {
|
||
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
|
||
event.xkey.state |= dispPtr->modeModMask;
|
||
}
|
||
break;
|
||
}
|
||
}
|
||
if (flags & KEY) {
|
||
event.xkey.keycode = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-mode") == 0) {
|
||
number = TkFindStateNum(interp, field, notifyMode, value);
|
||
if (number < 0) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CROSSING) {
|
||
event.xcrossing.mode = number;
|
||
} else if (flags & FOCUS) {
|
||
event.xfocus.mode = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-override") == 0) {
|
||
if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CREATE) {
|
||
event.xcreatewindow.override_redirect = number;
|
||
} else if (flags & MAP) {
|
||
event.xmap.override_redirect = number;
|
||
} else if (flags & REPARENT) {
|
||
event.xreparent.override_redirect = number;
|
||
} else if (flags & CONFIG) {
|
||
event.xconfigure.override_redirect = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-place") == 0) {
|
||
number = TkFindStateNum(interp, field, circPlace, value);
|
||
if (number < 0) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & CIRC) {
|
||
event.xcirculate.place = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-root") == 0) {
|
||
if (value[0] == '.') {
|
||
tkwin2 = Tk_NameToWindow(interp, value, mainwin);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
number = Tk_WindowId(tkwin2);
|
||
} else if (TkpScanWindowId(interp, value, &number)
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.root = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-rootx") == 0) {
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.x_root = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-rooty") == 0) {
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.y_root = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-sendevent") == 0) {
|
||
if (isdigit(UCHAR(value[0]))) {
|
||
/*
|
||
* Allow arbitrary integer values for the field; they
|
||
* are needed by a few of the tests in the Tk test suite.
|
||
*/
|
||
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
} else {
|
||
if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
event.xany.send_event = number;
|
||
} else if (strcmp(field, "-serial") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xany.serial = number;
|
||
} else if (strcmp(field, "-state") == 0) {
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
|
||
event.xkey.state = number;
|
||
} else {
|
||
event.xcrossing.state = number;
|
||
}
|
||
} else if (flags & VISIBILITY) {
|
||
number = TkFindStateNum(interp, field, visNotify, value);
|
||
if (number < 0) {
|
||
return TCL_ERROR;
|
||
}
|
||
event.xvisibility.state = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-subwindow") == 0) {
|
||
if (value[0] == '.') {
|
||
tkwin2 = Tk_NameToWindow(interp, value, mainwin);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
number = Tk_WindowId(tkwin2);
|
||
} else if (TkpScanWindowId(interp, value, &number)
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.subwindow = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-time") == 0) {
|
||
if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.time = (Time) number;
|
||
} else if (flags & PROP) {
|
||
event.xproperty.time = (Time) number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-width") == 0) {
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & EXPOSE) {
|
||
event.xexpose.width = number;
|
||
} else if (flags & (CREATE|CONFIG)) {
|
||
event.xcreatewindow.width = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-window") == 0) {
|
||
if (value[0] == '.') {
|
||
tkwin2 = Tk_NameToWindow(interp, value, mainwin);
|
||
if (tkwin2 == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
number = Tk_WindowId(tkwin2);
|
||
} else if (TkpScanWindowId(interp, value, &number)
|
||
!= TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
|
||
|GRAVITY|CIRC)) {
|
||
event.xcreatewindow.window = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-x") == 0) {
|
||
int rootX, rootY;
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tk_GetRootCoords(tkwin, &rootX, &rootY);
|
||
rootX += number;
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.x = number;
|
||
event.xkey.x_root = rootX;
|
||
} else if (flags & EXPOSE) {
|
||
event.xexpose.x = number;
|
||
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
|
||
event.xcreatewindow.x = number;
|
||
} else if (flags & REPARENT) {
|
||
event.xreparent.x = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else if (strcmp(field, "-y") == 0) {
|
||
int rootX, rootY;
|
||
if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
Tk_GetRootCoords(tkwin, &rootX, &rootY);
|
||
rootY += number;
|
||
if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
|
||
event.xkey.y = number;
|
||
event.xkey.y_root = rootY;
|
||
} else if (flags & EXPOSE) {
|
||
event.xexpose.y = number;
|
||
} else if (flags & (CREATE|CONFIG|GRAVITY)) {
|
||
event.xcreatewindow.y = number;
|
||
} else if (flags & REPARENT) {
|
||
event.xreparent.y = number;
|
||
} else {
|
||
goto badopt;
|
||
}
|
||
} else {
|
||
badopt:
|
||
Tcl_AppendResult(interp, "bad option to ", argv[1],
|
||
" event: \"", field, "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
|
||
if (synch != 0) {
|
||
Tk_HandleEvent(&event);
|
||
} else {
|
||
Tk_QueueWindowEvent(&event, pos);
|
||
}
|
||
Tcl_ResetResult(interp);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*-------------------------------------------------------------------------
|
||
*
|
||
* GetVirtualEventUid --
|
||
*
|
||
* Determine if the given string is in the proper format for a
|
||
* virtual event.
|
||
*
|
||
* Results:
|
||
* The return value is NULL if the virtual event string was
|
||
* not in the proper format. In this case, an error message
|
||
* will be left in interp->result. Otherwise the return
|
||
* value is a Tk_Uid that represents the virtual event.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*-------------------------------------------------------------------------
|
||
*/
|
||
static Tk_Uid
|
||
GetVirtualEventUid(interp, virtString)
|
||
Tcl_Interp *interp;
|
||
char *virtString;
|
||
{
|
||
Tk_Uid uid;
|
||
int length;
|
||
|
||
length = strlen(virtString);
|
||
|
||
if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
|
||
virtString[length - 2] != '>' || virtString[length - 1] != '>') {
|
||
Tcl_AppendResult(interp, "virtual event \"", virtString,
|
||
"\" is badly formed", (char *) NULL);
|
||
return NULL;
|
||
}
|
||
virtString[length - 2] = '\0';
|
||
uid = Tk_GetUid(virtString + 2);
|
||
virtString[length - 2] = '>';
|
||
|
||
return uid;
|
||
}
|
||
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* FindSequence --
|
||
*
|
||
* Find the entry in the pattern table that corresponds to a
|
||
* particular pattern string, and return a pointer to that
|
||
* entry.
|
||
*
|
||
* Results:
|
||
* The return value is normally a pointer to the PatSeq
|
||
* in patternTable that corresponds to eventString. If an error
|
||
* was found while parsing eventString, or if "create" is 0 and
|
||
* no pattern sequence previously existed, then NULL is returned
|
||
* and interp->result contains a message describing the problem.
|
||
* If no pattern sequence previously existed for eventString, then
|
||
* a new one is created with a NULL command field. In a successful
|
||
* return, *maskPtr is filled in with a mask of the event types
|
||
* on which the pattern sequence depends.
|
||
*
|
||
* Side effects:
|
||
* A new pattern sequence may be allocated.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static PatSeq *
|
||
FindSequence(interp, patternTablePtr, object, eventString, create,
|
||
allowVirtual, maskPtr)
|
||
Tcl_Interp *interp; /* Interpreter to use for error
|
||
* reporting. */
|
||
Tcl_HashTable *patternTablePtr; /* Table to use for lookup. */
|
||
ClientData object; /* For binding table, token for object with
|
||
* which binding is associated.
|
||
* For virtual event table, NULL. */
|
||
char *eventString; /* String description of pattern to
|
||
* match on. See user documentation
|
||
* for details. */
|
||
int create; /* 0 means don't create the entry if
|
||
* it doesn't already exist. Non-zero
|
||
* means create. */
|
||
int allowVirtual; /* 0 means that virtual events are not
|
||
* allowed in the sequence. Non-zero
|
||
* otherwise. */
|
||
unsigned long *maskPtr; /* *maskPtr is filled in with the event
|
||
* types on which this pattern sequence
|
||
* depends. */
|
||
{
|
||
|
||
Pattern pats[EVENT_BUFFER_SIZE];
|
||
int numPats, virtualFound;
|
||
char *p;
|
||
Pattern *patPtr;
|
||
PatSeq *psPtr;
|
||
Tcl_HashEntry *hPtr;
|
||
int flags, count, new;
|
||
size_t sequenceSize;
|
||
unsigned long eventMask;
|
||
PatternTableKey key;
|
||
|
||
/*
|
||
*-------------------------------------------------------------
|
||
* Step 1: parse the pattern string to produce an array
|
||
* of Patterns. The array is generated backwards, so
|
||
* that the lowest-indexed pattern corresponds to the last
|
||
* event that must occur.
|
||
*-------------------------------------------------------------
|
||
*/
|
||
|
||
p = eventString;
|
||
flags = 0;
|
||
eventMask = 0;
|
||
virtualFound = 0;
|
||
|
||
patPtr = &pats[EVENT_BUFFER_SIZE-1];
|
||
for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
|
||
while (isspace(UCHAR(*p))) {
|
||
p++;
|
||
}
|
||
if (*p == '\0') {
|
||
break;
|
||
}
|
||
|
||
count = ParseEventDescription(interp, &p, patPtr, &eventMask);
|
||
if (count == 0) {
|
||
return NULL;
|
||
}
|
||
|
||
if (eventMask & VirtualEventMask) {
|
||
if (allowVirtual == 0) {
|
||
interp->result =
|
||
"virtual event not allowed in definition of another virtual event";
|
||
return NULL;
|
||
}
|
||
virtualFound = 1;
|
||
}
|
||
|
||
/*
|
||
* Replicate events for DOUBLE and TRIPLE.
|
||
*/
|
||
|
||
if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
|
||
flags |= PAT_NEARBY;
|
||
patPtr[-1] = patPtr[0];
|
||
patPtr--;
|
||
numPats++;
|
||
if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
|
||
patPtr[-1] = patPtr[0];
|
||
patPtr--;
|
||
numPats++;
|
||
}
|
||
}
|
||
}
|
||
|
||
/*
|
||
*-------------------------------------------------------------
|
||
* Step 2: find the sequence in the binding table if it exists,
|
||
* and add a new sequence to the table if it doesn't.
|
||
*-------------------------------------------------------------
|
||
*/
|
||
|
||
if (numPats == 0) {
|
||
interp->result = "no events specified in binding";
|
||
return NULL;
|
||
}
|
||
if ((numPats > 1) && (virtualFound != 0)) {
|
||
interp->result = "virtual events may not be composed";
|
||
return NULL;
|
||
}
|
||
|
||
patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
|
||
memset(&key, 0, sizeof(key));
|
||
key.object = object;
|
||
key.type = patPtr->eventType;
|
||
key.detail = patPtr->detail;
|
||
hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &new);
|
||
sequenceSize = numPats*sizeof(Pattern);
|
||
if (!new) {
|
||
for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
|
||
psPtr = psPtr->nextSeqPtr) {
|
||
if ((numPats == psPtr->numPats)
|
||
&& ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
|
||
&& (memcmp((char *) patPtr, (char *) psPtr->pats,
|
||
sequenceSize) == 0)) {
|
||
goto done;
|
||
}
|
||
}
|
||
}
|
||
if (!create) {
|
||
if (new) {
|
||
Tcl_DeleteHashEntry(hPtr);
|
||
}
|
||
return NULL;
|
||
}
|
||
psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
|
||
+ (numPats-1)*sizeof(Pattern)));
|
||
psPtr->numPats = numPats;
|
||
psPtr->eventProc = NULL;
|
||
psPtr->freeProc = NULL;
|
||
psPtr->clientData = NULL;
|
||
psPtr->flags = flags;
|
||
psPtr->refCount = 0;
|
||
psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
|
||
psPtr->hPtr = hPtr;
|
||
psPtr->voPtr = NULL;
|
||
psPtr->nextObjPtr = NULL;
|
||
Tcl_SetHashValue(hPtr, psPtr);
|
||
|
||
memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
|
||
|
||
done:
|
||
*maskPtr = eventMask;
|
||
return psPtr;
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* ParseEventDescription --
|
||
*
|
||
* Fill Pattern buffer with information about event from
|
||
* event string.
|
||
*
|
||
* Results:
|
||
* Leaves error message in interp and returns 0 if there was an
|
||
* error due to a badly formed event string. Returns 1 if proper
|
||
* event was specified, 2 if Double modifier was used in event
|
||
* string, or 3 if Triple was used.
|
||
*
|
||
* Side effects:
|
||
* On exit, eventStringPtr points to rest of event string (after the
|
||
* closing '>', so that this procedure can be called repeatedly to
|
||
* parse all the events in the entire sequence.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
ParseEventDescription(interp, eventStringPtr, patPtr,
|
||
eventMaskPtr)
|
||
Tcl_Interp *interp; /* For error messages. */
|
||
char **eventStringPtr; /* On input, holds a pointer to start of
|
||
* event string. On exit, gets pointer to
|
||
* rest of string after parsed event. */
|
||
Pattern *patPtr; /* Filled with the pattern parsed from the
|
||
* event string. */
|
||
unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */
|
||
|
||
{
|
||
char *p;
|
||
unsigned long eventMask;
|
||
int count, eventFlags;
|
||
#define FIELD_SIZE 48
|
||
char field[FIELD_SIZE];
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
p = *eventStringPtr;
|
||
|
||
patPtr->eventType = -1;
|
||
patPtr->needMods = 0;
|
||
patPtr->detail.clientData = 0;
|
||
|
||
eventMask = 0;
|
||
count = 1;
|
||
|
||
/*
|
||
* Handle simple ASCII characters.
|
||
*/
|
||
|
||
if (*p != '<') {
|
||
char string[2];
|
||
|
||
patPtr->eventType = KeyPress;
|
||
eventMask = KeyPressMask;
|
||
string[0] = *p;
|
||
string[1] = 0;
|
||
patPtr->detail.keySym = TkStringToKeysym(string);
|
||
if (patPtr->detail.keySym == NoSymbol) {
|
||
if (isprint(UCHAR(*p))) {
|
||
patPtr->detail.keySym = *p;
|
||
} else {
|
||
sprintf(interp->result,
|
||
"bad ASCII character 0x%x", (unsigned char) *p);
|
||
return 0;
|
||
}
|
||
}
|
||
p++;
|
||
goto end;
|
||
}
|
||
|
||
/*
|
||
* A fancier event description. This can be either a virtual event
|
||
* or a physical event.
|
||
*
|
||
* A virtual event description consists of:
|
||
*
|
||
* 1. double open angle brackets.
|
||
* 2. virtual event name.
|
||
* 3. double close angle brackets.
|
||
*
|
||
* A physical event description consists of:
|
||
*
|
||
* 1. open angle bracket.
|
||
* 2. any number of modifiers, each followed by spaces
|
||
* or dashes.
|
||
* 3. an optional event name.
|
||
* 4. an option button or keysym name. Either this or
|
||
* item 3 *must* be present; if both are present
|
||
* then they are separated by spaces or dashes.
|
||
* 5. a close angle bracket.
|
||
*/
|
||
|
||
p++;
|
||
if (*p == '<') {
|
||
/*
|
||
* This is a virtual event: soak up all the characters up to
|
||
* the next '>'.
|
||
*/
|
||
|
||
char *field = p + 1;
|
||
p = strchr(field, '>');
|
||
if (p == field) {
|
||
interp->result = "virtual event \"<<>>\" is badly formed";
|
||
return 0;
|
||
}
|
||
if ((p == NULL) || (p[1] != '>')) {
|
||
interp->result = "missing \">\" in virtual binding";
|
||
return 0;
|
||
}
|
||
*p = '\0';
|
||
patPtr->eventType = VirtualEvent;
|
||
eventMask = VirtualEventMask;
|
||
patPtr->detail.name = Tk_GetUid(field);
|
||
*p = '>';
|
||
|
||
p += 2;
|
||
goto end;
|
||
}
|
||
|
||
while (1) {
|
||
ModInfo *modPtr;
|
||
p = GetField(p, field, FIELD_SIZE);
|
||
if (*p == '>') {
|
||
/*
|
||
* This solves the problem of, e.g., <Control-M> being
|
||
* misinterpreted as Control + Meta + missing keysym
|
||
* instead of Control + KeyPress + M.
|
||
*/
|
||
break;
|
||
}
|
||
hPtr = Tcl_FindHashEntry(&modTable, field);
|
||
if (hPtr == NULL) {
|
||
break;
|
||
}
|
||
modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
|
||
patPtr->needMods |= modPtr->mask;
|
||
if (modPtr->flags & (DOUBLE|TRIPLE)) {
|
||
if (modPtr->flags & DOUBLE) {
|
||
count = 2;
|
||
} else {
|
||
count = 3;
|
||
}
|
||
}
|
||
while ((*p == '-') || isspace(UCHAR(*p))) {
|
||
p++;
|
||
}
|
||
}
|
||
|
||
eventFlags = 0;
|
||
hPtr = Tcl_FindHashEntry(&eventTable, field);
|
||
if (hPtr != NULL) {
|
||
EventInfo *eiPtr;
|
||
eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
|
||
|
||
patPtr->eventType = eiPtr->type;
|
||
eventFlags = flagArray[eiPtr->type];
|
||
eventMask = eiPtr->eventMask;
|
||
while ((*p == '-') || isspace(UCHAR(*p))) {
|
||
p++;
|
||
}
|
||
p = GetField(p, field, FIELD_SIZE);
|
||
}
|
||
if (*field != '\0') {
|
||
if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
|
||
if (eventFlags == 0) {
|
||
patPtr->eventType = ButtonPress;
|
||
eventMask = ButtonPressMask;
|
||
} else if (eventFlags & KEY) {
|
||
goto getKeysym;
|
||
} else if ((eventFlags & BUTTON) == 0) {
|
||
Tcl_AppendResult(interp, "specified button \"", field,
|
||
"\" for non-button event", (char *) NULL);
|
||
return 0;
|
||
}
|
||
patPtr->detail.button = (*field - '0');
|
||
} else {
|
||
getKeysym:
|
||
patPtr->detail.keySym = TkStringToKeysym(field);
|
||
if (patPtr->detail.keySym == NoSymbol) {
|
||
Tcl_AppendResult(interp, "bad event type or keysym \"",
|
||
field, "\"", (char *) NULL);
|
||
return 0;
|
||
}
|
||
if (eventFlags == 0) {
|
||
patPtr->eventType = KeyPress;
|
||
eventMask = KeyPressMask;
|
||
} else if ((eventFlags & KEY) == 0) {
|
||
Tcl_AppendResult(interp, "specified keysym \"", field,
|
||
"\" for non-key event", (char *) NULL);
|
||
return 0;
|
||
}
|
||
}
|
||
} else if (eventFlags == 0) {
|
||
interp->result = "no event type or button # or keysym";
|
||
return 0;
|
||
}
|
||
|
||
while ((*p == '-') || isspace(UCHAR(*p))) {
|
||
p++;
|
||
}
|
||
if (*p != '>') {
|
||
while (*p != '\0') {
|
||
p++;
|
||
if (*p == '>') {
|
||
interp->result = "extra characters after detail in binding";
|
||
return 0;
|
||
}
|
||
}
|
||
interp->result = "missing \">\" in binding";
|
||
return 0;
|
||
}
|
||
p++;
|
||
|
||
end:
|
||
*eventStringPtr = p;
|
||
*eventMaskPtr |= eventMask;
|
||
return count;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* GetField --
|
||
*
|
||
* Used to parse pattern descriptions. Copies up to
|
||
* size characters from p to copy, stopping at end of
|
||
* string, space, "-", ">", or whenever size is
|
||
* exceeded.
|
||
*
|
||
* Results:
|
||
* The return value is a pointer to the character just
|
||
* after the last one copied (usually "-" or space or
|
||
* ">", but could be anything if size was exceeded).
|
||
* Also places NULL-terminated string (up to size
|
||
* character, including NULL), at copy.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static char *
|
||
GetField(p, copy, size)
|
||
char *p; /* Pointer to part of pattern. */
|
||
char *copy; /* Place to copy field. */
|
||
int size; /* Maximum number of characters to
|
||
* copy. */
|
||
{
|
||
while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
|
||
&& (*p != '-') && (size > 1)) {
|
||
*copy = *p;
|
||
p++;
|
||
copy++;
|
||
size--;
|
||
}
|
||
*copy = '\0';
|
||
return p;
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* GetPatternString --
|
||
*
|
||
* Produce a string version of the given event, for displaying to
|
||
* the user.
|
||
*
|
||
* Results:
|
||
* The string is left in dsPtr.
|
||
*
|
||
* Side effects:
|
||
* It is the caller's responsibility to initialize the DString before
|
||
* and to free it after calling this procedure.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
static void
|
||
GetPatternString(psPtr, dsPtr)
|
||
PatSeq *psPtr;
|
||
Tcl_DString *dsPtr;
|
||
{
|
||
Pattern *patPtr;
|
||
char c, buffer[10];
|
||
int patsLeft, needMods;
|
||
ModInfo *modPtr;
|
||
EventInfo *eiPtr;
|
||
|
||
/*
|
||
* The order of the patterns in the sequence is backwards from the order
|
||
* in which they must be output.
|
||
*/
|
||
|
||
for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
|
||
patsLeft > 0; patsLeft--, patPtr--) {
|
||
|
||
/*
|
||
* Check for simple case of an ASCII character.
|
||
*/
|
||
|
||
if ((patPtr->eventType == KeyPress)
|
||
&& ((psPtr->flags & PAT_NEARBY) == 0)
|
||
&& (patPtr->needMods == 0)
|
||
&& (patPtr->detail.keySym < 128)
|
||
&& isprint(UCHAR(patPtr->detail.keySym))
|
||
&& (patPtr->detail.keySym != '<')
|
||
&& (patPtr->detail.keySym != ' ')) {
|
||
|
||
c = (char) patPtr->detail.keySym;
|
||
Tcl_DStringAppend(dsPtr, &c, 1);
|
||
continue;
|
||
}
|
||
|
||
/*
|
||
* Check for virtual event.
|
||
*/
|
||
|
||
if (patPtr->eventType == VirtualEvent) {
|
||
#ifdef SCM_CODE
|
||
Tcl_DStringAppend(dsPtr, "\"<<", 3);
|
||
#else
|
||
Tcl_DStringAppend(dsPtr, "<<", 2);
|
||
#endif
|
||
Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
|
||
#ifdef SCM_CODE
|
||
Tcl_DStringAppend(dsPtr, ">>\"", 3);
|
||
#else
|
||
Tcl_DStringAppend(dsPtr, ">>", 2);
|
||
#endif
|
||
continue;
|
||
}
|
||
|
||
/*
|
||
* It's a more general event specification. First check
|
||
* for "Double" or "Triple", then modifiers, then event type,
|
||
* then keysym or button detail.
|
||
*/
|
||
|
||
#ifdef SCM_CODE
|
||
Tcl_DStringAppend(dsPtr, "\"<", 2);
|
||
#else
|
||
Tcl_DStringAppend(dsPtr, "<", 1);
|
||
#endif
|
||
if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
|
||
&& (memcmp((char *) patPtr, (char *) (patPtr-1),
|
||
sizeof(Pattern)) == 0)) {
|
||
patsLeft--;
|
||
patPtr--;
|
||
if ((patsLeft > 1) && (memcmp((char *) patPtr,
|
||
(char *) (patPtr-1), sizeof(Pattern)) == 0)) {
|
||
patsLeft--;
|
||
patPtr--;
|
||
Tcl_DStringAppend(dsPtr, "Triple-", 7);
|
||
} else {
|
||
Tcl_DStringAppend(dsPtr, "Double-", 7);
|
||
}
|
||
}
|
||
for (needMods = patPtr->needMods, modPtr = modArray;
|
||
needMods != 0; modPtr++) {
|
||
if (modPtr->mask & needMods) {
|
||
needMods &= ~modPtr->mask;
|
||
Tcl_DStringAppend(dsPtr, modPtr->name, -1);
|
||
Tcl_DStringAppend(dsPtr, "-", 1);
|
||
}
|
||
}
|
||
for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
|
||
if (eiPtr->type == patPtr->eventType) {
|
||
Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
|
||
if (patPtr->detail.clientData != 0) {
|
||
Tcl_DStringAppend(dsPtr, "-", 1);
|
||
}
|
||
break;
|
||
}
|
||
}
|
||
|
||
if (patPtr->detail.clientData != 0) {
|
||
if ((patPtr->eventType == KeyPress)
|
||
|| (patPtr->eventType == KeyRelease)) {
|
||
char *string;
|
||
|
||
string = TkKeysymToString(patPtr->detail.keySym);
|
||
if (string != NULL) {
|
||
Tcl_DStringAppend(dsPtr, string, -1);
|
||
}
|
||
} else {
|
||
sprintf(buffer, "%d", patPtr->detail.button);
|
||
Tcl_DStringAppend(dsPtr, buffer, -1);
|
||
}
|
||
}
|
||
#ifdef SCM_CODE
|
||
Tcl_DStringAppend(dsPtr, ">\"", 2);
|
||
#else
|
||
Tcl_DStringAppend(dsPtr, ">", 1);
|
||
#endif
|
||
}
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* GetKeySym --
|
||
*
|
||
* Given an X KeyPress or KeyRelease event, map the
|
||
* keycode in the event into a KeySym.
|
||
*
|
||
* Results:
|
||
* The return value is the KeySym corresponding to
|
||
* eventPtr, or NoSymbol if no matching Keysym could be
|
||
* found.
|
||
*
|
||
* Side effects:
|
||
* In the first call for a given display, keycode-to-
|
||
* KeySym maps get loaded.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static KeySym
|
||
GetKeySym(dispPtr, eventPtr)
|
||
TkDisplay *dispPtr; /* Display in which to
|
||
* map keycode. */
|
||
XEvent *eventPtr; /* Description of X event. */
|
||
{
|
||
KeySym sym;
|
||
int index;
|
||
|
||
/*
|
||
* Refresh the mapping information if it's stale
|
||
*/
|
||
|
||
if (dispPtr->bindInfoStale) {
|
||
InitKeymapInfo(dispPtr);
|
||
}
|
||
|
||
/*
|
||
* Figure out which of the four slots in the keymap vector to
|
||
* use for this key. Refer to Xlib documentation for more info
|
||
* on how this computation works.
|
||
*/
|
||
|
||
index = 0;
|
||
if (eventPtr->xkey.state & dispPtr->modeModMask) {
|
||
index = 2;
|
||
}
|
||
if ((eventPtr->xkey.state & ShiftMask)
|
||
|| ((dispPtr->lockUsage != LU_IGNORE)
|
||
&& (eventPtr->xkey.state & LockMask))) {
|
||
index += 1;
|
||
}
|
||
sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
|
||
|
||
/*
|
||
* Special handling: if the key was shifted because of Lock, but
|
||
* lock is only caps lock, not shift lock, and the shifted keysym
|
||
* isn't upper-case alphabetic, then switch back to the unshifted
|
||
* keysym.
|
||
*/
|
||
|
||
if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
|
||
&& (dispPtr->lockUsage == LU_CAPS)) {
|
||
if (!(((sym >= XK_A) && (sym <= XK_Z))
|
||
|| ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
|
||
|| ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
|
||
index &= ~1;
|
||
sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
|
||
index);
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Another bit of special handling: if this is a shifted key and there
|
||
* is no keysym defined, then use the keysym for the unshifted key.
|
||
*/
|
||
|
||
if ((index & 1) && (sym == NoSymbol)) {
|
||
sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
|
||
index & ~1);
|
||
}
|
||
return sym;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* InitKeymapInfo --
|
||
*
|
||
* This procedure is invoked to scan keymap information
|
||
* to recompute stuff that's important for binding, such
|
||
* as the modifier key (if any) that corresponds to "mode
|
||
* switch".
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Keymap-related information in dispPtr is updated.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
InitKeymapInfo(dispPtr)
|
||
TkDisplay *dispPtr; /* Display for which to recompute keymap
|
||
* information. */
|
||
{
|
||
XModifierKeymap *modMapPtr;
|
||
KeyCode *codePtr;
|
||
KeySym keysym;
|
||
int count, i, j, max, arraySize;
|
||
#define KEYCODE_ARRAY_SIZE 20
|
||
|
||
dispPtr->bindInfoStale = 0;
|
||
modMapPtr = XGetModifierMapping(dispPtr->display);
|
||
|
||
/*
|
||
* Check the keycodes associated with the Lock modifier. If
|
||
* any of them is associated with the XK_Shift_Lock modifier,
|
||
* then Lock has to be interpreted as Shift Lock, not Caps Lock.
|
||
*/
|
||
|
||
dispPtr->lockUsage = LU_IGNORE;
|
||
codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
|
||
for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
|
||
if (*codePtr == 0) {
|
||
continue;
|
||
}
|
||
keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
|
||
if (keysym == XK_Shift_Lock) {
|
||
dispPtr->lockUsage = LU_SHIFT;
|
||
break;
|
||
}
|
||
if (keysym == XK_Caps_Lock) {
|
||
dispPtr->lockUsage = LU_CAPS;
|
||
break;
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Look through the keycodes associated with modifiers to see if
|
||
* the the "mode switch", "meta", or "alt" keysyms are associated
|
||
* with any modifiers. If so, remember their modifier mask bits.
|
||
*/
|
||
|
||
dispPtr->modeModMask = 0;
|
||
dispPtr->metaModMask = 0;
|
||
dispPtr->altModMask = 0;
|
||
codePtr = modMapPtr->modifiermap;
|
||
max = 8*modMapPtr->max_keypermod;
|
||
for (i = 0; i < max; i++, codePtr++) {
|
||
if (*codePtr == 0) {
|
||
continue;
|
||
}
|
||
keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
|
||
if (keysym == XK_Mode_switch) {
|
||
dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
|
||
}
|
||
if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
|
||
dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
|
||
}
|
||
if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
|
||
dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Create an array of the keycodes for all modifier keys.
|
||
*/
|
||
|
||
if (dispPtr->modKeyCodes != NULL) {
|
||
ckfree((char *) dispPtr->modKeyCodes);
|
||
}
|
||
dispPtr->numModKeyCodes = 0;
|
||
arraySize = KEYCODE_ARRAY_SIZE;
|
||
dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
|
||
(KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
|
||
for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
|
||
if (*codePtr == 0) {
|
||
continue;
|
||
}
|
||
|
||
/*
|
||
* Make sure that the keycode isn't already in the array.
|
||
*/
|
||
|
||
for (j = 0; j < dispPtr->numModKeyCodes; j++) {
|
||
if (dispPtr->modKeyCodes[j] == *codePtr) {
|
||
goto nextModCode;
|
||
}
|
||
}
|
||
if (dispPtr->numModKeyCodes >= arraySize) {
|
||
KeyCode *new;
|
||
|
||
/*
|
||
* Ran out of space in the array; grow it.
|
||
*/
|
||
|
||
arraySize *= 2;
|
||
new = (KeyCode *) ckalloc((unsigned)
|
||
(arraySize * sizeof(KeyCode)));
|
||
memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
|
||
(dispPtr->numModKeyCodes * sizeof(KeyCode)));
|
||
ckfree((char *) dispPtr->modKeyCodes);
|
||
dispPtr->modKeyCodes = new;
|
||
}
|
||
dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
|
||
dispPtr->numModKeyCodes++;
|
||
nextModCode: continue;
|
||
}
|
||
XFreeModifiermap(modMapPtr);
|
||
}
|
||
|
||
/*
|
||
*---------------------------------------------------------------------------
|
||
*
|
||
* EvalTclBinding --
|
||
*
|
||
* The procedure that is invoked by Tk_BindEvent when a Tcl binding
|
||
* is fired.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result code, the result of globally evaluating the
|
||
* percent-substitued binding string.
|
||
*
|
||
* Side effects:
|
||
* Normal side effects due to eval.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
FreeTclBinding(clientData)
|
||
ClientData clientData;
|
||
{
|
||
#ifdef SCM_CODE
|
||
# ifdef STk_CODE
|
||
STk_delete_callback((char*) clientData);
|
||
# else
|
||
SCM_delete_callback((char*) clientData);
|
||
# endif
|
||
#endif
|
||
ckfree((char *) clientData);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TkStringToKeysym --
|
||
*
|
||
* This procedure finds the keysym associated with a given keysym
|
||
* name.
|
||
*
|
||
* Results:
|
||
* The return value is the keysym that corresponds to name, or
|
||
* NoSymbol if there is no such keysym.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
KeySym
|
||
TkStringToKeysym(name)
|
||
char *name; /* Name of a keysym. */
|
||
{
|
||
#ifdef REDO_KEYSYM_LOOKUP
|
||
Tcl_HashEntry *hPtr;
|
||
KeySym keysym;
|
||
|
||
hPtr = Tcl_FindHashEntry(&keySymTable, name);
|
||
if (hPtr != NULL) {
|
||
return (KeySym) Tcl_GetHashValue(hPtr);
|
||
}
|
||
if (strlen(name) == 1) {
|
||
keysym = (KeySym) (unsigned char) name[0];
|
||
if (TkKeysymToString(keysym) != NULL) {
|
||
return keysym;
|
||
}
|
||
}
|
||
#endif /* REDO_KEYSYM_LOOKUP */
|
||
return XStringToKeysym(name);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TkKeysymToString --
|
||
*
|
||
* This procedure finds the keysym name associated with a given
|
||
* keysym.
|
||
*
|
||
* Results:
|
||
* The return value is a pointer to a static string containing
|
||
* the name of the given keysym, or NULL if there is no known name.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
char *
|
||
TkKeysymToString(keysym)
|
||
KeySym keysym;
|
||
{
|
||
#ifdef REDO_KEYSYM_LOOKUP
|
||
Tcl_HashEntry *hPtr;
|
||
|
||
hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
|
||
if (hPtr != NULL) {
|
||
return (char *) Tcl_GetHashValue(hPtr);
|
||
}
|
||
#endif /* REDO_KEYSYM_LOOKUP */
|
||
return XKeysymToString(keysym);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* TkCopyAndGlobalEval --
|
||
*
|
||
* This procedure makes a copy of a script then calls Tcl_GlobalEval
|
||
* to evaluate it. It's used in situations where the execution of
|
||
* a command may cause the original command string to be reallocated.
|
||
*
|
||
* Results:
|
||
* Returns the result of evaluating script, including both a standard
|
||
* Tcl completion code and a string in interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
TkCopyAndGlobalEval(interp, script)
|
||
Tcl_Interp *interp; /* Interpreter in which to evaluate
|
||
* script. */
|
||
char *script; /* Script to evaluate. */
|
||
{
|
||
#ifdef BGLK_CODE
|
||
return Tcl_GlobalEval(interp, script);
|
||
#else
|
||
Tcl_DString buffer;
|
||
int code;
|
||
|
||
Tcl_DStringInit(&buffer);
|
||
Tcl_DStringAppend(&buffer, script, -1);
|
||
code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer));
|
||
Tcl_DStringFree(&buffer);
|
||
return code;
|
||
#endif
|
||
}
|