tcl.git - Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.

diff options

author	dkf <donal.k.fellows@manchester.ac.uk>	2012-03-08 09:55:39 (GMT)
committer	dkf <donal.k.fellows@manchester.ac.uk>	2012-03-08 09:55:39 (GMT)
commit	64997e6db9c283aeaa383cf901d7f45949cd0c24 (patch)
tree	cf75c844e0b6c3f6f04117e38753b3996a1b139b /doc/info.n
parent	4b85ca90cba7edb9a10caead17ffa8d407e1e2b3 (diff)
download	tcl-64997e6db9c283aeaa383cf901d7f45949cd0c24.zip tcl-64997e6db9c283aeaa383cf901d7f45949cd0c24.tar.gz tcl-64997e6db9c283aeaa383cf901d7f45949cd0c24.tar.bz2

Various minor fixes (prompted by Andreas Kupries detecting a spelling mistake).

Diffstat (limited to 'doc/info.n')

-rw-r--r--

doc/info.n

1 files changed, 38 insertions, 32 deletions

/* * tkBind.c -- * * This file provides procedures that associate Tcl commands * with X events or sequences of X events. * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tkBind.c,v 1.27 2002/08/31 06:12:20 das Exp $ */ #include "tkPort.h" #include "tkInt.h" #ifdef __WIN32__ #include "tkWinInt.h" #endif #if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* UNIX */ #include "tkUnixInt.h" #endif /* * File structure: * * Structure definitions and static variables. * * Init/Free this package. * * Tcl "bind" command (actually located in tkCmds.c). * "bind" command implementation. * "bind" implementation helpers. * * Tcl "event" command. * "event" command implementation. * "event" implementation helpers. * * Package-specific common helpers. * * Non-package-specific helpers. */ /* * The following union is used to hold the detail information from an * XEvent (including Tk's XVirtualEvent extension). */ typedef union { KeySym keySym; /* KeySym that corresponds to xkey.keycode. */ int button; /* Button that was pressed (xbutton.button). */ Tk_Uid name; /* Tk_Uid of virtual event. */ ClientData clientData; /* Used when type of Detail is unknown, and to * ensure that all bytes of Detail are initialized * when this structure is used in a hash key. */ } Detail; /* * The structure below represents a binding table. A binding table * represents a domain in which event bindings may occur. It includes * a space of objects relative to which events occur (usually windows, * but not always), a history of recent events in the domain, and * a set of mappings that associate particular Tcl commands with sequences * of events in the domain. Multiple binding tables may exist at once, * either because there are multiple applications open, or because there * are multiple domains within an application with separate event * bindings for each (for example, each canvas widget has a separate * binding table for associating events with the items in the canvas). * * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much * below 30. To see this, consider a triple mouse button click while * the Shift key is down (and auto-repeating). There may be as many * as 3 auto-repeat events after each mouse button press or release * (see the first large comment block within Tk_BindEvent for more on * this), for a total of 20 events to cover the three button presses * and two intervening releases. If you reduce EVENT_BUFFER_SIZE too * much, shift multi-clicks will be lost. * */ #define EVENT_BUFFER_SIZE 30 typedef struct BindingTable { XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events * (higher indices are for more recent * events). */ Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym, * button, Tk_Uid, or 0) for each * entry in eventRing. */ int curEvent; /* Index in eventRing of most recent * event. Newer events have higher * indices. */ Tcl_HashTable patternTable; /* Used to map from an event to a * list of patterns that may match that * event. Keys are PatternTableKey * structs, values are (PatSeq *). */ Tcl_HashTable objectTable; /* Used to map from an object to a * list of patterns associated with * that object. Keys are ClientData, * values are (PatSeq *). */ Tcl_Interp *interp; /* Interpreter in which commands are * executed. */ } BindingTable; /* * The following structure represents virtual event table. A virtual event * table provides a way to map from platform-specific physical events such * as button clicks or key presses to virtual events such as <<Paste>>, * <<Close>>, or <<ScrollWindow>>. * * A virtual event is usually never part of the event stream, but instead is * synthesized inline by matching low-level events. However, a virtual * event may be generated by platform-specific code or by Tcl scripts. In * that case, no lookup of the virtual event will need to be done using * this table, because the virtual event is actually in the event stream. */ typedef struct VirtualEventTable { Tcl_HashTable patternTable; /* Used to map from a physical event to * a list of patterns that may match that * event. Keys are PatternTableKey * structs, values are (PatSeq *). */ Tcl_HashTable nameTable; /* Used to map a virtual event name to * the array of physical events that can * trigger it. Keys are the Tk_Uid names * of the virtual events, values are * PhysicalsOwned structs. */ } VirtualEventTable; /* * The following structure is used as a key in a patternTable for both * binding tables and a virtual event tables. * * In a binding table, the object field corresponds to the binding tag * for the widget whose bindings are being accessed. * * In a virtual event table, the object field is always NULL. Virtual * events are a global definiton and are not tied to a particular * binding tag. * * The same key is used for both types of pattern tables so that the * helper functions that traverse and match patterns will work for both * binding tables and virtual event tables. */ typedef struct PatternTableKey { ClientData object; /* For binding table, identifies the binding * tag of the object (or class of objects) * relative to which the event occurred. * For virtual event table, always NULL. */ int type; /* Type of event (from X). */ Detail detail; /* Additional information, such as keysym, * button, Tk_Uid, or 0 if nothing * additional. */ } PatternTableKey; /* * The following structure defines a pattern, which is matched against X * events as part of the process of converting X events into Tcl commands. */ typedef struct Pattern { int eventType; /* Type of X event, e.g. ButtonPress. */ int needMods; /* Mask of modifiers that must be * present (0 means no modifiers are * required). */ Detail detail; /* Additional information that must * match event. Normally this is 0, * meaning no additional information * must match. For KeyPress and * KeyRelease events, a keySym may * be specified to select a * particular keystroke (0 means any * keystrokes). For button events, * specifies a particular button (0 * means any buttons are OK). For virtual * events, specifies the Tk_Uid of the * virtual event name (never 0). */ } Pattern; /* * The following structure defines a pattern sequence, which consists of one * or more patterns. In order to trigger, a pattern sequence must match * the most recent X events (first pattern to most recent event, next * pattern to next event, and so on). It is used as the hash value in a * patternTable for both binding tables and virtual event tables. * * In a binding table, it is the sequence of physical events that make up * a binding for an object. * * In a virtual event table, it is the sequence of physical events that * define a virtual event. * * The same structure is used for both types of pattern tables so that the * helper functions that traverse and match patterns will work for both * binding tables and virtual event tables. */ typedef struct PatSeq { int numPats; /* Number of patterns in sequence (usually * 1). */ TkBindEvalProc *eventProc; /* The procedure that will be invoked on * the clientData when this pattern sequence * matches. */ TkBindFreeProc *freeProc; /* The procedure that will be invoked to * release the clientData when this pattern * sequence is freed. */ ClientData clientData; /* Arbitray data passed to eventProc and * freeProc when sequence matches. */ int flags; /* Miscellaneous flag values; see below for * definitions. */ int refCount; /* Number of times that this binding is in * the midst of executing. If greater than 1, * then a recursive invocation is happening. * Only when this is zero can the binding * actually be freed. */ struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences * that have the same initial pattern. NULL * means end of list. */ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the * initial pattern. This is the head of the * list of which nextSeqPtr forms a part. */ struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a * virtual event table, identifies the array * of virtual events that can be triggered by * this event. */ struct PatSeq *nextObjPtr; /* In a binding table, next in list of all * pattern sequences for the same object (NULL * for end of list). Needed to implement * Tk_DeleteAllBindings. In a virtual event * table, always NULL. */ Pattern pats[1]; /* Array of "numPats" patterns. Only one * element is declared here but in actuality * enough space will be allocated for "numPats" * patterns. To match, pats[0] must match * event n, pats[1] must match event n-1, etc. */ } PatSeq; /* * Flag values for PatSeq structures: * * PAT_NEARBY 1 means that all of the events matching * this sequence must occur with nearby X * and Y mouse coordinates and close in time. * This is typically used to restrict multiple * button presses. * MARKED_DELETED 1 means that this binding has been marked as deleted * and removed from the binding table, but its memory * could not be released because it was already queued for * execution. When the binding is actually about to be * executed, this flag will be checked and the binding * skipped if set. */ #define PAT_NEARBY 0x1 #define MARKED_DELETED 0x2 /* * Constants that define how close together two events must be * in milliseconds or pixels to meet the PAT_NEARBY constraint: */ #define NEARBY_PIXELS 5 #define NEARBY_MS 500 /* * The following structure keeps track of all the virtual events that are * associated with a particular physical event. It is pointed to by the * voPtr field in a PatSeq in the patternTable of a virtual event table. */ typedef struct VirtualOwners { int numOwners; /* Number of virtual events to trigger. */ Tcl_HashEntry *owners[1]; /* Array of pointers to entries in * nameTable. Enough space will * actually be allocated for numOwners * hash entries. */ } VirtualOwners; /* * The following structure is used in the nameTable of a virtual event * table to associate a virtual event with all the physical events that can * trigger it. */ typedef struct PhysicalsOwned { int numOwned; /* Number of physical events owned. */ PatSeq *patSeqs[1]; /* Array of pointers to physical event * patterns. Enough space will actually * be allocated to hold numOwned. */ } PhysicalsOwned; /* * One of the following structures exists for each interpreter. This * structure keeps track of the current display and screen in the * interpreter, so that a script can be invoked whenever the display/screen * changes (the script does things like point tk::Priv at a display-specific * structure). */ typedef struct { TkDisplay *curDispPtr; /* Display for last binding command invoked * in this application. */ int curScreenIndex; /* Index of screen for last binding command. */ int bindingDepth; /* Number of active instances of Tk_BindEvent * in this application. */ } ScreenInfo; /* * The following structure is used to keep track of all the C bindings that * are awaiting invocation and whether the window they refer to has been * destroyed. If the window is destroyed, then all pending callbacks for * that window will be cancelled. The Tcl bindings will still all be * invoked, however. */ typedef struct PendingBinding { struct PendingBinding *nextPtr; /* Next in chain of pending bindings, in * case a recursive binding evaluation is in * progress. */ Tk_Window tkwin; /* The window that the following bindings * depend upon. */ int deleted; /* Set to non-zero by window cleanup code * if tkwin is deleted. */ PatSeq *matchArray[5]; /* Array of pending C bindings. The actual * size of this depends on how many C bindings * matched the event passed to Tk_BindEvent. * THIS FIELD MUST BE THE LAST IN THE * STRUCTURE. */ } PendingBinding; /* * The following structure keeps track of all the information local to * the binding package on a per interpreter basis. */ typedef struct BindInfo { VirtualEventTable virtualEventTable; /* The virtual events that exist in this * interpreter. */ ScreenInfo screenInfo; /* Keeps track of the current display and * screen, so it can be restored after * a binding has executed. */ PendingBinding *pendingList;/* The list of pending C bindings, kept in * case a C or Tcl binding causes the target * window to be deleted. */ int deleted; /* 1 the application has been deleted but * the structure has been preserved. */ } BindInfo; /* * In X11R4 and earlier versions, XStringToKeysym is ridiculously * slow. The data structure and hash table below, along with the * code that uses them, implement a fast mapping from strings to * keysyms. In X11R5 and later releases XStringToKeysym is plenty * fast so this stuff isn't needed. The #define REDO_KEYSYM_LOOKUP * is normally undefined, so that XStringToKeysym gets used. It * can be set in the Makefile to enable the use of the hash table * below. */ #ifdef REDO_KEYSYM_LOOKUP typedef struct { char *name; /* Name of keysym. */ KeySym value; /* Numeric identifier for keysym. */ } KeySymInfo; static KeySymInfo keyArray[] = { #ifndef lint #include "ks_names.h" #endif {(char *) NULL, 0} }; static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */ static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */ #endif /* REDO_KEYSYM_LOOKUP */ /* * Set to non-zero when the package-wide static variables have been * initialized. */ static int initialized = 0; TCL_DECLARE_MUTEX(bindMutex) /* * A hash table is kept to map from the string names of event * modifiers to information about those modifiers. The structure * for storing this information, and the hash table built at * initialization time, are defined below. */ typedef struct { char *name; /* Name of modifier. */ int mask; /* Button/modifier mask value, * such as Button1Mask. */ int flags; /* Various flags; see below for * definitions. */ } ModInfo; /* * Flags for ModInfo structures: * * DOUBLE - Non-zero means duplicate this event, * e.g. for double-clicks. * TRIPLE - Non-zero means triplicate this event, * e.g. for triple-clicks. * QUADRUPLE - Non-zero means quadruple this event, * e.g. for 4-fold-clicks. * MULT_CLICKS - Combination of all of above. */ #define DOUBLE 1 #define TRIPLE 2 #define QUADRUPLE 4 #define MULT_CLICKS 7 static ModInfo modArray[] = { {"Control", ControlMask, 0}, {"Shift", ShiftMask, 0}, {"Lock", LockMask, 0}, {"Meta", META_MASK, 0}, {"M", META_MASK, 0}, {"Alt", ALT_MASK, 0}, {"B1", Button1Mask, 0}, {"Button1", Button1Mask, 0}, {"B2", Button2Mask, 0}, {"Button2", Button2Mask, 0}, {"B3", Button3Mask, 0}, {"Button3", Button3Mask, 0}, {"B4", Button4Mask, 0}, {"Button4", Button4Mask, 0}, {"B5", Button5Mask, 0}, {"Button5", Button5Mask, 0}, {"Mod1", Mod1Mask, 0}, {"M1", Mod1Mask, 0}, {"Command", Mod1Mask, 0}, {"Mod2", Mod2Mask, 0}, {"M2", Mod2Mask, 0}, {"Option", Mod2Mask, 0}, {"Mod3", Mod3Mask, 0}, {"M3", Mod3Mask, 0}, {"Mod4", Mod4Mask, 0}, {"M4", Mod4Mask, 0}, {"Mod5", Mod5Mask, 0}, {"M5", Mod5Mask, 0}, {"Double", 0, DOUBLE}, {"Triple", 0, TRIPLE}, {"Quadruple", 0, QUADRUPLE}, {"Any", 0, 0}, /* Ignored: historical relic. */ {NULL, 0, 0} }; static Tcl_HashTable modTable; /* * This module also keeps a hash table mapping from event names * to information about those events. The structure, an array * to use to initialize the hash table, and the hash table are * all defined below. */ typedef struct { char *name; /* Name of event. */ int type; /* Event type for X, such as * ButtonPress. */ int eventMask; /* Mask bits (for XSelectInput) * for this event type. */ } EventInfo; /* * Note: some of the masks below are an OR-ed combination of * several masks. This is necessary because X doesn't report * up events unless you also ask for down events. Also, X * doesn't report button state in motion events unless you've * asked about button events. */ static EventInfo eventArray[] = { {"Key", KeyPress, KeyPressMask}, {"KeyPress", KeyPress, KeyPressMask}, {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask}, {"Button", ButtonPress, ButtonPressMask}, {"ButtonPress", ButtonPress, ButtonPressMask}, {"ButtonRelease", ButtonRelease, ButtonPressMask|ButtonReleaseMask}, {"Motion", MotionNotify, ButtonPressMask|PointerMotionMask}, {"Enter", EnterNotify, EnterWindowMask}, {"Leave", LeaveNotify, LeaveWindowMask}, {"FocusIn", FocusIn, FocusChangeMask}, {"FocusOut", FocusOut, FocusChangeMask}, {"Expose", Expose, ExposureMask}, {"Visibility", VisibilityNotify, VisibilityChangeMask}, {"Destroy", DestroyNotify, StructureNotifyMask}, {"Unmap", UnmapNotify, StructureNotifyMask}, {"Map", MapNotify, StructureNotifyMask}, {"Reparent", ReparentNotify, StructureNotifyMask}, {"Configure", ConfigureNotify, StructureNotifyMask}, {"Gravity", GravityNotify, StructureNotifyMask}, {"Circulate", CirculateNotify, StructureNotifyMask}, {"Property", PropertyNotify, PropertyChangeMask}, {"Colormap", ColormapNotify, ColormapChangeMask}, {"Activate", ActivateNotify, ActivateMask}, {"Deactivate", DeactivateNotify, ActivateMask}, {"MouseWheel", MouseWheelEvent, MouseWheelMask}, {"CirculateRequest", CirculateRequest, SubstructureRedirectMask}, {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask}, {"Create", CreateNotify, SubstructureNotifyMask}, {"MapRequest", MapRequest, SubstructureRedirectMask}, {"ResizeRequest", ResizeRequest, ResizeRedirectMask}, {(char *) NULL, 0, 0} }; static Tcl_HashTable eventTable; /* * The defines and table below are used to classify events into * various groups. The reason for this is that logically identical * fields (e.g. "state") appear at different places in different * types of events. The classification masks can be used to figure * out quickly where to extract information from events. */ #define KEY 0x1 #define BUTTON 0x2 #define MOTION 0x4 #define CROSSING 0x8 #define FOCUS 0x10 #define EXPOSE 0x20 #define VISIBILITY 0x40 #define CREATE 0x80 #define DESTROY 0x100 #define UNMAP 0x200 #define MAP 0x400 #define REPARENT 0x800 #define CONFIG 0x1000 #define GRAVITY 0x2000 #define CIRC 0x4000 #define PROP 0x8000 #define COLORMAP 0x10000 #define VIRTUAL 0x20000 #define ACTIVATE 0x40000 #define MAPREQ 0x80000 #define CONFIGREQ 0x100000 #define RESIZEREQ 0x200000 #define CIRCREQ 0x400000 #define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL) static int flagArray[TK_LASTEVENT] = { /* Not used */ 0, /* Not used */ 0, /* KeyPress */ KEY, /* KeyRelease */ KEY, /* ButtonPress */ BUTTON, /* ButtonRelease */ BUTTON, /* MotionNotify */ MOTION, /* EnterNotify */ CROSSING, /* LeaveNotify */ CROSSING, /* FocusIn */ FOCUS, /* FocusOut */ FOCUS, /* KeymapNotify */ 0, /* Expose */ EXPOSE, /* GraphicsExpose */ EXPOSE, /* NoExpose */ 0, /* VisibilityNotify */ VISIBILITY, /* CreateNotify */ CREATE, /* DestroyNotify */ DESTROY, /* UnmapNotify */ UNMAP, /* MapNotify */ MAP, /* MapRequest */ MAPREQ, /* ReparentNotify */ REPARENT, /* ConfigureNotify */ CONFIG, /* ConfigureRequest */ CONFIGREQ, /* GravityNotify */ GRAVITY, /* ResizeRequest */ RESIZEREQ, /* CirculateNotify */ CIRC, /* CirculateRequest */ 0, /* PropertyNotify */ PROP, /* SelectionClear */ 0, /* SelectionRequest */ 0, /* SelectionNotify */ 0, /* ColormapNotify */ COLORMAP, /* ClientMessage */ 0, /* MappingNotify */ 0, /* VirtualEvent */ VIRTUAL, /* Activate */ ACTIVATE, /* Deactivate */ ACTIVATE, /* MouseWheel */ KEY }; /* * The following table is used to map between the location where an * generated event should be queued and the string used to specify the * location. */ static TkStateMap queuePosition[] = { {-1, "now"}, {TCL_QUEUE_HEAD, "head"}, {TCL_QUEUE_MARK, "mark"}, {TCL_QUEUE_TAIL, "tail"}, {-2, NULL} }; /* * The following tables are used as a two-way map between X's internal * numeric values for fields in an XEvent and the strings used in Tcl. The * tables are used both when constructing an XEvent from user input and * when providing data from an XEvent to the user. */ static TkStateMap notifyMode[] = { {NotifyNormal, "NotifyNormal"}, {NotifyGrab, "NotifyGrab"}, {NotifyUngrab, "NotifyUngrab"}, {NotifyWhileGrabbed, "NotifyWhileGrabbed"}, {-1, NULL} }; static TkStateMap notifyDetail[] = { {NotifyAncestor, "NotifyAncestor"}, {NotifyVirtual, "NotifyVirtual"}, {NotifyInferior, "NotifyInferior"}, {NotifyNonlinear, "NotifyNonlinear"}, {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"}, {NotifyPointer, "NotifyPointer"}, {NotifyPointerRoot, "NotifyPointerRoot"}, {NotifyDetailNone, "NotifyDetailNone"}, {-1, NULL} }; static TkStateMap circPlace[] = { {PlaceOnTop, "PlaceOnTop"}, {PlaceOnBottom, "PlaceOnBottom"}, {-1, NULL} }; static TkStateMap visNotify[] = { {VisibilityUnobscured, "VisibilityUnobscured"}, {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"}, {VisibilityFullyObscured, "VisibilityFullyObscured"}, {-1, NULL} }; static TkStateMap configureRequestDetail[] = { {None, "None"}, {Above, "Above"}, {Below, "Below"}, {BottomIf, "BottomIf"}, {TopIf, "TopIf"}, {Opposite, "Opposite"}, {-1, NULL} }; static TkStateMap propNotify[] = { {PropertyNewValue, "NewValue"}, {PropertyDelete, "Delete"}, {-1, NULL} }; /* * Prototypes for local procedures defined in this file: */ static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp, char *dispName, int screenIndex)); static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp, VirtualEventTable *vetPtr, char *virtString, char *eventString)); static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp, VirtualEventTable *vetPtr, char *virtString, char *eventString)); static void DeleteVirtualEventTable _ANSI_ARGS_(( VirtualEventTable *vetPtr)); static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr, CONST char *before, XEvent *eventPtr, KeySym keySym, Tcl_DString *dsPtr)); static void FreeTclBinding _ANSI_ARGS_((ClientData clientData)); static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp, Tcl_HashTable *patternTablePtr, ClientData object, CONST char *eventString, int create, int allowVirtual, unsigned long *maskPtr)); static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp, VirtualEventTable *vetPtr)); static char * GetField _ANSI_ARGS_((char *p, char *copy, int size)); static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr, Tcl_DString *dsPtr)); static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp, VirtualEventTable *vetPtr, char *virtString)); static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp, char *virtString)); static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window main, int objc, Tcl_Obj *CONST objv[])); static void InitVirtualEventTable _ANSI_ARGS_(( VirtualEventTable *vetPtr)); static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr, BindingTable *bindPtr, PatSeq *psPtr, PatSeq *bestPtr, ClientData *objectPtr, PatSeq **sourcePtrPtr)); static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp, Tk_Window main, Tcl_Obj *objPtr, Tk_Window *tkwinPtr)); static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp, CONST char **eventStringPtr, Pattern *patPtr, unsigned long *eventMaskPtr)); static void DoWarp _ANSI_ARGS_((ClientData clientData)); /* * The following define is used as a short circuit for the callback * procedure to evaluate a TclBinding. The actual evaluation of the * binding is handled inline, because special things have to be done * with a Tcl binding before evaluation time. */ #define EvalTclBinding ((TkBindEvalProc *) 1) /* *--------------------------------------------------------------------------- * * TkBindInit -- * * This procedure is called when an application is created. It * initializes all the structures used by bindings and virtual * events. It must be called before any other functions in this * file are called. * * Results: * None. * * Side effects: * Memory allocated. * *--------------------------------------------------------------------------- */ void TkBindInit(mainPtr) TkMainInfo *mainPtr; /* The newly created application. */ { BindInfo *bindInfoPtr; if (sizeof(XEvent) < sizeof(XVirtualEvent)) { panic("TkBindInit: virtual events can't be supported"); } /* * Initialize the static data structures used by the binding package. * They are only initialized once, no matter how many interps are * created. */ if (!initialized) { Tcl_MutexLock(&bindMutex); if (!initialized) { Tcl_HashEntry *hPtr; ModInfo *modPtr; EventInfo *eiPtr; int 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; } Tcl_MutexUnlock(&bindMutex); } mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp); bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo)); InitVirtualEventTable(&bindInfoPtr->virtualEventTable); bindInfoPtr->screenInfo.curDispPtr = NULL; bindInfoPtr->screenInfo.curScreenIndex = -1; bindInfoPtr->screenInfo.bindingDepth = 0; bindInfoPtr->pendingList = NULL; bindInfoPtr->deleted = 0; mainPtr->bindInfo = (TkBindInfo) bindInfoPtr; TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable); } /* *--------------------------------------------------------------------------- * * TkBindFree -- * * This procedure is called when an application is deleted. It * deletes all the structures used by bindings and virtual events. * * Results: * None. * * Side effects: * Memory freed. * *--------------------------------------------------------------------------- */ void TkBindFree(mainPtr) TkMainInfo *mainPtr; /* The newly created application. */ { BindInfo *bindInfoPtr; Tk_DeleteBindingTable(mainPtr->bindingTable); mainPtr->bindingTable = NULL; bindInfoPtr = (BindInfo *) mainPtr->bindInfo; DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable); bindInfoPtr->deleted = 1; Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC); mainPtr->bindInfo = NULL; } /* *-------------------------------------------------------------- * * Tk_CreateBindingTable -- * * Set up a new domain in which event bindings may be created. * * Results: * The return value is a token for the new table, which must * be passed to procedures like Tk_CreateBinding. * * Side effects: * Memory is allocated for the new table. * *-------------------------------------------------------------- */ Tk_BindingTable Tk_CreateBindingTable(interp) Tcl_Interp *interp; /* Interpreter to associate with the binding * table: commands are executed in this * interpreter. */ { BindingTable *bindPtr; int i; /* * Create and initialize a new binding table. */ bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable)); for (i = 0; i < EVENT_BUFFER_SIZE; i++) { bindPtr->eventRing[i].type = -1; } bindPtr->curEvent = 0; Tcl_InitHashTable(&bindPtr->patternTable, sizeof(PatternTableKey)/sizeof(int)); Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS); bindPtr->interp = interp; return (Tk_BindingTable) bindPtr; } /* *-------------------------------------------------------------- * * Tk_DeleteBindingTable -- * * Destroy a binding table and free up all its memory. * The caller should not use bindingTable again after * this procedure returns. * * Results: * None. * * Side effects: * Memory is freed. * *-------------------------------------------------------------- */ void Tk_DeleteBindingTable(bindingTable) Tk_BindingTable bindingTable; /* Token for the binding table to * destroy. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr, *nextPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * Find and delete all of the patterns associated with the binding * table. */ for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) { nextPtr = psPtr->nextSeqPtr; psPtr->flags |= MARKED_DELETED; if (psPtr->refCount == 0) { if (psPtr->freeProc != NULL) { (*psPtr->freeProc)(psPtr->clientData); } ckfree((char *) psPtr); } } } /* * Clean up the rest of the information associated with the * binding table. */ Tcl_DeleteHashTable(&bindPtr->patternTable); Tcl_DeleteHashTable(&bindPtr->objectTable); ckfree((char *) bindPtr); } /* *-------------------------------------------------------------- * * Tk_CreateBinding -- * * Add a binding to a binding table, so that future calls to * Tk_BindEvent may execute the command in the binding. * * Results: * The return value is 0 if an error occurred while setting * up the binding. In this case, an error message will be * left in the interp's result. If all went well then the return * value is a mask of the event types that must be made * available to Tk_BindEvent in order to properly detect when * this binding triggers. This value can be used to determine * what events to select for in a window, for example. * * Side effects: * An existing binding on the same event sequence may be * replaced. * The new binding may cause future calls to Tk_BindEvent to * behave differently than they did previously. * *-------------------------------------------------------------- */ unsigned long Tk_CreateBinding(interp, bindingTable, object, eventString, command, append) Tcl_Interp *interp; /* Used for error reporting. */ Tk_BindingTable bindingTable; /* Table in which to create binding. */ ClientData object; /* Token for object with which binding is * associated. */ CONST char *eventString; /* String describing event sequence that * triggers binding. */ CONST char *command; /* Contains Tcl command to execute when * binding triggers. */ int append; /* 0 means replace any existing binding for * eventString; 1 means append to that * binding. If the existing binding is for a * callback function and not a Tcl command * string, the existing binding will always be * replaced. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; unsigned long eventMask; char *new, *old; psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, 1, 1, &eventMask); if (psPtr == NULL) { return 0; } if (psPtr->eventProc == NULL) { int new; Tcl_HashEntry *hPtr; /* * This pattern sequence was just created. * Link the pattern into the list associated with the object, so * that if the object goes away, these bindings will all * automatically be deleted. */ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new); if (new) { psPtr->nextObjPtr = NULL; } else { psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, psPtr); } else if (psPtr->eventProc != EvalTclBinding) { /* * Free existing procedural binding. */ if (psPtr->freeProc != NULL) { (*psPtr->freeProc)(psPtr->clientData); } psPtr->clientData = NULL; append = 0; } old = (char *) psPtr->clientData; if ((append != 0) && (old != NULL)) { int length; length = strlen(old) + strlen(command) + 2; new = (char *) ckalloc((unsigned) length); sprintf(new, "%s\n%s", old, command); } else { new = (char *) ckalloc((unsigned) strlen(command) + 1); strcpy(new, command); } if (old != NULL) { ckfree(old); } psPtr->eventProc = EvalTclBinding; psPtr->freeProc = FreeTclBinding; psPtr->clientData = (ClientData) new; return eventMask; } /* *--------------------------------------------------------------------------- * * TkCreateBindingProcedure -- * * Add a C binding to a binding table, so that future calls to * Tk_BindEvent may callback the procedure in the binding. * * Results: * The return value is 0 if an error occurred while setting * up the binding. In this case, an error message will be * left in the interp's result. If all went well then the return * value is a mask of the event types that must be made * available to Tk_BindEvent in order to properly detect when * this binding triggers. This value can be used to determine * what events to select for in a window, for example. * * Side effects: * Any existing binding on the same event sequence will be * replaced. * *--------------------------------------------------------------------------- */ unsigned long TkCreateBindingProcedure(interp, bindingTable, object, eventString, eventProc, freeProc, clientData) Tcl_Interp *interp; /* Used for error reporting. */ Tk_BindingTable bindingTable; /* Table in which to create binding. */ ClientData object; /* Token for object with which binding is * associated. */ CONST char *eventString; /* String describing event sequence that * triggers binding. */ TkBindEvalProc *eventProc; /* Procedure to invoke when binding * triggers. Must not be NULL. */ TkBindFreeProc *freeProc; /* Procedure to invoke when binding is * freed. May be NULL for no procedure. */ ClientData clientData; /* Arbitrary ClientData to pass to eventProc * and freeProc. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; unsigned long eventMask; psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, 1, 1, &eventMask); if (psPtr == NULL) { return 0; } if (psPtr->eventProc == NULL) { int new; Tcl_HashEntry *hPtr; /* * This pattern sequence was just created. * Link the pattern into the list associated with the object, so * that if the object goes away, these bindings will all * automatically be deleted. */ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new); if (new) { psPtr->nextObjPtr = NULL; } else { psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, psPtr); } else { /* * Free existing callback. */ if (psPtr->freeProc != NULL) { (*psPtr->freeProc)(psPtr->clientData); } } psPtr->eventProc = eventProc; psPtr->freeProc = freeProc; psPtr->clientData = clientData; return eventMask; } /* *-------------------------------------------------------------- * * Tk_DeleteBinding -- * * Remove an event binding from a binding table. * * Results: * The result is a standard Tcl return value. If an error * occurs then the interp's result will contain an error message. * * Side effects: * The binding given by object and eventString is removed * from bindingTable. * *-------------------------------------------------------------- */ int Tk_DeleteBinding(interp, bindingTable, object, eventString) Tcl_Interp *interp; /* Used for error reporting. */ Tk_BindingTable bindingTable; /* Table in which to delete binding. */ ClientData object; /* Token for object with which binding * is associated. */ CONST char *eventString; /* String describing event sequence * that triggers binding. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr, *prevPtr; unsigned long eventMask; Tcl_HashEntry *hPtr; psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, 0, 1, &eventMask); if (psPtr == NULL) { Tcl_ResetResult(interp); return TCL_OK; } /* * Unlink the binding from the list for its object, then from the * list for its pattern. */ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { panic("Tk_DeleteBinding couldn't find object table entry"); } prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr); if (prevPtr == psPtr) { Tcl_SetHashValue(hPtr, psPtr->nextObjPtr); } else { for ( ; ; prevPtr = prevPtr->nextObjPtr) { if (prevPtr == NULL) { panic("Tk_DeleteBinding couldn't find on object list"); } if (prevPtr->nextObjPtr == psPtr) { prevPtr->nextObjPtr = psPtr->nextObjPtr; break; } } } prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); if (prevPtr == psPtr) { if (psPtr->nextSeqPtr == NULL) { Tcl_DeleteHashEntry(psPtr->hPtr); } else { Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr); } } else { for ( ; ; prevPtr = prevPtr->nextSeqPtr) { if (prevPtr == NULL) { panic("Tk_DeleteBinding couldn't find on hash chain"); } if (prevPtr->nextSeqPtr == psPtr) { prevPtr->nextSeqPtr = psPtr->nextSeqPtr; break; } } } psPtr->flags |= MARKED_DELETED; if (psPtr->refCount == 0) { if (psPtr->freeProc != NULL) { (*psPtr->freeProc)(psPtr->clientData); } ckfree((char *) psPtr); } return TCL_OK; } /* *-------------------------------------------------------------- * * Tk_GetBinding -- * * Return the command associated with a given event string. * * Results: * The return value is a pointer to the command string * associated with eventString for object in the domain * given by bindingTable. If there is no binding for * eventString, or if eventString is improperly formed, * then NULL is returned and an error message is left in * the interp's result. The return value is semi-static: it * will persist until the binding is changed or deleted. * * Side effects: * None. * *-------------------------------------------------------------- */ CONST char * Tk_GetBinding(interp, bindingTable, object, eventString) Tcl_Interp *interp; /* Interpreter for error reporting. */ Tk_BindingTable bindingTable; /* Table in which to look for * binding. */ ClientData object; /* Token for object with which binding * is associated. */ CONST char *eventString; /* String describing event sequence * that triggers binding. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; unsigned long eventMask; psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, 0, 1, &eventMask); if (psPtr == NULL) { return NULL; } if (psPtr->eventProc == EvalTclBinding) { return (CONST char *) psPtr->clientData; } return ""; } /* *-------------------------------------------------------------- * * Tk_GetAllBindings -- * * Return a list of event strings for all the bindings * associated with a given object. * * Results: * There is no return value. The interp's result is modified to * hold a Tcl list with one entry for each binding associated * with object in bindingTable. Each entry in the list * contains the event string associated with one binding. * * Side effects: * None. * *-------------------------------------------------------------- */ void Tk_GetAllBindings(interp, bindingTable, object) Tcl_Interp *interp; /* Interpreter returning result or * error. */ Tk_BindingTable bindingTable; /* Table in which to look for * bindings. */ ClientData object; /* Token for object. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; Tcl_HashEntry *hPtr; Tcl_DString ds; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } Tcl_DStringInit(&ds); for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextObjPtr) { /* * For each binding, output information about each of the * patterns in its sequence. */ Tcl_DStringSetLength(&ds, 0); GetPatternString(psPtr, &ds); Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); } Tcl_DStringFree(&ds); } /* *-------------------------------------------------------------- * * Tk_DeleteAllBindings -- * * Remove all bindings associated with a given object in a * given binding table. * * Results: * All bindings associated with object are removed from * bindingTable. * * Side effects: * None. * *-------------------------------------------------------------- */ void Tk_DeleteAllBindings(bindingTable, object) Tk_BindingTable bindingTable; /* Table in which to delete * bindings. */ ClientData object; /* Token for object. */ { BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr, *prevPtr; PatSeq *nextPtr; Tcl_HashEntry *hPtr; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) { nextPtr = psPtr->nextObjPtr; /* * Be sure to remove each binding from its hash chain in the * pattern table. If this is the last pattern in the chain, * then delete the hash entry too. */ prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); if (prevPtr == psPtr) { if (psPtr->nextSeqPtr == NULL) { Tcl_DeleteHashEntry(psPtr->hPtr); } else { Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr); } } else { for ( ; ; prevPtr = prevPtr->nextSeqPtr) { if (prevPtr == NULL) { panic("Tk_DeleteAllBindings couldn't find on hash chain"); } if (prevPtr->nextSeqPtr == psPtr) { prevPtr->nextSeqPtr = psPtr->nextSeqPtr; break; } } } psPtr->flags |= MARKED_DELETED; if (psPtr->refCount == 0) { if (psPtr->freeProc != NULL) { (*psPtr->freeProc)(psPtr->clientData); } ckfree((char *) psPtr); } } Tcl_DeleteHashEntry(hPtr); } /* *--------------------------------------------------------------------------- * * Tk_BindEvent -- * * This procedure is invoked to process an X event. The * event is added to those recorded for the binding table. * Then each of the objects at *objectPtr is checked in * order to see if it has a binding that matches the recent * events. If so, the most specific binding is invoked for * each object. * * Results: * None. * * Side effects: * Depends on the command associated with the matching binding. * * All Tcl bindings scripts for each object are accumulated before * the first binding is evaluated. If the action of a Tcl binding * is to change or delete a binding, or delete the window associated * with the binding, all the original Tcl binding scripts will still * fire. Contrast this with C binding procedures. If a pending C * binding (one that hasn't fired yet, but is queued to be fired for * this window) is deleted, it will not be called, and if it is * changed, then the new binding procedure will be called. If the * window itself is deleted, no further C binding procedures will be * called for this window. When both Tcl binding scripts and C binding * procedures are interleaved, the above rules still apply. * *--------------------------------------------------------------------------- */ void Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr) Tk_BindingTable bindingTable; /* Table in which to look for * bindings. */ XEvent *eventPtr; /* What actually happened. */ Tk_Window tkwin; /* Window on display where event * occurred (needed in order to * locate display information). */ int numObjects; /* Number of objects at *objectPtr. */ ClientData *objectPtr; /* Array of one or more objects * to check for a matching binding. */ { BindingTable *bindPtr; TkDisplay *dispPtr; ScreenInfo *screenPtr; BindInfo *bindInfoPtr; TkDisplay *oldDispPtr; XEvent *ringPtr; PatSeq *vMatchDetailList, *vMatchNoDetailList; int flags, oldScreen, i, deferModal; unsigned int matchCount, matchSpace; Tcl_Interp *interp; Tcl_DString scripts, savedResult; Detail detail; char *p, *end; PendingBinding *pendingPtr; PendingBinding staticPending; TkWindow *winPtr = (TkWindow *)tkwin; PatternTableKey key; Tk_ClassModalProc *modalProc; /* * Ignore events on windows that don't have names: these are windows * like wrapper windows that shouldn't be visible to the * application. */ if (winPtr->pathName == NULL) { return; } /* * Ignore the event completely if it is an Enter, Leave, FocusIn, * or FocusOut event with detail NotifyInferior. The reason for * ignoring these events is that we don't want transitions between * a window and its children to visible to bindings on the parent: * this would cause problems for mega-widgets, since the internal * structure of a mega-widget isn't supposed to be visible to * people watching the parent. */ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) { if (eventPtr->xcrossing.detail == NotifyInferior) { return; } } if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) { if (eventPtr->xfocus.detail == NotifyInferior) { return; } } bindPtr = (BindingTable *) bindingTable; dispPtr = ((TkWindow *) tkwin)->dispPtr; bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo; /* * Add the new event to the ring of saved events for the * binding table. Two tricky points: * * 1. Combine consecutive MotionNotify events. Do this by putting * the new event *on top* of the previous event. * 2. If a modifier key is held down, it auto-repeats to generate * continuous KeyPress and KeyRelease events. These can flush * the event ring so that valuable information is lost (such * as repeated button clicks). To handle this, check for the * special case of a modifier KeyPress arriving when the previous * two events are a KeyRelease and KeyPress of the same key. * If this happens, mark the most recent event (the KeyRelease) * invalid and put the new event on top of the event before that * (the KeyPress). */ if ((eventPtr->type == MotionNotify) && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) { /* * Don't advance the ring pointer. */ } else if (eventPtr->type == KeyPress) { int i; for (i = 0; ; i++) { if (i >= dispPtr->numModKeyCodes) { goto advanceRingPointer; } if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) { break; } } ringPtr = &bindPtr->eventRing[bindPtr->curEvent]; if ((ringPtr->type != KeyRelease) || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) { goto advanceRingPointer; } if (bindPtr->curEvent <= 0) { i = EVENT_BUFFER_SIZE - 1; } else { i = bindPtr->curEvent - 1; } ringPtr = &bindPtr->eventRing[i]; if ((ringPtr->type != KeyPress) || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) { goto advanceRingPointer; } bindPtr->eventRing[bindPtr->curEvent].type = -1; bindPtr->curEvent = i; } else { advanceRingPointer: bindPtr->curEvent++; if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) { bindPtr->curEvent = 0; } } ringPtr = &bindPtr->eventRing[bindPtr->curEvent]; memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent)); detail.clientData = 0; flags = flagArray[ringPtr->type]; if (flags & KEY) { detail.keySym = TkpGetKeySym(dispPtr, ringPtr); if (detail.keySym == NoSymbol) { detail.keySym = 0; } } else if (flags & BUTTON) { detail.button = ringPtr->xbutton.button; } else if (flags & VIRTUAL) { detail.name = ((XVirtualEvent *) ringPtr)->name; } bindPtr->detailRing[bindPtr->curEvent] = detail; /* * Find out if there are any virtual events that correspond to this * physical event (or sequence of physical events). */ vMatchDetailList = NULL; vMatchNoDetailList = NULL; memset(&key, 0, sizeof(key)); if (ringPtr->type != VirtualEvent) { Tcl_HashTable *veptPtr; Tcl_HashEntry *hPtr; veptPtr = &bindInfoPtr->virtualEventTable.patternTable; key.object = NULL; key.type = ringPtr->type; key.detail = detail; hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key); if (hPtr != NULL) { vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr); } if (key.detail.clientData != 0) { key.detail.clientData = 0; hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key); if (hPtr != NULL) { vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr); } } } /* * Loop over all the binding tags, finding the binding script or * callback for each one. Append all of the binding scripts, with * %-sequences expanded, to "scripts", with null characters separating * the scripts for each object. Append all the callbacks to the array * of pending callbacks. */ pendingPtr = &staticPending; matchCount = 0; matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *); Tcl_DStringInit(&scripts); for ( ; numObjects > 0; numObjects--, objectPtr++) { PatSeq *matchPtr, *sourcePtr; Tcl_HashEntry *hPtr; matchPtr = NULL; sourcePtr = NULL; /* * Match the new event against those recorded in the pattern table, * saving the longest matching pattern. For events with details * (button and key events), look for a binding for the specific * key or button. First see if the event matches a physical event * that the object is interested in, then look for a virtual event. */ key.object = *objectPtr; key.type = ringPtr->type; key.detail = detail; hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr); } if (vMatchDetailList != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList, matchPtr, objectPtr, &sourcePtr); } /* * If no match was found, look for a binding for all keys or buttons * (detail of 0). Again, first match on a virtual event. */ if ((detail.clientData != 0) && (matchPtr == NULL)) { key.detail.clientData = 0; hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr); } if (vMatchNoDetailList != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList, matchPtr, objectPtr, &sourcePtr); } } if (matchPtr != NULL) { if (sourcePtr->eventProc == NULL) { panic("Tk_BindEvent: missing command"); } if (sourcePtr->eventProc == EvalTclBinding) { ExpandPercents(winPtr, (char *) sourcePtr->clientData, eventPtr, detail.keySym, &scripts); } else { if (matchCount >= matchSpace) { PendingBinding *new; unsigned int oldSize, newSize; oldSize = sizeof(staticPending) - sizeof(staticPending.matchArray) + matchSpace * sizeof(PatSeq*); matchSpace *= 2; newSize = sizeof(staticPending) - sizeof(staticPending.matchArray) + matchSpace * sizeof(PatSeq*); new = (PendingBinding *) ckalloc(newSize); memcpy((VOID *) new, (VOID *) pendingPtr, oldSize); if (pendingPtr != &staticPending) { ckfree((char *) pendingPtr); } pendingPtr = new; } sourcePtr->refCount++; pendingPtr->matchArray[matchCount] = sourcePtr; matchCount++; } /* * A "" is added to the scripts string to separate the * various scripts that should be invoked. */ Tcl_DStringAppend(&scripts, "", 1); } } if (Tcl_DStringLength(&scripts) == 0) { return; } /* * Now go back through and evaluate the binding for each object, * in order, dealing with "break" and "continue" exceptions * appropriately. * * There are two tricks here: * 1. Bindings can be invoked from in the middle of Tcl commands, * where the interp's result is significant (for example, a widget * might be deleted because of an error in creating it, so the * result contains an error message that is eventually going to * be returned by the creating command). To preserve the result, * we save it in a dynamic string. * 2. The binding's action can potentially delete the binding, * so bindPtr may not point to anything valid once the action * completes. Thus we have to save bindPtr->interp in a * local variable in order to restore the result. */ interp = bindPtr->interp; Tcl_DStringInit(&savedResult); /* * Save information about the current screen, then invoke a script * if the screen has changed. */ Tcl_DStringGetResult(interp, &savedResult); screenPtr = &bindInfoPtr->screenInfo; oldDispPtr = screenPtr->curDispPtr; oldScreen = screenPtr->curScreenIndex; if ((dispPtr != screenPtr->curDispPtr) || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) { screenPtr->curDispPtr = dispPtr; screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin); ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex); } if (matchCount > 0) { /* * Remember the list of pending C binding callbacks, so we can mark * them as deleted and not call them if the act of evaluating a C * or Tcl binding deletes a C binding callback or even the whole * window. */ pendingPtr->nextPtr = bindInfoPtr->pendingList; pendingPtr->tkwin = tkwin; pendingPtr->deleted = 0; bindInfoPtr->pendingList = pendingPtr; } /* * Save the current value of the TK_DEFER_MODAL flag so we can * restore it at the end of the loop. Clear the flag so we can * detect any recursive requests for a modal loop. */ flags = winPtr->flags; winPtr->flags &= ~TK_DEFER_MODAL; p = Tcl_DStringValue(&scripts); end = p + Tcl_DStringLength(&scripts); i = 0; /* * Be carefule when dereferencing screenPtr or bindInfoPtr. If we * evaluate something that destroys ".", bindInfoPtr would have been * freed, but we can tell that by first checking to see if * winPtr->mainPtr == NULL. */ Tcl_Preserve((ClientData) bindInfoPtr); while (p < end) { int code; if (!bindInfoPtr->deleted) { screenPtr->bindingDepth++; } Tcl_AllowExceptions(interp); if (*p == '\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++; if (!bindInfoPtr->deleted) { screenPtr->bindingDepth--; } if (code != TCL_OK) { if (code == TCL_CONTINUE) { /* * Do nothing: just go on to the next command. */ } else if (code == TCL_BREAK) { break; } else { Tcl_AddErrorInfo(interp, "\n (command bound to event)"); Tcl_BackgroundError(interp); break; } } } if (matchCount > 0 && !pendingPtr->deleted) { /* * Restore the original modal flag value and invoke the modal loop * if needed. */ deferModal = winPtr->flags & TK_DEFER_MODAL; winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL) | (flags & TK_DEFER_MODAL); if (deferModal) { modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc); if (modalProc != NULL) { (*modalProc)(tkwin, eventPtr); } } } if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0) && ((oldDispPtr != screenPtr->curDispPtr) || (oldScreen != screenPtr->curScreenIndex))) { /* * Some other binding script is currently executing, but its * screen is no longer current. Change the current display * back again. */ screenPtr->curDispPtr = oldDispPtr; screenPtr->curScreenIndex = oldScreen; ChangeScreen(interp, oldDispPtr->name, oldScreen); } Tcl_DStringResult(interp, &savedResult); Tcl_DStringFree(&scripts); if (matchCount > 0) { if (!bindInfoPtr->deleted) { /* * Delete the pending list from the list of pending scripts * for this window. */ PendingBinding **curPtrPtr; for (curPtrPtr = &bindInfoPtr->pendingList; ; ) { if (*curPtrPtr == pendingPtr) { *curPtrPtr = pendingPtr->nextPtr; break; } curPtrPtr = &(*curPtrPtr)->nextPtr; } } if (pendingPtr != &staticPending) { ckfree((char *) pendingPtr); } } Tcl_Release((ClientData) bindInfoPtr); } /* *--------------------------------------------------------------------------- * * TkBindDeadWindow -- * * This procedure is invoked when it is determined that a window is * dead. It cleans up bind-related information about the window * * Results: * None. * * Side effects: * Any pending C bindings for this window are cancelled. * *--------------------------------------------------------------------------- */ void TkBindDeadWindow(winPtr) TkWindow *winPtr; /* The window that is being deleted. */ { BindInfo *bindInfoPtr; PendingBinding *curPtr; /* * Certain special windows like those used for send and clipboard * have no mainPtr. */ if (winPtr->mainPtr == NULL) return; bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo; curPtr = bindInfoPtr->pendingList; while (curPtr != NULL) { if (curPtr->tkwin == (Tk_Window) winPtr) { curPtr->deleted = 1; } curPtr = curPtr->nextPtr; } } /* *---------------------------------------------------------------------- * * MatchPatterns -- * * Given a list of pattern sequences and a list of recent events, * return the pattern sequence that best matches the event list, * if there is one. * * This procedure is used in two different ways. In the simplest * use, "object" is NULL and psPtr is a list of pattern sequences, * each of which corresponds to a binding. In this case, the * procedure finds the pattern sequences that match the event list * and returns the most specific of those, if there is more than one. * * In the second case, psPtr is a list of pattern sequences, each * of which corresponds to a definition for a virtual binding. * In order for one of these sequences to "match", it must match * the events (as above) but in addition there must be a binding * for its associated virtual event on the current object. The * "object" argument indicates which object the binding must be for. * * Results: * The return value is NULL if bestPtr is NULL and no pattern matches * the recent events from bindPtr. Otherwise the return value is * the most specific pattern sequence among bestPtr and all those * at psPtr that match the event list and object. If a pattern * sequence other than bestPtr is returned, then *bestCommandPtr * is filled in with a pointer to the command from the best sequence. * * Side effects: * None. * *---------------------------------------------------------------------- */ static PatSeq * MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr) TkDisplay *dispPtr; /* Display from which the event came. */ BindingTable *bindPtr; /* Information about binding table, such as * ring of recent events. */ PatSeq *psPtr; /* List of pattern sequences. */ PatSeq *bestPtr; /* The best match seen so far, from a * previous call to this procedure. NULL * means no prior best match. */ ClientData *objectPtr; /* If NULL, the sequences at psPtr * correspond to "normal" bindings. If * non-NULL, the sequences at psPtr correspond * to virtual bindings; in order to match each * sequence must correspond to a virtual * binding for which a binding exists for * object in bindPtr. */ PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that * contains the eventProc and clientData * associated with the best match. If this * differs from the return value, it is the * virtual event that most closely matched the * return value (a physical event). Not * modified unless a result other than bestPtr * is returned. */ { PatSeq *matchPtr, *bestSourcePtr, *sourcePtr; bestSourcePtr = *sourcePtrPtr; /* * Iterate over all the pattern sequences. */ for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) { XEvent *eventPtr; Pattern *patPtr; Window window; Detail *detailPtr; int patCount, ringCount, flags, state; int modMask; /* * Iterate over all the patterns in a sequence to be * sure that they all match. */ eventPtr = &bindPtr->eventRing[bindPtr->curEvent]; detailPtr = &bindPtr->detailRing[bindPtr->curEvent]; window = eventPtr->xany.window; patPtr = psPtr->pats; patCount = psPtr->numPats; ringCount = EVENT_BUFFER_SIZE; while (patCount > 0) { if (ringCount <= 0) { goto nextSequence; } if (eventPtr->xany.type != patPtr->eventType) { /* * Most of the event types are considered superfluous * in that they are ignored if they occur in the middle * of a pattern sequence and have mismatching types. The * only ones that cannot be ignored are ButtonPress and * ButtonRelease events (if the next event in the pattern * is a KeyPress or KeyRelease) and KeyPress and KeyRelease * events (if the next pattern event is a ButtonPress or * ButtonRelease). Here are some tricky cases to consider: * 1. Double-Button or Double-Key events. * 2. Double-ButtonRelease or Double-KeyRelease events. * 3. The arrival of various events like Enter and Leave * and FocusIn and GraphicsExpose between two button * presses or key presses. * 4. Modifier keys like Shift and Control shouldn't * generate conflicts with button events. */ if ((patPtr->eventType == KeyPress) || (patPtr->eventType == KeyRelease)) { if ((eventPtr->xany.type == ButtonPress) || (eventPtr->xany.type == ButtonRelease)) { goto nextSequence; } } else if ((patPtr->eventType == ButtonPress) || (patPtr->eventType == ButtonRelease)) { if ((eventPtr->xany.type == KeyPress) || (eventPtr->xany.type == KeyRelease)) { int i; /* * Ignore key events if they are modifier keys. */ for (i = 0; i < dispPtr->numModKeyCodes; i++) { if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) { /* * This key is a modifier key, so ignore it. */ goto nextEvent; } } goto nextSequence; } } goto nextEvent; } if (eventPtr->xany.type == CreateNotify && eventPtr->xcreatewindow.parent != window) { goto nextSequence; } else if (eventPtr->xany.window != window) { goto nextSequence; } /* * Note: it's important for the keysym check to go before * the modifier check, so we can ignore unwanted modifier * keys before choking on the modifier check. */ if ((patPtr->detail.clientData != 0) && (patPtr->detail.clientData != detailPtr->clientData)) { /* * The detail appears not to match. However, if the event * is a KeyPress for a modifier key then just ignore the * event. Otherwise event sequences like "aD" never match * because the shift key goes down between the "a" and the * "D". */ if (eventPtr->xany.type == KeyPress) { int i; for (i = 0; i < dispPtr->numModKeyCodes; i++) { if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) { goto nextEvent; } } } goto nextSequence; } flags = flagArray[eventPtr->type]; if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { state = eventPtr->xkey.state; } else if (flags & CROSSING) { state = eventPtr->xcrossing.state; } else { state = 0; } if (patPtr->needMods != 0) { modMask = patPtr->needMods; if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) { modMask = (modMask & ~META_MASK) | dispPtr->metaModMask; } if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) { modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask; } if ((state & META_MASK) && (dispPtr->metaModMask != 0)) { state = (state & ~META_MASK) | dispPtr->metaModMask; } if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) { state = (state & ~ALT_MASK) | dispPtr->altModMask; } if ((state & modMask) != modMask) { goto nextSequence; } } if (psPtr->flags & PAT_NEARBY) { XEvent *firstPtr; int timeDiff; firstPtr = &bindPtr->eventRing[bindPtr->curEvent]; timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time; if ((firstPtr->xkey.x_root < (eventPtr->xkey.x_root - NEARBY_PIXELS)) || (firstPtr->xkey.x_root > (eventPtr->xkey.x_root + NEARBY_PIXELS)) || (firstPtr->xkey.y_root < (eventPtr->xkey.y_root - NEARBY_PIXELS)) || (firstPtr->xkey.y_root > (eventPtr->xkey.y_root + NEARBY_PIXELS)) || (timeDiff > NEARBY_MS)) { goto nextSequence; } } patPtr++; patCount--; nextEvent: if (eventPtr == bindPtr->eventRing) { eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1]; detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1]; } else { eventPtr--; detailPtr--; } ringCount--; } matchPtr = psPtr; sourcePtr = psPtr; if (objectPtr != NULL) { int iVirt; VirtualOwners *voPtr; PatternTableKey key; /* * The sequence matches the physical constraints. * Is this object interested in any of the virtual events * that correspond to this sequence? */ voPtr = psPtr->voPtr; memset(&key, 0, sizeof(key)); key.object = *objectPtr; key.type = VirtualEvent; key.detail.clientData = 0; for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) { Tcl_HashEntry *hPtr = voPtr->owners[iVirt]; key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr, hPtr); hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { /* * This tag is interested in this virtual event and its * corresponding physical event is a good match with the * virtual event's definition. */ PatSeq *virtMatchPtr; virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr); if ((virtMatchPtr->numPats != 1) || (virtMatchPtr->nextSeqPtr != NULL)) { panic("MatchPattern: badly constructed virtual event"); } sourcePtr = virtMatchPtr; goto match; } } /* * The physical event matches a virtual event's definition, but * the tag isn't interested in it. */ goto nextSequence; } match: /* * This sequence matches. If we've already got another match, * pick whichever is most specific. Detail is most important, * then needMods. */ if (bestPtr != NULL) { Pattern *patPtr2; int i; if (matchPtr->numPats != bestPtr->numPats) { if (bestPtr->numPats > matchPtr->numPats) { goto nextSequence; } else { goto newBest; } } for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats; i < matchPtr->numPats; i++, patPtr++, patPtr2++) { if (patPtr->detail.clientData != patPtr2->detail.clientData) { if (patPtr->detail.clientData == 0) { goto nextSequence; } else { goto newBest; } } if (patPtr->needMods != patPtr2->needMods) { if ((patPtr->needMods & patPtr2->needMods) == patPtr->needMods) { goto nextSequence; } else if ((patPtr->needMods & patPtr2->needMods) == patPtr2->needMods) { goto newBest; } } } /* * Tie goes to current best pattern. * * (1) For virtual vs. virtual, the least recently defined * virtual wins, because virtuals are examined in order of * definition. This order is _not_ guaranteed in the * documentation. * * (2) For virtual vs. physical, the physical wins because all * the physicals are examined before the virtuals. This order * is guaranteed in the documentation. * * (3) For physical vs. physical pattern, the most recently * defined physical wins, because physicals are examined in * reverse order of definition. This order is guaranteed in * the documentation. */ goto nextSequence; } newBest: bestPtr = matchPtr; bestSourcePtr = sourcePtr; nextSequence: continue; } *sourcePtrPtr = bestSourcePtr; return bestPtr; } /* *-------------------------------------------------------------- * * ExpandPercents -- * * Given a command and an event, produce a new command * by replacing % constructs in the original command * with information from the X event. * * Results: * The new expanded command is appended to the dynamic string * given by dsPtr. * * Side effects: * None. * *-------------------------------------------------------------- */ static void ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr) TkWindow *winPtr; /* Window where event occurred: needed to * get input context. */ CONST char *before; /* Command containing percent expressions * to be replaced. */ XEvent *eventPtr; /* X event containing information to be * used in % replacements. */ KeySym keySym; /* KeySym: only relevant for KeyPress and * KeyRelease events). */ Tcl_DString *dsPtr; /* Dynamic string in which to append new * command. */ { int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl * list element. */ int number, flags, length; #define NUM_SIZE 40 CONST char *string; Tcl_DString buf; char numStorage[NUM_SIZE+1]; Tcl_DStringInit(&buf); if (eventPtr->type < TK_LASTEVENT) { flags = flagArray[eventPtr->type]; } else { flags = 0; } while (1) { /* * Find everything up to the next % character and append it * to the result string. */ for (string = before; (*string != 0) && (*string != '%'); string++) { /* Empty loop body. */ } if (string != before) { Tcl_DStringAppend(dsPtr, before, (int) (string-before)); before = string; } if (*before == 0) { break; } /* * There's a percent sequence here. Process it. */ number = 0; string = "??"; switch (before[1]) { case '#': number = eventPtr->xany.serial; goto doNumber; case 'a': if (flags & CONFIG) { TkpPrintWindowId(numStorage, eventPtr->xconfigure.above); string = numStorage; } goto doString; case 'b': 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); } else if (flags & CONFIGREQ) { if (eventPtr->xconfigurerequest.value_mask & CWStackMode) { string = TkFindStateString(configureRequestDetail, eventPtr->xconfigurerequest.detail); } else { string = ""; } } goto doString; case 'f': number = eventPtr->xcrossing.focus; goto doNumber; case 'h': if (flags & EXPOSE) { number = eventPtr->xexpose.height; } else if (flags & (CONFIG)) { number = eventPtr->xconfigure.height; } else if (flags & CREATE) { number = eventPtr->xcreatewindow.height; } else if (flags & CONFIGREQ) { number = eventPtr->xconfigurerequest.height; } else if (flags & RESIZEREQ) { number = eventPtr->xresizerequest.height; } goto doNumber; case 'i': if (flags & CREATE) { TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window); } else if (flags & CONFIGREQ) { TkpPrintWindowId(numStorage, eventPtr->xconfigurerequest.window); } else if (flags & MAPREQ) { TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window); } else { TkpPrintWindowId(numStorage, eventPtr->xany.window); } string = numStorage; goto doString; case 'k': 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; } goto doNumber; case 'p': if (flags & CIRC) { string = TkFindStateString(circPlace, eventPtr->xcirculate.place); } else if (flags & CIRCREQ) { string = TkFindStateString(circPlace, eventPtr->xcirculaterequest.place); } goto doString; case 's': if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { number = eventPtr->xkey.state; } else if (flags & CROSSING) { number = eventPtr->xcrossing.state; } else if (flags & PROP) { string = TkFindStateString(propNotify, eventPtr->xproperty.state); goto doString; } 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; } else if (flags & CREATE) { number = eventPtr->xcreatewindow.width; } else if (flags & CONFIGREQ) { number = eventPtr->xconfigurerequest.width; } else if (flags & RESIZEREQ) { number = eventPtr->xresizerequest.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; } else if (flags & CREATE) { number = eventPtr->xcreatewindow.x; } else if (flags & CONFIGREQ) { number = eventPtr->xconfigurerequest.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; } else if (flags & CREATE) { number = eventPtr->xcreatewindow.y; } else if (flags & CONFIGREQ) { number = eventPtr->xconfigurerequest.y; } goto doNumber; case 'A': if (flags & KEY) { Tcl_DStringFree(&buf); string = TkpGetString(winPtr, eventPtr, &buf); } goto doString; case 'B': if (flags & CREATE) { number = eventPtr->xcreatewindow.border_width; } else if (flags & CONFIGREQ) { number = eventPtr->xconfigurerequest.border_width; } else { number = eventPtr->xconfigure.border_width; } goto doNumber; case 'D': /* * This is used only by the MouseWheel event. */ number = eventPtr->xkey.keycode; 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 'P': if (flags & PROP) { string = Tk_GetAtomName((Tk_Window) winPtr, eventPtr->xproperty.atom); } goto doString; 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); } else { string = "??"; } goto doString; } 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: numStorage[0] = before[1]; numStorage[1] = '\0'; string = numStorage; goto doString; } doNumber: sprintf(numStorage, "%d", number); string = numStorage; doString: spaceNeeded = Tcl_ScanElement(string, &cvtFlags); length = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, length + spaceNeeded); spaceNeeded = Tcl_ConvertElement(string, Tcl_DStringValue(dsPtr) + length, cvtFlags | TCL_DONT_USE_BRACES); Tcl_DStringSetLength(dsPtr, length + spaceNeeded); before += 2; } Tcl_DStringFree(&buf); } /* *---------------------------------------------------------------------- * * ChangeScreen -- * * This procedure is invoked whenever the current screen changes * in an application. It invokes a Tcl procedure named * "tk::ScreenChanged", passing it the screen name as argument. * tk::ScreenChanged does things like making the tk::Priv variable * point to an array for the current display. * * Results: * None. * * Side effects: * Depends on what tk::ScreenChanged does. If an error occurs * them bgerror 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. */ { Tcl_DString cmd; int code; char screen[TCL_INTEGER_SPACE]; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18); Tcl_DStringAppend(&cmd, dispName, -1); sprintf(screen, ".%d", screenIndex); Tcl_DStringAppend(&cmd, screen, -1); code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd)); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (changing screen in event binding)"); Tcl_BackgroundError(interp); } } /* *---------------------------------------------------------------------- * * 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_EventObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int index; Tk_Window tkwin; VirtualEventTable *vetPtr; TkBindInfo bindInfo; static CONST char *optionStrings[] = { "add", "delete", "generate", "info", NULL }; enum options { EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO }; tkwin = (Tk_Window) clientData; bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; vetPtr = &((BindInfo *) bindInfo)->virtualEventTable; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case EVENT_ADD: { int i; char *name, *event; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "virtual sequence ?sequence ...?"); return TCL_ERROR; } name = Tcl_GetStringFromObj(objv[2], NULL); for (i = 3; i < objc; i++) { event = Tcl_GetStringFromObj(objv[i], NULL); if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) { return TCL_ERROR; } } break; } case EVENT_DELETE: { int i; char *name, *event; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "virtual ?sequence sequence ...?"); return TCL_ERROR; } name = Tcl_GetStringFromObj(objv[2], NULL); if (objc == 3) { return DeleteVirtualEvent(interp, vetPtr, name, NULL); } for (i = 3; i < objc; i++) { event = Tcl_GetStringFromObj(objv[i], NULL); if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) { return TCL_ERROR; } } break; } case EVENT_GENERATE: { if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?"); return TCL_ERROR; } return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2); } case EVENT_INFO: { if (objc == 2) { GetAllVirtualEvents(interp, vetPtr); return TCL_OK; } else if (objc == 3) { return GetVirtualEvent(interp, vetPtr, Tcl_GetStringFromObj(objv[2], NULL)); } else { Tcl_WrongNumArgs(interp, 2, objv, "?virtual?"); return TCL_ERROR; } } } return TCL_OK; } /* *--------------------------------------------------------------------------- * * InitVirtualEventTable -- * * Given storage for a virtual event table, set up the fields to * prepare a new domain in which virtual events may be defined. * * Results: * None. * * Side effects: * *vetPtr is now initialized. * *--------------------------------------------------------------------------- */ static void InitVirtualEventTable(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 the interp's result. If all went well then the * return value is TCL_OK. * * Side effects: * The virtual event may cause future calls to Tk_BindEvent to * behave differently than they did previously. * *---------------------------------------------------------------------- */ static int CreateVirtualEvent(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 the interp's result will contain an error message. * It is not an error to attempt to delete a virtual event that * does not exist or a definition that does not exist. * * Side effects: * The virtual event given by virtString may be removed from the * virtual event table. * *-------------------------------------------------------------- */ static int DeleteVirtualEvent(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) { CONST char *string; string = Tcl_GetStringResult(interp); return (string[0] != '\0') ? TCL_ERROR : TCL_OK; } } for (iPhys = poPtr->numOwned; --iPhys >= 0; ) { PatSeq *psPtr = poPtr->patSeqs[iPhys]; if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) { int iVirt; VirtualOwners *voPtr; /* * Remove association between this physical event and the given * virtual event that it triggers. */ voPtr = psPtr->voPtr; for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) { if (voPtr->owners[iVirt] == vhPtr) { break; } } if (iVirt == voPtr->numOwners) { 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("DeleteVirtualEvent couldn't find on hash chain"); } if (prevPtr->nextSeqPtr == psPtr) { prevPtr->nextSeqPtr = psPtr->nextSeqPtr; break; } } } ckfree((char *) psPtr->voPtr); ckfree((char *) psPtr); } else { /* * This physical event still triggers some other virtual * event(s). Consolidate the list of virtual owners for * this physical event so it no longer triggers the * given virtual event. */ voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners]; } /* * Now delete the virtual event's reference to the physical * event. */ poPtr->numOwned--; if (eventPSPtr != NULL && poPtr->numOwned != 0) { /* * Just deleting this one physical event. Consolidate list * of owned physical events and return. */ poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned]; return TCL_OK; } } } if (poPtr->numOwned == 0) { /* * All the physical events for this virtual event were deleted, * either because there was only one associated physical event or * because the caller was deleting the entire virtual event. Now * the virtual event itself should be deleted. */ ckfree((char *) poPtr); Tcl_DeleteHashEntry(vhPtr); } return TCL_OK; } /* *--------------------------------------------------------------------------- * * GetVirtualEvent -- * * Return the list of physical events that can invoke the * given virtual event. * * Results: * The return value is TCL_OK and the interp's result is filled with the * string representation of the physical events associated with the * virtual event; if there are no physical events for the given virtual * event, the interp's result is filled with and empty string. If the * virtual event string is improperly formed, then TCL_ERROR is * returned and an error message is left in the interp's result. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int GetVirtualEvent(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. The interp's result is modified to * hold a Tcl list with one entry for each virtual event in * nameTable. * * Side effects: * None. * *-------------------------------------------------------------- */ static void GetAllVirtualEvents(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); Tcl_DStringAppend(&ds, "<<", 2); Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1); Tcl_DStringAppend(&ds, ">>", 2); Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); } Tcl_DStringFree(&ds); } /* *--------------------------------------------------------------------------- * * HandleEventGenerate -- * * Helper function for the "event generate" command. Generate and * process an XEvent, constructed from information parsed from the * event description string and its optional arguments. * * argv[0] contains name of the target window. * argv[1] contains pattern string for one event (e.g, <Control-v>). * argv[2..argc-1] contains -field/option pairs for specifying * additional detail in the generated event. * * Either virtual or physical events can be generated this way. * The event description string must contain the specification * for only one event. * * Results: * None. * * Side effects: * When constructing the event, * event.xany.serial is filled with the current X serial number. * event.xany.window is filled with the target window. * event.xany.display is filled with the target window's display. * Any other fields in eventPtr which are not specified by the pattern * string or the optional arguments, are set to 0. * * The event may be handled sychronously or asynchronously, depending * on the value specified by the optional "-when" option. The * default setting is synchronous. * *--------------------------------------------------------------------------- */ static int HandleEventGenerate(interp, mainWin, objc, objv) Tcl_Interp *interp; /* Interp for errors return and name lookup. */ Tk_Window mainWin; /* Main window associated with interp. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { XEvent event; CONST char *p; char *name, *windowName; int count, flags, synch, i, number, warp; Tcl_QueuePosition pos; Pattern pat; Tk_Window tkwin, tkwin2; TkWindow *mainPtr; unsigned long eventMask; static CONST char *fieldStrings[] = { "-when", "-above", "-borderwidth", "-button", "-count", "-delta", "-detail", "-focus", "-height", "-keycode", "-keysym", "-mode", "-override", "-place", "-root", "-rootx", "-rooty", "-sendevent", "-serial", "-state", "-subwindow", "-time", "-warp", "-width", "-window", "-x", "-y", NULL }; enum field { EVENT_WHEN, EVENT_ABOVE, EVENT_BORDER, EVENT_BUTTON, EVENT_COUNT, EVENT_DELTA, EVENT_DETAIL, EVENT_FOCUS, EVENT_HEIGHT, EVENT_KEYCODE, EVENT_KEYSYM, EVENT_MODE, EVENT_OVERRIDE, EVENT_PLACE, EVENT_ROOT, EVENT_ROOTX, EVENT_ROOTY, EVENT_SEND, EVENT_SERIAL, EVENT_STATE, EVENT_SUBWINDOW, EVENT_TIME, EVENT_WARP, EVENT_WIDTH, EVENT_WINDOW, EVENT_X, EVENT_Y }; windowName = Tcl_GetStringFromObj(objv[0], NULL); if (!windowName[0]) { tkwin = mainWin; } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) { return TCL_ERROR; } mainPtr = (TkWindow *) mainWin; if ((tkwin == NULL) || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { char *name; name = Tcl_GetStringFromObj(objv[0], NULL); Tcl_AppendResult(interp, "window id \"", name, "\" doesn't exist in this application", (char *) NULL); return TCL_ERROR; } name = Tcl_GetStringFromObj(objv[1], NULL); p = name; eventMask = 0; count = ParseEventDescription(interp, &p, &pat, &eventMask); if (count == 0) { return TCL_ERROR; } if (count != 1) { Tcl_SetResult(interp, "Double or Triple modifier not allowed", TCL_STATIC); return TCL_ERROR; } if (*p != '\0') { Tcl_SetResult(interp, "only one event specification allowed", TCL_STATIC); return TCL_ERROR; } memset((VOID *) &event, 0, sizeof(event)); event.xany.type = pat.eventType; event.xany.serial = NextRequest(Tk_Display(tkwin)); event.xany.send_event = False; if (windowName[0]) { event.xany.window = Tk_WindowId(tkwin); } else { event.xany.window = RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin)); } event.xany.display = Tk_Display(tkwin); flags = flagArray[event.xany.type]; if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { event.xkey.state = pat.needMods; if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) { TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event); } else if (flags & BUTTON) { event.xbutton.button = pat.detail.button; } else if (flags & VIRTUAL) { ((XVirtualEvent *) &event)->name = pat.detail.name; } } if (flags & (CREATE|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; warp = 0; pos = TCL_QUEUE_TAIL; for (i = 2; i < objc; i += 2) { Tcl_Obj *optionPtr, *valuePtr; int index; optionPtr = objv[i]; valuePtr = objv[i + 1]; if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } if (objc & 1) { /* * This test occurs after Tcl_GetIndexFromObj() so that * "event generate <Button> -xyz" will return the error message * that "-xyz" is a bad option, rather than that the value * for "-xyz" is missing. */ Tcl_AppendResult(interp, "value for \"", Tcl_GetStringFromObj(optionPtr, NULL), "\" missing", (char *) NULL); return TCL_ERROR; } switch ((enum field) index) { case EVENT_WARP: { if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) { return TCL_ERROR; } if (!(flags & (KEY_BUTTON_MOTION_VIRTUAL))) { goto badopt; } break; } case EVENT_WHEN: { pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr, queuePosition, valuePtr); if ((int) pos < -1) { return TCL_ERROR; } synch = 0; if ((int) pos == -1) { synch = 1; } break; } case EVENT_ABOVE: { if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } if (flags & CONFIG) { event.xconfigure.above = Tk_WindowId(tkwin2); } else { goto badopt; } break; } case EVENT_BORDER: { if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & (CREATE|CONFIG)) { event.xcreatewindow.border_width = number; } else { goto badopt; } break; } case EVENT_BUTTON: { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & BUTTON) { event.xbutton.button = number; } else { goto badopt; } break; } case EVENT_COUNT: { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & EXPOSE) { event.xexpose.count = number; } else { goto badopt; } break; } case EVENT_DELTA: { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) { event.xkey.keycode = number; } else { goto badopt; } break; } case EVENT_DETAIL: { number = TkFindStateNumObj(interp, optionPtr, notifyDetail, valuePtr); if (number < 0) { return TCL_ERROR; } if (flags & FOCUS) { event.xfocus.detail = number; } else if (flags & CROSSING) { event.xcrossing.detail = number; } else { goto badopt; } break; } case EVENT_FOCUS: { if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & CROSSING) { event.xcrossing.focus = number; } else { goto badopt; } break; } case EVENT_HEIGHT: { if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & EXPOSE) { event.xexpose.height = number; } else if (flags & CONFIG) { event.xconfigure.height = number; } else { goto badopt; } break; } case EVENT_KEYCODE: { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) { event.xkey.keycode = number; } else { goto badopt; } break; } case EVENT_KEYSYM: { KeySym keysym; char *value; value = Tcl_GetStringFromObj(valuePtr, NULL); keysym = TkStringToKeysym(value); if (keysym == NoSymbol) { Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", (char *) NULL); return TCL_ERROR; } TkpSetKeycodeAndState(tkwin, keysym, &event); if (event.xkey.keycode == 0) { Tcl_AppendResult(interp, "no keycode for keysym \"", value, "\"", (char *) NULL); return TCL_ERROR; } if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) { goto badopt; } break; } case EVENT_MODE: { number = TkFindStateNumObj(interp, optionPtr, notifyMode, valuePtr); if (number < 0) { return TCL_ERROR; } if (flags & CROSSING) { event.xcrossing.mode = number; } else if (flags & FOCUS) { event.xfocus.mode = number; } else { goto badopt; } break; } case EVENT_OVERRIDE: { if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & CREATE) { event.xcreatewindow.override_redirect = number; } else if (flags & MAP) { event.xmap.override_redirect = number; } else if (flags & REPARENT) { event.xreparent.override_redirect = number; } else if (flags & CONFIG) { event.xconfigure.override_redirect = number; } else { goto badopt; } break; } case EVENT_PLACE: { number = TkFindStateNumObj(interp, optionPtr, circPlace, valuePtr); if (number < 0) { return TCL_ERROR; } if (flags & CIRC) { event.xcirculate.place = number; } else { goto badopt; } break; } case EVENT_ROOT: { if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.root = Tk_WindowId(tkwin2); } else { goto badopt; } break; } case EVENT_ROOTX: { if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.x_root = number; } else { goto badopt; } break; } case EVENT_ROOTY: { if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.y_root = number; } else { goto badopt; } break; } case EVENT_SEND: { CONST char *value; value = Tcl_GetStringFromObj(valuePtr, NULL); if (isdigit(UCHAR(value[0]))) { /* * Allow arbitrary integer values for the field; they * are needed by a few of the tests in the Tk test suite. */ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } } else { if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } } event.xany.send_event = number; break; } case EVENT_SERIAL: { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } event.xany.serial = number; break; } case EVENT_STATE: { if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) { event.xkey.state = number; } else { event.xcrossing.state = number; } } else if (flags & VISIBILITY) { number = TkFindStateNumObj(interp, optionPtr, visNotify, valuePtr); if (number < 0) { return TCL_ERROR; } event.xvisibility.state = number; } else { goto badopt; } break; } case EVENT_SUBWINDOW: { if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.subwindow = Tk_WindowId(tkwin2); } else { goto badopt; } break; } case EVENT_TIME: { if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { event.xkey.time = (Time) number; } else if (flags & PROP) { event.xproperty.time = (Time) number; } else { goto badopt; } break; } case EVENT_WIDTH: { if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & EXPOSE) { event.xexpose.width = number; } else if (flags & (CREATE|CONFIG)) { event.xcreatewindow.width = number; } else { goto badopt; } break; } case EVENT_WINDOW: { if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { return TCL_ERROR; } if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG |GRAVITY|CIRC)) { event.xcreatewindow.window = Tk_WindowId(tkwin2); } else { goto badopt; } break; } case EVENT_X: { int rootX, rootY; if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &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; } break; } case EVENT_Y: { int rootX, rootY; if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &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; } break; } } continue; badopt: Tcl_AppendResult(interp, name, " event doesn't accept \"", Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL); return TCL_ERROR; } if (synch != 0) { Tk_HandleEvent(&event); } else { Tk_QueueWindowEvent(&event, pos); } /* * We only allow warping if the window is mapped */ if ((warp != 0) && Tk_IsMapped(tkwin)) { TkDisplay *dispPtr; dispPtr = TkGetDisplay(event.xmotion.display); if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) { Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr); dispPtr->flags |= TK_DISPLAY_IN_WARP; } dispPtr->warpWindow = event.xany.window; dispPtr->warpX = event.xkey.x; dispPtr->warpY = event.xkey.y; } Tcl_ResetResult(interp); return TCL_OK; } static int NameToWindow(interp, mainWin, objPtr, tkwinPtr) Tcl_Interp *interp; /* Interp for error return and name lookup. */ Tk_Window mainWin; /* Main window of application. */ Tcl_Obj *objPtr; /* Contains name or id string of window. */ Tk_Window *tkwinPtr; /* Filled with token for window. */ { char *name; Tk_Window tkwin; Window id; name = Tcl_GetStringFromObj(objPtr, NULL); if (name[0] == '.') { tkwin = Tk_NameToWindow(interp, name, mainWin); if (tkwin == NULL) { return TCL_ERROR; } *tkwinPtr = tkwin; } else { /* * Check for the winPtr being valid, even if it looks ok to * TkpScanWindowId. [Bug #411307] */ if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) || ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id)) == NULL)) { Tcl_AppendResult(interp, "bad window name/identifier \"", name, "\"", (char *) NULL); return TCL_ERROR; } } return TCL_OK; } /* *------------------------------------------------------------------------- * * DoWarp -- * * Perform Warping of X pointer. Executed as an idle handler only. * * Results: * None * * Side effects: * X Pointer will move to a new location. * *------------------------------------------------------------------------- */ static void DoWarp(clientData) ClientData clientData; { TkDisplay *dispPtr = (TkDisplay *) clientData; XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow, 0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY); XForceScreenSaver(dispPtr->display, ScreenSaverReset); dispPtr->flags &= ~TK_DISPLAY_IN_WARP; } /* *------------------------------------------------------------------------- * * GetVirtualEventUid -- * * Determine if the given string is in the proper format for a * virtual event. * * Results: * The return value is NULL if the virtual event string was * not in the proper format. In this case, an error message * will be left in the interp's result. Otherwise the return * value is a Tk_Uid that represents the virtual event. * * Side effects: * None. * *------------------------------------------------------------------------- */ static Tk_Uid GetVirtualEventUid(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 the interp's result contains a message describing the problem. * If no pattern sequence previously existed for eventString, then * a new one is created with a NULL command field. In a successful * return, *maskPtr is filled in with a mask of the event types * on which the pattern sequence depends. * * Side effects: * A new pattern sequence may be allocated. * *---------------------------------------------------------------------- */ static PatSeq * FindSequence(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. */ CONST char *eventString; /* String description of pattern to * match on. See user documentation * for details. */ int create; /* 0 means don't create the entry if * it doesn't already exist. Non-zero * means create. */ int allowVirtual; /* 0 means that virtual events are not * allowed in the sequence. Non-zero * otherwise. */ unsigned long *maskPtr; /* *maskPtr is filled in with the event * types on which this pattern sequence * depends. */ { Pattern pats[EVENT_BUFFER_SIZE]; int numPats, virtualFound; CONST char *p; Pattern *patPtr; PatSeq *psPtr; Tcl_HashEntry *hPtr; int flags, count, 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) { Tcl_SetResult(interp, "virtual event not allowed in definition of another virtual event", TCL_STATIC); return NULL; } virtualFound = 1; } /* * Replicate events for DOUBLE, TRIPLE, QUADRUPLE. */ while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) { flags |= PAT_NEARBY; patPtr[-1] = patPtr[0]; patPtr--; numPats++; } } /* *------------------------------------------------------------- * Step 2: find the sequence in the binding table if it exists, * and add a new sequence to the table if it doesn't. *------------------------------------------------------------- */ if (numPats == 0) { Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); return NULL; } if ((numPats > 1) && (virtualFound != 0)) { Tcl_SetResult(interp, "virtual events may not be composed", TCL_STATIC); return NULL; } patPtr = &pats[EVENT_BUFFER_SIZE-numPats]; memset(&key, 0, sizeof(key)); key.object = object; key.type = patPtr->eventType; key.detail = patPtr->detail; hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &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); } /* * No binding exists for the sequence, so return an empty error. * This is a special error that the caller will check for in order * to silently ignore this case. This is a hack that maintains * backward compatibility for Tk_GetBinding but the various "bind" * commands silently ignore missing bindings. */ return NULL; } psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq) + (numPats-1)*sizeof(Pattern))); psPtr->numPats = numPats; psPtr->eventProc = NULL; psPtr->freeProc = NULL; psPtr->clientData = NULL; psPtr->flags = flags; psPtr->refCount = 0; psPtr->nextSeqPtr = (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. */ CONST char **eventStringPtr;/* On input, holds a pointer to start of * event string. On exit, gets pointer to * rest of string after parsed event. */ Pattern *patPtr; /* Filled with the pattern parsed from the * event string. */ unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */ { char *p; unsigned long eventMask; int count, eventFlags; #define FIELD_SIZE 48 char field[FIELD_SIZE]; Tcl_HashEntry *hPtr; Tcl_DString copy; Tcl_DStringInit(&copy); p = Tcl_DStringAppend(&copy, *eventStringPtr, -1); patPtr->eventType = -1; patPtr->needMods = 0; patPtr->detail.clientData = 0; eventMask = 0; count = 1; /* * Handle simple ASCII characters. */ if (*p != '<') { char string[2]; patPtr->eventType = KeyPress; eventMask = KeyPressMask; string[0] = *p; string[1] = 0; patPtr->detail.keySym = TkStringToKeysym(string); if (patPtr->detail.keySym == NoSymbol) { if (isprint(UCHAR(*p))) { patPtr->detail.keySym = *p; } else { char buf[64]; sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p); Tcl_SetResult(interp, buf, TCL_VOLATILE); count = 0; goto done; } } p++; goto end; } /* * A fancier event description. This can be either a virtual event * or a physical event. * * A virtual event description consists of: * * 1. double open angle brackets. * 2. virtual event name. * 3. double close angle brackets. * * A physical event description consists of: * * 1. open angle bracket. * 2. any number of modifiers, each followed by spaces * or dashes. * 3. an optional event name. * 4. an option button or keysym name. Either this or * item 3 *must* be present; if both are present * then they are separated by spaces or dashes. * 5. a close angle bracket. */ p++; if (*p == '<') { /* * This is a virtual event: soak up all the characters up to * the next '>'. */ char *field = p + 1; p = strchr(field, '>'); if (p == field) { Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", TCL_STATIC); count = 0; goto done; } if ((p == NULL) || (p[1] != '>')) { Tcl_SetResult(interp, "missing \">\" in virtual binding", TCL_STATIC); count = 0; goto done; } *p = '\0'; patPtr->eventType = VirtualEvent; eventMask = VirtualEventMask; patPtr->detail.name = Tk_GetUid(field); *p = '>'; p += 2; goto end; } while (1) { ModInfo *modPtr; p = GetField(p, field, FIELD_SIZE); if (*p == '>') { /* * This solves the problem of, e.g., <Control-M> being * misinterpreted as Control + Meta + missing keysym * instead of Control + KeyPress + M. */ break; } hPtr = Tcl_FindHashEntry(&modTable, field); if (hPtr == NULL) { break; } modPtr = (ModInfo *) Tcl_GetHashValue(hPtr); patPtr->needMods |= modPtr->mask; if (modPtr->flags & (MULT_CLICKS)) { int i = modPtr->flags & MULT_CLICKS; count = 2; while (i >>= 1) count++; } while ((*p == '-') || isspace(UCHAR(*p))) { p++; } } eventFlags = 0; hPtr = Tcl_FindHashEntry(&eventTable, field); if (hPtr != NULL) { EventInfo *eiPtr; 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); count = 0; goto done; } patPtr->detail.button = (*field - '0'); } else { getKeysym: patPtr->detail.keySym = TkStringToKeysym(field); if (patPtr->detail.keySym == NoSymbol) { Tcl_AppendResult(interp, "bad event type or keysym \"", field, "\"", (char *) NULL); count = 0; goto done; } if (eventFlags == 0) { patPtr->eventType = KeyPress; eventMask = KeyPressMask; } else if ((eventFlags & KEY) == 0) { Tcl_AppendResult(interp, "specified keysym \"", field, "\" for non-key event", (char *) NULL); count = 0; goto done; } } } else if (eventFlags == 0) { Tcl_SetResult(interp, "no event type or button # or keysym", TCL_STATIC); count = 0; goto done; } while ((*p == '-') || isspace(UCHAR(*p))) { p++; } if (*p != '>') { while (*p != '\0') { p++; if (*p == '>') { Tcl_SetResult(interp, "extra characters after detail in binding", TCL_STATIC); count = 0; goto done; } } Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); count = 0; goto done; } p++; end: *eventStringPtr += (p - Tcl_DStringValue(&copy)); *eventMaskPtr |= eventMask; done: Tcl_DStringFree(&copy); 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[TCL_INTEGER_SPACE]; 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) { Tcl_DStringAppend(dsPtr, "<<", 2); Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1); Tcl_DStringAppend(dsPtr, ">>", 2); continue; } /* * It's a more general event specification. First check * for "Double", "Triple", "Quadruple", then modifiers, * then event type, then keysym or button detail. */ Tcl_DStringAppend(dsPtr, "<", 1); if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) && (memcmp((char *) patPtr, (char *) (patPtr-1), sizeof(Pattern)) == 0)) { patsLeft--; patPtr--; if ((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, "Quadruple-", 10); } else { Tcl_DStringAppend(dsPtr, "Triple-", 7); } } else { Tcl_DStringAppend(dsPtr, "Double-", 7); } } for (needMods = patPtr->needMods, modPtr = modArray; needMods != 0; modPtr++) { if (modPtr->mask & needMods) { needMods &= ~modPtr->mask; Tcl_DStringAppend(dsPtr, modPtr->name, -1); Tcl_DStringAppend(dsPtr, "-", 1); } } for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { if (eiPtr->type == patPtr->eventType) { Tcl_DStringAppend(dsPtr, eiPtr->name, -1); if (patPtr->detail.clientData != 0) { Tcl_DStringAppend(dsPtr, "-", 1); } break; } } if (patPtr->detail.clientData != 0) { if ((patPtr->eventType == KeyPress) || (patPtr->eventType == KeyRelease)) { char *string; string = TkKeysymToString(patPtr->detail.keySym); if (string != NULL) { Tcl_DStringAppend(dsPtr, string, -1); } } else { sprintf(buffer, "%d", patPtr->detail.button); Tcl_DStringAppend(dsPtr, buffer, -1); } } Tcl_DStringAppend(dsPtr, ">", 1); } } /* *--------------------------------------------------------------------------- * * EvalTclBinding -- * * The 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; { 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 the interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TkCopyAndGlobalEval(interp, script) Tcl_Interp *interp; /* Interpreter in which to evaluate * script. */ char *script; /* Script to evaluate. */ { Tcl_DString buffer; int code; Tcl_DStringInit(&buffer); Tcl_DStringAppend(&buffer, script, -1); code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer)); Tcl_DStringFree(&buffer); return code; }


context:
space:
mode: