Tk Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact e41f45f7f6ac3447a5ef84db2131545a82b8b2375ecfc36f3d43576f4659910e:


     1  /*
     2   * tkBind.c --
     3   *
     4   *	This file provides functions that associate Tcl commands with X events
     5   *	or sequences of X events.
     6   *
     7   * Copyright (c) 1989-1994 The Regents of the University of California.
     8   * Copyright (c) 1994-1997 Sun Microsystems, Inc.
     9   * Copyright (c) 1998 by Scriptics Corporation.
    10   *
    11   * See the file "license.terms" for information on usage and redistribution of
    12   * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13   */
    14  
    15  #include "tkInt.h"
    16  
    17  #ifdef _WIN32
    18  #include "tkWinInt.h"
    19  #elif defined(MAC_OSX_TK)
    20  #include "tkMacOSXInt.h"
    21  #else
    22  #include "tkUnixInt.h"
    23  #endif
    24  
    25  /*
    26   * File structure:
    27   *
    28   * Structure definitions and static variables.
    29   *
    30   * Init/Free this package.
    31   *
    32   * Tcl "bind" command (actually located in tkCmds.c) core implementation, plus
    33   * helpers.
    34   *
    35   * Tcl "event" command implementation, plus helpers.
    36   *
    37   * Package-specific common helpers.
    38   *
    39   * Non-package-specific helpers.
    40   */
    41  
    42  /*
    43   * The following union is used to hold the detail information from an XEvent
    44   * (including Tk's XVirtualEvent extension).
    45   */
    46  
    47  typedef union {
    48      KeySym keySym;		/* KeySym that corresponds to xkey.keycode. */
    49      int button;			/* Button that was pressed (xbutton.button). */
    50      Tk_Uid name;		/* Tk_Uid of virtual event. */
    51      ClientData clientData;	/* Used when type of Detail is unknown, and to
    52  				 * ensure that all bytes of Detail are
    53  				 * initialized when this structure is used in
    54  				 * a hash key. */
    55  } Detail;
    56  
    57  /*
    58   * The structure below represents a binding table. A binding table represents
    59   * a domain in which event bindings may occur. It includes a space of objects
    60   * relative to which events occur (usually windows, but not always), a history
    61   * of recent events in the domain, and a set of mappings that associate
    62   * particular Tcl commands with sequences of events in the domain. Multiple
    63   * binding tables may exist at once, either because there are multiple
    64   * applications open, or because there are multiple domains within an
    65   * application with separate event bindings for each (for example, each canvas
    66   * widget has a separate binding table for associating events with the items
    67   * in the canvas).
    68   *
    69   * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much below 30.
    70   * To see this, consider a triple mouse button click while the Shift key is
    71   * down (and auto-repeating). There may be as many as 3 auto-repeat events
    72   * after each mouse button press or release (see the first large comment block
    73   * within Tk_BindEvent for more on this), for a total of 20 events to cover
    74   * the three button presses and two intervening releases. If you reduce
    75   * EVENT_BUFFER_SIZE too much, shift multi-clicks will be lost.
    76   */
    77  
    78  /*
    79   * NOTE: The changes which were needed to make Tk work on OSX 10.14 (Mojave)
    80   * also demand that the event ring be a bit bigger.  It might be wise to
    81   * augment the current double-click pattern matching by adding a new
    82   * DoubleClick modifier bit which could be set based on the clickCount of the
    83   * Apple NSEvent object.
    84   */
    85  
    86  #ifndef TK_MAC_OSX
    87    #define EVENT_BUFFER_SIZE 45
    88  #else
    89    #define EVENT_BUFFER_SIZE 30
    90  #endif
    91  
    92  typedef struct Tk_BindingTable_ {
    93      XEvent eventRing[EVENT_BUFFER_SIZE];
    94  				/* Circular queue of recent events (higher
    95  				 * indices are for more recent events). */
    96      Detail detailRing[EVENT_BUFFER_SIZE];
    97  				/* "Detail" information (keySym, button,
    98  				 * Tk_Uid, or 0) for each entry in
    99  				 * eventRing. */
   100      int curEvent;		/* Index in eventRing of most recent event.
   101  				 * Newer events have higher indices. */
   102      Tcl_HashTable patternTable;	/* Used to map from an event to a list of
   103  				 * patterns that may match that event. Keys
   104  				 * are PatternTableKey structs, values are
   105  				 * (PatSeq *). */
   106      Tcl_HashTable objectTable;	/* Used to map from an object to a list of
   107  				 * patterns associated with that object. Keys
   108  				 * are ClientData, values are (PatSeq *). */
   109      Tcl_Interp *interp;		/* Interpreter in which commands are
   110  				 * executed. */
   111  } BindingTable;
   112  
   113  /*
   114   * The following structure represents virtual event table. A virtual event
   115   * table provides a way to map from platform-specific physical events such as
   116   * button clicks or key presses to virtual events such as <<Paste>>,
   117   * <<Close>>, or <<ScrollWindow>>.
   118   *
   119   * A virtual event is usually never part of the event stream, but instead is
   120   * synthesized inline by matching low-level events. However, a virtual event
   121   * may be generated by platform-specific code or by Tcl commands. In that case,
   122   * no lookup of the virtual event will need to be done using this table,
   123   * because the virtual event is actually in the event stream.
   124   */
   125  
   126  typedef struct {
   127      Tcl_HashTable patternTable;	/* Used to map from a physical event to a list
   128  				 * of patterns that may match that event. Keys
   129  				 * are PatternTableKey structs, values are
   130  				 * (PatSeq *). */
   131      Tcl_HashTable nameTable;	/* Used to map a virtual event name to the
   132  				 * array of physical events that can trigger
   133  				 * it. Keys are the Tk_Uid names of the
   134  				 * virtual events, values are PhysicalsOwned
   135  				 * structs. */
   136  } VirtualEventTable;
   137  
   138  /*
   139   * The following structure is used as a key in a patternTable for both binding
   140   * tables and a virtual event tables.
   141   *
   142   * In a binding table, the object field corresponds to the binding tag for the
   143   * widget whose bindings are being accessed.
   144   *
   145   * In a virtual event table, the object field is always NULL. Virtual events
   146   * are a global definiton and are not tied to a particular binding tag.
   147   *
   148   * The same key is used for both types of pattern tables so that the helper
   149   * functions that traverse and match patterns will work for both binding
   150   * tables and virtual event tables.
   151   */
   152  
   153  typedef struct {
   154      ClientData object;		/* For binding table, identifies the binding
   155  				 * tag of the object (or class of objects)
   156  				 * relative to which the event occurred. For
   157  				 * virtual event table, always NULL. */
   158      int type;			/* Type of event (from X). */
   159      Detail detail;		/* Additional information, such as keysym,
   160  				 * button, Tk_Uid, or 0 if nothing
   161  				 * additional. */
   162  } PatternTableKey;
   163  
   164  /*
   165   * The following structure defines a pattern, which is matched against X
   166   * events as part of the process of converting X events into Tcl commands.
   167   */
   168  
   169  typedef struct {
   170      int eventType;		/* Type of X event, e.g. ButtonPress. */
   171      int needMods;		/* Mask of modifiers that must be present (0
   172  				 * means no modifiers are required). */
   173      Detail detail;		/* Additional information that must match
   174  				 * event. Normally this is 0, meaning no
   175  				 * additional information must match. For
   176  				 * KeyPress and KeyRelease events, a keySym
   177  				 * may be specified to select a particular
   178  				 * keystroke (0 means any keystrokes). For
   179  				 * button events, specifies a particular
   180  				 * button (0 means any buttons are OK). For
   181  				 * virtual events, specifies the Tk_Uid of the
   182  				 * virtual event name (never 0). */
   183  } TkPattern;
   184  
   185  /*
   186   * The following structure defines a pattern sequence, which consists of one
   187   * or more patterns. In order to trigger, a pattern sequence must match the
   188   * most recent X events (first pattern to most recent event, next pattern to
   189   * next event, and so on). It is used as the hash value in a patternTable for
   190   * both binding tables and virtual event tables.
   191   *
   192   * In a binding table, it is the sequence of physical events that make up a
   193   * binding for an object.
   194   *
   195   * In a virtual event table, it is the sequence of physical events that define
   196   * a virtual event.
   197   *
   198   * The same structure is used for both types of pattern tables so that the
   199   * helper functions that traverse and match patterns will work for both
   200   * binding tables and virtual event tables.
   201   */
   202  
   203  typedef struct PatSeq {
   204      int numPats;		/* Number of patterns in sequence (usually
   205  				 * 1). */
   206      char *script;		/* Binding script to evaluate when sequence
   207  				 * matches (ckalloc()ed) */
   208      int flags;			/* Miscellaneous flag values; see below for
   209  				 * definitions. */
   210      struct PatSeq *nextSeqPtr;	/* Next in list of all pattern sequences that
   211  				 * have the same initial pattern. NULL means
   212  				 * end of list. */
   213      Tcl_HashEntry *hPtr;	/* Pointer to hash table entry for the initial
   214  				 * pattern. This is the head of the list of
   215  				 * which nextSeqPtr forms a part. */
   216      struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
   217  				 * virtual event table, identifies the array
   218  				 * of virtual events that can be triggered by
   219  				 * this event. */
   220      struct PatSeq *nextObjPtr;	/* In a binding table, next in list of all
   221  				 * pattern sequences for the same object (NULL
   222  				 * for end of list). Needed to implement
   223  				 * Tk_DeleteAllBindings. In a virtual event
   224  				 * table, always NULL. */
   225      TkPattern pats[1];		/* Array of "numPats" patterns. Only one
   226  				 * element is declared here but in actuality
   227  				 * enough space will be allocated for
   228  				 * "numPats" patterns. To match, pats[0] must
   229  				 * match event n, pats[1] must match event
   230  				 * n-1, etc. */
   231  } PatSeq;
   232  
   233  /*
   234   * Flag values for PatSeq structures:
   235   *
   236   * PAT_NEARBY		1 means that all of the events matching this sequence
   237   *			must occur with nearby X and Y mouse coordinates and
   238   *			close in time. This is typically used to restrict
   239   *			multiple button presses.
   240   */
   241  
   242  #define PAT_NEARBY		0x1
   243  
   244  /*
   245   * Constants that define how close together two events must be in milliseconds
   246   * or pixels to meet the PAT_NEARBY constraint:
   247   */
   248  
   249  #define NEARBY_PIXELS		5
   250  #define NEARBY_MS		500
   251  
   252  /*
   253   * The following structure keeps track of all the virtual events that are
   254   * associated with a particular physical event. It is pointed to by the voPtr
   255   * field in a PatSeq in the patternTable of a virtual event table.
   256   */
   257  
   258  typedef struct VirtualOwners {
   259      int numOwners;		/* Number of virtual events to trigger. */
   260      Tcl_HashEntry *owners[1];	/* Array of pointers to entries in nameTable.
   261  				 * Enough space will actually be allocated for
   262  				 * numOwners hash entries. */
   263  } VirtualOwners;
   264  
   265  /*
   266   * The following structure is used in the nameTable of a virtual event table
   267   * to associate a virtual event with all the physical events that can trigger
   268   * it.
   269   */
   270  typedef struct {
   271      int numOwned;		/* Number of physical events owned. */
   272      PatSeq *patSeqs[1];		/* Array of pointers to physical event
   273  				 * patterns. Enough space will actually be
   274  				 * allocated to hold numOwned. */
   275  } PhysicalsOwned;
   276  
   277  /*
   278   * One of the following structures exists for each interpreter. This structure
   279   * keeps track of the current display and screen in the interpreter, so that a
   280   * command can be invoked whenever the display/screen changes (the command does
   281   * things like point tk::Priv at a display-specific structure).
   282   */
   283  
   284  typedef struct {
   285      TkDisplay *curDispPtr;	/* Display for last binding command invoked in
   286  				 * this application. */
   287      int curScreenIndex;		/* Index of screen for last binding command */
   288      int bindingDepth;		/* Number of active instances of Tk_BindEvent
   289  				 * in this application. */
   290  } ScreenInfo;
   291  
   292  /*
   293   * The following structure keeps track of all the information local to the
   294   * binding package on a per interpreter basis.
   295   */
   296  
   297  typedef struct TkBindInfo_ {
   298      VirtualEventTable virtualEventTable;
   299  				/* The virtual events that exist in this
   300  				 * interpreter. */
   301      ScreenInfo screenInfo;	/* Keeps track of the current display and
   302  				 * screen, so it can be restored after a
   303  				 * binding has executed. */
   304      int deleted;		/* 1 the application has been deleted but the
   305  				 * structure has been preserved. */
   306  } BindInfo;
   307  
   308  /*
   309   * In X11R4 and earlier versions, XStringToKeysym is ridiculously slow. The
   310   * data structure and hash table below, along with the code that uses them,
   311   * implement a fast mapping from strings to keysyms. In X11R5 and later
   312   * releases XStringToKeysym is plenty fast so this stuff isn't needed. The
   313   * #define REDO_KEYSYM_LOOKUP is normally undefined, so that XStringToKeysym
   314   * gets used. It can be set in the Makefile to enable the use of the hash
   315   * table below.
   316   */
   317  
   318  #ifdef REDO_KEYSYM_LOOKUP
   319  typedef struct {
   320      const char *name;			/* Name of keysym. */
   321      KeySym value;		/* Numeric identifier for keysym. */
   322  } KeySymInfo;
   323  static const KeySymInfo keyArray[] = {
   324  #ifndef lint
   325  #include "ks_names.h"
   326  #endif
   327      {NULL, 0}
   328  };
   329  static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
   330  static Tcl_HashTable nameTable;	/* keyArray hashed by keysym name. */
   331  #endif /* REDO_KEYSYM_LOOKUP */
   332  
   333  /*
   334   * Set to non-zero when the package-wide static variables have been
   335   * initialized.
   336   */
   337  
   338  static int initialized = 0;
   339  TCL_DECLARE_MUTEX(bindMutex)
   340  
   341  /*
   342   * A hash table is kept to map from the string names of event modifiers to
   343   * information about those modifiers. The structure for storing this
   344   * information, and the hash table built at initialization time, are defined
   345   * below.
   346   */
   347  
   348  typedef struct {
   349      const char *name; /* Name of modifier. */
   350      int mask;			/* Button/modifier mask value, such as
   351  				 * Button1Mask. */
   352      int flags;			/* Various flags; see below for
   353  				 * definitions. */
   354  } ModInfo;
   355  
   356  /*
   357   * Flags for ModInfo structures:
   358   *
   359   * DOUBLE -		Non-zero means duplicate this event,
   360   *			e.g. for double-clicks.
   361   * TRIPLE -		Non-zero means triplicate this event,
   362   *			e.g. for triple-clicks.
   363   * QUADRUPLE -		Non-zero means quadruple this event,
   364   *			e.g. for 4-fold-clicks.
   365   * MULT_CLICKS -	Combination of all of above.
   366   */
   367  
   368  #define DOUBLE		1
   369  #define TRIPLE		2
   370  #define QUADRUPLE	4
   371  #define MULT_CLICKS	7
   372  
   373  static const ModInfo modArray[] = {
   374      {"Control",		ControlMask,	0},
   375      {"Shift",		ShiftMask,	0},
   376      {"Lock",		LockMask,	0},
   377      {"Meta",		META_MASK,	0},
   378      {"M",		META_MASK,	0},
   379      {"Alt",		ALT_MASK,	0},
   380      {"Extended",	EXTENDED_MASK,	0},
   381      {"B1",		Button1Mask,	0},
   382      {"Button1",		Button1Mask,	0},
   383      {"B2",		Button2Mask,	0},
   384      {"Button2",		Button2Mask,	0},
   385      {"B3",		Button3Mask,	0},
   386      {"Button3",		Button3Mask,	0},
   387      {"B4",		Button4Mask,	0},
   388      {"Button4",		Button4Mask,	0},
   389      {"B5",		Button5Mask,	0},
   390      {"Button5",		Button5Mask,	0},
   391      {"Mod1",		Mod1Mask,	0},
   392      {"M1",		Mod1Mask,	0},
   393      {"Command",		Mod1Mask,	0},
   394      {"Mod2",		Mod2Mask,	0},
   395      {"M2",		Mod2Mask,	0},
   396      {"Option",		Mod2Mask,	0},
   397      {"Mod3",		Mod3Mask,	0},
   398      {"M3",		Mod3Mask,	0},
   399      {"Mod4",		Mod4Mask,	0},
   400      {"M4",		Mod4Mask,	0},
   401      {"Mod5",		Mod5Mask,	0},
   402      {"M5",		Mod5Mask,	0},
   403      {"Double",		0,		DOUBLE},
   404      {"Triple",		0,		TRIPLE},
   405      {"Quadruple",	0,		QUADRUPLE},
   406      {"Any",		0,		0},	/* Ignored: historical relic */
   407      {NULL,		0,		0}
   408  };
   409  static Tcl_HashTable modTable;
   410  
   411  /*
   412   * This module also keeps a hash table mapping from event names to information
   413   * about those events. The structure, an array to use to initialize the hash
   414   * table, and the hash table are all defined below.
   415   */
   416  
   417  typedef struct {
   418      const char *name;	/* Name of event. */
   419      int type;			/* Event type for X, such as ButtonPress. */
   420      int eventMask;		/* Mask bits (for XSelectInput) for this event
   421  				 * type. */
   422  } EventInfo;
   423  
   424  /*
   425   * Note: some of the masks below are an OR-ed combination of several masks.
   426   * This is necessary because X doesn't report up events unless you also ask
   427   * for down events. Also, X doesn't report button state in motion events
   428   * unless you've asked about button events.
   429   */
   430  
   431  static const EventInfo eventArray[] = {
   432      {"Key",		KeyPress,		KeyPressMask},
   433      {"KeyPress",	KeyPress,		KeyPressMask},
   434      {"KeyRelease",	KeyRelease,		KeyPressMask|KeyReleaseMask},
   435      {"Button",		ButtonPress,		ButtonPressMask},
   436      {"ButtonPress",	ButtonPress,		ButtonPressMask},
   437      {"ButtonRelease",	ButtonRelease,
   438  	    ButtonPressMask|ButtonReleaseMask},
   439      {"Motion",		MotionNotify,
   440  	    ButtonPressMask|PointerMotionMask},
   441      {"Enter",		EnterNotify,		EnterWindowMask},
   442      {"Leave",		LeaveNotify,		LeaveWindowMask},
   443      {"FocusIn",		FocusIn,		FocusChangeMask},
   444      {"FocusOut",	FocusOut,		FocusChangeMask},
   445      {"Expose",		Expose,			ExposureMask},
   446      {"Visibility",	VisibilityNotify,	VisibilityChangeMask},
   447      {"Destroy",		DestroyNotify,		StructureNotifyMask},
   448      {"Unmap",		UnmapNotify,		StructureNotifyMask},
   449      {"Map",		MapNotify,		StructureNotifyMask},
   450      {"Reparent",	ReparentNotify,		StructureNotifyMask},
   451      {"Configure",	ConfigureNotify,	StructureNotifyMask},
   452      {"Gravity",		GravityNotify,		StructureNotifyMask},
   453      {"Circulate",	CirculateNotify,	StructureNotifyMask},
   454      {"Property",	PropertyNotify,		PropertyChangeMask},
   455      {"Colormap",	ColormapNotify,		ColormapChangeMask},
   456      {"Activate",	ActivateNotify,		ActivateMask},
   457      {"Deactivate",	DeactivateNotify,	ActivateMask},
   458      {"MouseWheel",	MouseWheelEvent,	MouseWheelMask},
   459      {"CirculateRequest", CirculateRequest,	SubstructureRedirectMask},
   460      {"ConfigureRequest", ConfigureRequest,	SubstructureRedirectMask},
   461      {"Create",		CreateNotify,		SubstructureNotifyMask},
   462      {"MapRequest",	MapRequest,		SubstructureRedirectMask},
   463      {"ResizeRequest",	ResizeRequest,		ResizeRedirectMask},
   464      {NULL,		0,			0}
   465  };
   466  static Tcl_HashTable eventTable;
   467  
   468  /*
   469   * The defines and table below are used to classify events into various
   470   * groups. The reason for this is that logically identical fields (e.g.
   471   * "state") appear at different places in different types of events. The
   472   * classification masks can be used to figure out quickly where to extract
   473   * information from events.
   474   */
   475  
   476  #define KEY			0x1
   477  #define BUTTON			0x2
   478  #define MOTION			0x4
   479  #define CROSSING		0x8
   480  #define FOCUS			0x10
   481  #define EXPOSE			0x20
   482  #define VISIBILITY		0x40
   483  #define CREATE			0x80
   484  #define DESTROY			0x100
   485  #define UNMAP			0x200
   486  #define MAP			0x400
   487  #define REPARENT		0x800
   488  #define CONFIG			0x1000
   489  #define GRAVITY			0x2000
   490  #define CIRC			0x4000
   491  #define PROP			0x8000
   492  #define COLORMAP		0x10000
   493  #define VIRTUAL			0x20000
   494  #define ACTIVATE		0x40000
   495  #define	MAPREQ			0x80000
   496  #define	CONFIGREQ		0x100000
   497  #define	RESIZEREQ		0x200000
   498  #define CIRCREQ			0x400000
   499  
   500  #define KEY_BUTTON_MOTION_VIRTUAL	(KEY|BUTTON|MOTION|VIRTUAL)
   501  #define KEY_BUTTON_MOTION_CROSSING	(KEY|BUTTON|MOTION|VIRTUAL|CROSSING)
   502  
   503  static const int flagArray[TK_LASTEVENT] = {
   504     /* Not used */		0,
   505     /* Not used */		0,
   506     /* KeyPress */		KEY,
   507     /* KeyRelease */		KEY,
   508     /* ButtonPress */		BUTTON,
   509     /* ButtonRelease */		BUTTON,
   510     /* MotionNotify */		MOTION,
   511     /* EnterNotify */		CROSSING,
   512     /* LeaveNotify */		CROSSING,
   513     /* FocusIn */		FOCUS,
   514     /* FocusOut */		FOCUS,
   515     /* KeymapNotify */		0,
   516     /* Expose */			EXPOSE,
   517     /* GraphicsExpose */		EXPOSE,
   518     /* NoExpose */		0,
   519     /* VisibilityNotify */	VISIBILITY,
   520     /* CreateNotify */		CREATE,
   521     /* DestroyNotify */		DESTROY,
   522     /* UnmapNotify */		UNMAP,
   523     /* MapNotify */		MAP,
   524     /* MapRequest */		MAPREQ,
   525     /* ReparentNotify */		REPARENT,
   526     /* ConfigureNotify */	CONFIG,
   527     /* ConfigureRequest */	CONFIGREQ,
   528     /* GravityNotify */		GRAVITY,
   529     /* ResizeRequest */		RESIZEREQ,
   530     /* CirculateNotify */	CIRC,
   531     /* CirculateRequest */	0,
   532     /* PropertyNotify */		PROP,
   533     /* SelectionClear */		0,
   534     /* SelectionRequest */	0,
   535     /* SelectionNotify */	0,
   536     /* ColormapNotify */		COLORMAP,
   537     /* ClientMessage */		0,
   538     /* MappingNotify */		0,
   539     /* VirtualEvent */		VIRTUAL,
   540     /* Activate */		ACTIVATE,
   541     /* Deactivate */		ACTIVATE,
   542     /* MouseWheel */		KEY
   543  };
   544  
   545  /*
   546   * The following table is used to map between the location where an generated
   547   * event should be queued and the string used to specify the location.
   548   */
   549  
   550  static const TkStateMap queuePosition[] = {
   551      {-1,			"now"},
   552      {TCL_QUEUE_HEAD,		"head"},
   553      {TCL_QUEUE_MARK,		"mark"},
   554      {TCL_QUEUE_TAIL,		"tail"},
   555      {-2,			NULL}
   556  };
   557  
   558  /*
   559   * The following tables are used as a two-way map between X's internal numeric
   560   * values for fields in an XEvent and the strings used in Tcl. The tables are
   561   * used both when constructing an XEvent from user input and when providing
   562   * data from an XEvent to the user.
   563   */
   564  
   565  static const TkStateMap notifyMode[] = {
   566      {NotifyNormal,		"NotifyNormal"},
   567      {NotifyGrab,		"NotifyGrab"},
   568      {NotifyUngrab,		"NotifyUngrab"},
   569      {NotifyWhileGrabbed,	"NotifyWhileGrabbed"},
   570      {-1, NULL}
   571  };
   572  
   573  static const TkStateMap notifyDetail[] = {
   574      {NotifyAncestor,		"NotifyAncestor"},
   575      {NotifyVirtual,		"NotifyVirtual"},
   576      {NotifyInferior,		"NotifyInferior"},
   577      {NotifyNonlinear,		"NotifyNonlinear"},
   578      {NotifyNonlinearVirtual,	"NotifyNonlinearVirtual"},
   579      {NotifyPointer,		"NotifyPointer"},
   580      {NotifyPointerRoot,		"NotifyPointerRoot"},
   581      {NotifyDetailNone,		"NotifyDetailNone"},
   582      {-1, NULL}
   583  };
   584  
   585  static const TkStateMap circPlace[] = {
   586      {PlaceOnTop,		"PlaceOnTop"},
   587      {PlaceOnBottom,		"PlaceOnBottom"},
   588      {-1, NULL}
   589  };
   590  
   591  static const TkStateMap visNotify[] = {
   592      {VisibilityUnobscured,	  "VisibilityUnobscured"},
   593      {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
   594      {VisibilityFullyObscured,	  "VisibilityFullyObscured"},
   595      {-1, NULL}
   596  };
   597  
   598  static const TkStateMap configureRequestDetail[] = {
   599      {None,		"None"},
   600      {Above,		"Above"},
   601      {Below,		"Below"},
   602      {BottomIf,		"BottomIf"},
   603      {TopIf,		"TopIf"},
   604      {Opposite,		"Opposite"},
   605      {-1, NULL}
   606  };
   607  
   608  static const TkStateMap propNotify[] = {
   609      {PropertyNewValue,	"NewValue"},
   610      {PropertyDelete,	"Delete"},
   611      {-1, NULL}
   612  };
   613  
   614  /*
   615   * Prototypes for local functions defined in this file:
   616   */
   617  
   618  static void		ChangeScreen(Tcl_Interp *interp, char *dispName,
   619  			    int screenIndex);
   620  static int		CreateVirtualEvent(Tcl_Interp *interp,
   621  			    VirtualEventTable *vetPtr, char *virtString,
   622  			    const char *eventString);
   623  static int		DeleteVirtualEvent(Tcl_Interp *interp,
   624  			    VirtualEventTable *vetPtr, char *virtString,
   625  			    const char *eventString);
   626  static void		DeleteVirtualEventTable(VirtualEventTable *vetPtr);
   627  static void		ExpandPercents(TkWindow *winPtr, const char *before,
   628  			    XEvent *eventPtr,KeySym keySym,
   629  			    unsigned int scriptCount, Tcl_DString *dsPtr);
   630  static PatSeq *		FindSequence(Tcl_Interp *interp,
   631  			    Tcl_HashTable *patternTablePtr, ClientData object,
   632  			    const char *eventString, int create,
   633  			    int allowVirtual, unsigned long *maskPtr);
   634  static void		GetAllVirtualEvents(Tcl_Interp *interp,
   635  			    VirtualEventTable *vetPtr);
   636  static char *		GetField(char *p, char *copy, int size);
   637  static Tcl_Obj *	GetPatternObj(PatSeq *psPtr);
   638  static int		GetVirtualEvent(Tcl_Interp *interp,
   639  			    VirtualEventTable *vetPtr, Tcl_Obj *virtName);
   640  static Tk_Uid		GetVirtualEventUid(Tcl_Interp *interp,
   641  			    char *virtString);
   642  static int		HandleEventGenerate(Tcl_Interp *interp, Tk_Window main,
   643  			    int objc, Tcl_Obj *const objv[]);
   644  static void		InitVirtualEventTable(VirtualEventTable *vetPtr);
   645  static PatSeq *		MatchPatterns(TkDisplay *dispPtr,
   646  			    BindingTable *bindPtr, PatSeq *psPtr,
   647  			    PatSeq *bestPtr, ClientData *objectPtr,
   648  			    PatSeq **sourcePtrPtr);
   649  static int		NameToWindow(Tcl_Interp *interp, Tk_Window main,
   650  			    Tcl_Obj *objPtr, Tk_Window *tkwinPtr);
   651  static int		ParseEventDescription(Tcl_Interp *interp,
   652  			    const char **eventStringPtr, TkPattern *patPtr,
   653  			    unsigned long *eventMaskPtr);
   654  static void		DoWarp(ClientData clientData);
   655  
   656  /*
   657   *---------------------------------------------------------------------------
   658   *
   659   * TkBindInit --
   660   *
   661   *	This function is called when an application is created. It initializes
   662   *	all the structures used by bindings and virtual events. It must be
   663   *	called before any other functions in this file are called.
   664   *
   665   * Results:
   666   *	None.
   667   *
   668   * Side effects:
   669   *	Memory allocated.
   670   *
   671   *---------------------------------------------------------------------------
   672   */
   673  
   674  void
   675  TkBindInit(
   676      TkMainInfo *mainPtr)	/* The newly created application. */
   677  {
   678      BindInfo *bindInfoPtr;
   679  
   680      if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
   681  	Tcl_Panic("TkBindInit: virtual events can't be supported");
   682      }
   683  
   684      /*
   685       * Initialize the static data structures used by the binding package. They
   686       * are only initialized once, no matter how many interps are created.
   687       */
   688  
   689      if (!initialized) {
   690  	Tcl_MutexLock(&bindMutex);
   691  	if (!initialized) {
   692  	    Tcl_HashEntry *hPtr;
   693  	    const ModInfo *modPtr;
   694  	    const EventInfo *eiPtr;
   695  	    int newEntry;
   696  #ifdef REDO_KEYSYM_LOOKUP
   697  	    const KeySymInfo *kPtr;
   698  
   699  	    Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
   700  	    Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
   701  	    for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
   702  		hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &newEntry);
   703  		Tcl_SetHashValue(hPtr, kPtr->value);
   704  		hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
   705  			&newEntry);
   706  		if (newEntry) {
   707  		    Tcl_SetHashValue(hPtr, kPtr->name);
   708  		}
   709  	    }
   710  #endif /* REDO_KEYSYM_LOOKUP */
   711  
   712  	    Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
   713  	    for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
   714  		hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &newEntry);
   715  		Tcl_SetHashValue(hPtr, modPtr);
   716  	    }
   717  
   718  	    Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
   719  	    for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
   720  		hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &newEntry);
   721  		Tcl_SetHashValue(hPtr, eiPtr);
   722  	    }
   723  	    initialized = 1;
   724  	}
   725  	Tcl_MutexUnlock(&bindMutex);
   726      }
   727  
   728      mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
   729  
   730      bindInfoPtr = ckalloc(sizeof(BindInfo));
   731      InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
   732      bindInfoPtr->screenInfo.curDispPtr = NULL;
   733      bindInfoPtr->screenInfo.curScreenIndex = -1;
   734      bindInfoPtr->screenInfo.bindingDepth = 0;
   735      bindInfoPtr->deleted = 0;
   736      mainPtr->bindInfo = bindInfoPtr;
   737  
   738      TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
   739  }
   740  
   741  /*
   742   *---------------------------------------------------------------------------
   743   *
   744   * TkBindFree --
   745   *
   746   *	This function is called when an application is deleted. It deletes all
   747   *	the structures used by bindings and virtual events.
   748   *
   749   * Results:
   750   *	None.
   751   *
   752   * Side effects:
   753   *	Memory freed.
   754   *
   755   *---------------------------------------------------------------------------
   756   */
   757  
   758  void
   759  TkBindFree(
   760      TkMainInfo *mainPtr)	/* The newly created application. */
   761  {
   762      BindInfo *bindInfoPtr;
   763  
   764      Tk_DeleteBindingTable(mainPtr->bindingTable);
   765      mainPtr->bindingTable = NULL;
   766  
   767      bindInfoPtr = mainPtr->bindInfo;
   768      DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
   769      bindInfoPtr->deleted = 1;
   770      Tcl_EventuallyFree(bindInfoPtr, TCL_DYNAMIC);
   771      mainPtr->bindInfo = NULL;
   772  }
   773  
   774  /*
   775   *--------------------------------------------------------------
   776   *
   777   * Tk_CreateBindingTable --
   778   *
   779   *	Set up a new domain in which event bindings may be created.
   780   *
   781   * Results:
   782   *	The return value is a token for the new table, which must be passed to
   783   *	functions like Tk_CreateBinding.
   784   *
   785   * Side effects:
   786   *	Memory is allocated for the new table.
   787   *
   788   *--------------------------------------------------------------
   789   */
   790  
   791  Tk_BindingTable
   792  Tk_CreateBindingTable(
   793      Tcl_Interp *interp)		/* Interpreter to associate with the binding
   794  				 * table: commands are executed in this
   795  				 * interpreter. */
   796  {
   797      BindingTable *bindPtr = ckalloc(sizeof(BindingTable));
   798      int i;
   799  
   800      /*
   801       * Create and initialize a new binding table.
   802       */
   803  
   804      for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
   805  	bindPtr->eventRing[i].type = -1;
   806      }
   807      bindPtr->curEvent = 0;
   808      Tcl_InitHashTable(&bindPtr->patternTable,
   809  	    sizeof(PatternTableKey)/sizeof(int));
   810      Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
   811      bindPtr->interp = interp;
   812      return bindPtr;
   813  }
   814  
   815  /*
   816   *--------------------------------------------------------------
   817   *
   818   * Tk_DeleteBindingTable --
   819   *
   820   *	Destroy a binding table and free up all its memory. The caller should
   821   *	not use bindingTable again after this function returns.
   822   *
   823   * Results:
   824   *	None.
   825   *
   826   * Side effects:
   827   *	Memory is freed.
   828   *
   829   *--------------------------------------------------------------
   830   */
   831  
   832  void
   833  Tk_DeleteBindingTable(
   834      Tk_BindingTable bindPtr)	/* Token for the binding table to destroy. */
   835  {
   836      PatSeq *psPtr, *nextPtr;
   837      Tcl_HashEntry *hPtr;
   838      Tcl_HashSearch search;
   839  
   840      /*
   841       * Find and delete all of the patterns associated with the binding table.
   842       */
   843  
   844      for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
   845  	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
   846  	for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) {
   847  	    nextPtr = psPtr->nextSeqPtr;
   848  	    ckfree(psPtr->script);
   849  	    ckfree(psPtr);
   850  	}
   851      }
   852  
   853      /*
   854       * Clean up the rest of the information associated with the binding table.
   855       */
   856  
   857      Tcl_DeleteHashTable(&bindPtr->patternTable);
   858      Tcl_DeleteHashTable(&bindPtr->objectTable);
   859      ckfree(bindPtr);
   860  }
   861  
   862  /*
   863   *--------------------------------------------------------------
   864   *
   865   * Tk_CreateBinding --
   866   *
   867   *	Add a binding to a binding table, so that future calls to Tk_BindEvent
   868   *	may execute the command in the binding.
   869   *
   870   * Results:
   871   *	The return value is 0 if an error occurred while setting up the
   872   *	binding. In this case, an error message will be left in the interp's
   873   *	result. If all went well then the return value is a mask of the event
   874   *	types that must be made available to Tk_BindEvent in order to properly
   875   *	detect when this binding triggers. This value can be used to determine
   876   *	what events to select for in a window, for example.
   877   *
   878   * Side effects:
   879   *	An existing binding on the same event sequence may be replaced. The
   880   *	new binding may cause future calls to Tk_BindEvent to behave
   881   *	differently than they did previously.
   882   *
   883   *--------------------------------------------------------------
   884   */
   885  
   886  unsigned long
   887  Tk_CreateBinding(
   888      Tcl_Interp *interp,		/* Used for error reporting. */
   889      Tk_BindingTable bindPtr,	/* Table in which to create binding. */
   890      ClientData object,		/* Token for object with which binding is
   891  				 * associated. */
   892      const char *eventString,	/* String describing event sequence that
   893  				 * triggers binding. */
   894      const char *script,		/* Contains Tcl script to execute when
   895  				 * binding triggers. */
   896      int append)			/* 0 means replace any existing binding for
   897  				 * eventString; 1 means append to that
   898  				 * binding. If the existing binding is for a
   899  				 * callback function and not a Tcl command
   900  				 * string, the existing binding will always be
   901  				 * replaced. */
   902  {
   903      PatSeq *psPtr;
   904      unsigned long eventMask;
   905      char *newStr, *oldStr;
   906  
   907      if (!*script) {
   908  	/* Silently ignore empty scripts -- see SF#3006842 */
   909  	return 1;
   910      }
   911      psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
   912  	    1, 1, &eventMask);
   913      if (psPtr == NULL) {
   914  	return 0;
   915      }
   916      if (psPtr->script == NULL) {
   917  	int isNew;
   918  	Tcl_HashEntry *hPtr;
   919  
   920  	/*
   921  	 * This pattern sequence was just created. Link the pattern into the
   922  	 * list associated with the object, so that if the object goes away,
   923  	 * these bindings will all automatically be deleted.
   924  	 */
   925  
   926  	hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
   927  		&isNew);
   928  	if (isNew) {
   929  	    psPtr->nextObjPtr = NULL;
   930  	} else {
   931  	    psPtr->nextObjPtr = Tcl_GetHashValue(hPtr);
   932  	}
   933  	Tcl_SetHashValue(hPtr, psPtr);
   934      }
   935  
   936      oldStr = psPtr->script;
   937      if ((append != 0) && (oldStr != NULL)) {
   938  	size_t length1 = strlen(oldStr), length2 = strlen(script);
   939  
   940  	newStr = ckalloc(length1 + length2 + 2);
   941  	memcpy(newStr, oldStr, length1);
   942  	newStr[length1] = '\n';
   943  	memcpy(newStr+length1+1, script, length2+1);
   944      } else {
   945  	size_t length = strlen(script);
   946  
   947  	newStr = ckalloc(length + 1);
   948  	memcpy(newStr, script, length+1);
   949      }
   950      if (oldStr != NULL) {
   951  	ckfree(oldStr);
   952      }
   953      psPtr->script = newStr;
   954      return eventMask;
   955  }
   956  
   957  /*
   958   *--------------------------------------------------------------
   959   *
   960   * Tk_DeleteBinding --
   961   *
   962   *	Remove an event binding from a binding table.
   963   *
   964   * Results:
   965   *	The result is a standard Tcl return value. If an error occurs then the
   966   *	interp's result will contain an error message.
   967   *
   968   * Side effects:
   969   *	The binding given by object and eventString is removed from
   970   *	bindingTable.
   971   *
   972   *--------------------------------------------------------------
   973   */
   974  
   975  int
   976  Tk_DeleteBinding(
   977      Tcl_Interp *interp,		/* Used for error reporting. */
   978      Tk_BindingTable bindPtr,	/* Table in which to delete binding. */
   979      ClientData object,		/* Token for object with which binding is
   980  				 * associated. */
   981      const char *eventString)	/* String describing event sequence that
   982  				 * triggers binding. */
   983  {
   984      PatSeq *psPtr, *prevPtr;
   985      unsigned long eventMask;
   986      Tcl_HashEntry *hPtr;
   987  
   988      psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
   989  	    0, 1, &eventMask);
   990      if (psPtr == NULL) {
   991  	Tcl_ResetResult(interp);
   992  	return TCL_OK;
   993      }
   994  
   995      /*
   996       * Unlink the binding from the list for its object, then from the list for
   997       * its pattern.
   998       */
   999  
  1000      hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  1001      if (hPtr == NULL) {
  1002  	Tcl_Panic("Tk_DeleteBinding couldn't find object table entry");
  1003      }
  1004      prevPtr = Tcl_GetHashValue(hPtr);
  1005      if (prevPtr == psPtr) {
  1006  	Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
  1007      } else {
  1008  	for ( ; ; prevPtr = prevPtr->nextObjPtr) {
  1009  	    if (prevPtr == NULL) {
  1010  		Tcl_Panic("Tk_DeleteBinding couldn't find on object list");
  1011  	    }
  1012  	    if (prevPtr->nextObjPtr == psPtr) {
  1013  		prevPtr->nextObjPtr = psPtr->nextObjPtr;
  1014  		break;
  1015  	    }
  1016  	}
  1017      }
  1018      prevPtr = Tcl_GetHashValue(psPtr->hPtr);
  1019      if (prevPtr == psPtr) {
  1020  	if (psPtr->nextSeqPtr == NULL) {
  1021  	    Tcl_DeleteHashEntry(psPtr->hPtr);
  1022  	} else {
  1023  	    Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  1024  	}
  1025      } else {
  1026  	for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  1027  	    if (prevPtr == NULL) {
  1028  		Tcl_Panic("Tk_DeleteBinding couldn't find on hash chain");
  1029  	    }
  1030  	    if (prevPtr->nextSeqPtr == psPtr) {
  1031  		prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  1032  		break;
  1033  	    }
  1034  	}
  1035      }
  1036  
  1037      ckfree(psPtr->script);
  1038      ckfree(psPtr);
  1039      return TCL_OK;
  1040  }
  1041  
  1042  /*
  1043   *--------------------------------------------------------------
  1044   *
  1045   * Tk_GetBinding --
  1046   *
  1047   *	Return the script associated with a given event string.
  1048   *
  1049   * Results:
  1050   *	The return value is a pointer to the script associated with
  1051   *	eventString for object in the domain given by bindingTable. If there
  1052   *	is no binding for eventString, or if eventString is improperly formed,
  1053   *	then NULL is returned and an error message is left in the interp's
  1054   *	result. The return value is semi-static: it will persist until the
  1055   *	binding is changed or deleted.
  1056   *
  1057   * Side effects:
  1058   *	None.
  1059   *
  1060   *--------------------------------------------------------------
  1061   */
  1062  
  1063  const char *
  1064  Tk_GetBinding(
  1065      Tcl_Interp *interp,		/* Interpreter for error reporting. */
  1066      Tk_BindingTable bindPtr,	/* Table in which to look for binding. */
  1067      ClientData object,		/* Token for object with which binding is
  1068  				 * associated. */
  1069      const char *eventString)	/* String describing event sequence that
  1070  				 * triggers binding. */
  1071  {
  1072      PatSeq *psPtr;
  1073      unsigned long eventMask;
  1074  
  1075      psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
  1076  	    0, 1, &eventMask);
  1077      if (psPtr == NULL) {
  1078  	return NULL;
  1079      }
  1080      return psPtr->script;
  1081  }
  1082  
  1083  /*
  1084   *--------------------------------------------------------------
  1085   *
  1086   * Tk_GetAllBindings --
  1087   *
  1088   *	Return a list of event strings for all the bindings associated with a
  1089   *	given object.
  1090   *
  1091   * Results:
  1092   *	There is no return value. The interp's result is modified to hold a
  1093   *	Tcl list with one entry for each binding associated with object in
  1094   *	bindingTable. Each entry in the list contains the event string
  1095   *	associated with one binding.
  1096   *
  1097   * Side effects:
  1098   *	None.
  1099   *
  1100   *--------------------------------------------------------------
  1101   */
  1102  
  1103  void
  1104  Tk_GetAllBindings(
  1105      Tcl_Interp *interp,		/* Interpreter returning result or error. */
  1106      Tk_BindingTable bindPtr,	/* Table in which to look for bindings. */
  1107      ClientData object)		/* Token for object. */
  1108  {
  1109      PatSeq *psPtr;
  1110      Tcl_HashEntry *hPtr;
  1111      Tcl_Obj *resultObj;
  1112  
  1113      hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  1114      if (hPtr == NULL) {
  1115  	return;
  1116      }
  1117  
  1118      resultObj = Tcl_NewObj();
  1119      for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
  1120  	    psPtr = psPtr->nextObjPtr) {
  1121  	/*
  1122  	 * For each binding, output information about each of the patterns in
  1123  	 * its sequence.
  1124  	 */
  1125  
  1126  	Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr));
  1127      }
  1128      Tcl_SetObjResult(interp, resultObj);
  1129  }
  1130  
  1131  /*
  1132   *--------------------------------------------------------------
  1133   *
  1134   * Tk_DeleteAllBindings --
  1135   *
  1136   *	Remove all bindings associated with a given object in a given binding
  1137   *	table.
  1138   *
  1139   * Results:
  1140   *	All bindings associated with object are removed from bindingTable.
  1141   *
  1142   * Side effects:
  1143   *	None.
  1144   *
  1145   *--------------------------------------------------------------
  1146   */
  1147  
  1148  void
  1149  Tk_DeleteAllBindings(
  1150      Tk_BindingTable bindPtr,	/* Table in which to delete bindings. */
  1151      ClientData object)		/* Token for object. */
  1152  {
  1153      PatSeq *psPtr, *prevPtr;
  1154      PatSeq *nextPtr;
  1155      Tcl_HashEntry *hPtr;
  1156  
  1157      hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  1158      if (hPtr == NULL) {
  1159  	return;
  1160      }
  1161      for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
  1162  	    psPtr = nextPtr) {
  1163  	nextPtr = psPtr->nextObjPtr;
  1164  
  1165  	/*
  1166  	 * Be sure to remove each binding from its hash chain in the pattern
  1167  	 * table. If this is the last pattern in the chain, then delete the
  1168  	 * hash entry too.
  1169  	 */
  1170  
  1171  	prevPtr = Tcl_GetHashValue(psPtr->hPtr);
  1172  	if (prevPtr == psPtr) {
  1173  	    if (psPtr->nextSeqPtr == NULL) {
  1174  		Tcl_DeleteHashEntry(psPtr->hPtr);
  1175  	    } else {
  1176  		Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  1177  	    }
  1178  	} else {
  1179  	    for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  1180  		if (prevPtr == NULL) {
  1181  		    Tcl_Panic("Tk_DeleteAllBindings couldn't find on hash chain");
  1182  		}
  1183  		if (prevPtr->nextSeqPtr == psPtr) {
  1184  		    prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  1185  		    break;
  1186  		}
  1187  	    }
  1188  	}
  1189  	ckfree(psPtr->script);
  1190  	ckfree(psPtr);
  1191      }
  1192      Tcl_DeleteHashEntry(hPtr);
  1193  }
  1194  
  1195  /*
  1196   *---------------------------------------------------------------------------
  1197   *
  1198   * Tk_BindEvent --
  1199   *
  1200   *	This function is invoked to process an X event. The event is added to
  1201   *	those recorded for the binding table. Then each of the objects at
  1202   *	*objectPtr is checked in order to see if it has a binding that matches
  1203   *	the recent events. If so, the most specific binding is invoked for
  1204   *	each object.
  1205   *
  1206   * Results:
  1207   *	None.
  1208   *
  1209   * Side effects:
  1210   *	Depends on the script associated with the matching binding.
  1211   *
  1212   *	All Tcl binding scripts for each object are accumulated before the
  1213   *	first binding is evaluated. If the action of a Tcl binding is to
  1214   *	change or delete a binding, or delete the window associated with the
  1215   *	binding, all the original Tcl binding scripts will still fire.
  1216   *
  1217   *---------------------------------------------------------------------------
  1218   */
  1219  
  1220  void
  1221  Tk_BindEvent(
  1222      Tk_BindingTable bindPtr,	/* Table in which to look for bindings. */
  1223      XEvent *eventPtr,		/* What actually happened. */
  1224      Tk_Window tkwin,		/* Window on display where event occurred
  1225  				 * (needed in order to locate display
  1226  				 * information). */
  1227      int numObjects,		/* Number of objects at *objectPtr. */
  1228      ClientData *objectPtr)	/* Array of one or more objects to check for a
  1229  				 * matching binding. */
  1230  {
  1231      TkDisplay *dispPtr;
  1232      ScreenInfo *screenPtr;
  1233      BindInfo *bindInfoPtr;
  1234      TkDisplay *oldDispPtr;
  1235      XEvent *ringPtr;
  1236      PatSeq *vMatchDetailList, *vMatchNoDetailList;
  1237      int flags, oldScreen;
  1238      unsigned int scriptCount;
  1239      Tcl_Interp *interp;
  1240      Tcl_DString scripts;
  1241      Tcl_InterpState interpState;
  1242      Detail detail;
  1243      char *p, *end;
  1244      TkWindow *winPtr = (TkWindow *) tkwin;
  1245      PatternTableKey key;
  1246  
  1247      /*
  1248       * Ignore events on windows that don't have names: these are windows like
  1249       * wrapper windows that shouldn't be visible to the application.
  1250       */
  1251  
  1252      if (winPtr->pathName == NULL) {
  1253  	return;
  1254      }
  1255  
  1256      /*
  1257       * Ignore the event completely if it is an Enter, Leave, FocusIn, or
  1258       * FocusOut event with detail NotifyInferior. The reason for ignoring
  1259       * these events is that we don't want transitions between a window and its
  1260       * children to visible to bindings on the parent: this would cause
  1261       * problems for mega-widgets, since the internal structure of a
  1262       * mega-widget isn't supposed to be visible to people watching the parent.
  1263       */
  1264  
  1265      if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
  1266  	if (eventPtr->xcrossing.detail == NotifyInferior) {
  1267  	    return;
  1268  	}
  1269      }
  1270      if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
  1271  	if (eventPtr->xfocus.detail == NotifyInferior) {
  1272  	    return;
  1273  	}
  1274      }
  1275  
  1276      /*
  1277       * Ignore event types which are not in flagArray and all zeroes there.
  1278       * Most notably, NoExpose events can fill the ring buffer and disturb
  1279       * (thus masking out) event sequences of interest.
  1280       */
  1281  
  1282      if ((eventPtr->type >= TK_LASTEVENT) || !flagArray[eventPtr->type]) {
  1283  	return;
  1284      }
  1285  
  1286      dispPtr = ((TkWindow *) tkwin)->dispPtr;
  1287      bindInfoPtr = winPtr->mainPtr->bindInfo;
  1288  
  1289      /*
  1290       * Add the new event to the ring of saved events for the binding table.
  1291       * Two tricky points:
  1292       *
  1293       * 1. Combine consecutive MotionNotify events. Do this by putting the new
  1294       *    event *on top* of the previous event.
  1295       * 2. If a modifier key is held down, it auto-repeats to generate
  1296       *    continuous KeyPress and KeyRelease events. These can flush the event
  1297       *    ring so that valuable information is lost (such as repeated button
  1298       *    clicks). To handle this, check for the special case of a modifier
  1299       *    KeyPress arriving when the previous two events are a KeyRelease and
  1300       *    KeyPress of the same key. If this happens, mark the most recent
  1301       *    event (the KeyRelease) invalid and put the new event on top of the
  1302       *    event before that (the KeyPress).
  1303       */
  1304  
  1305      if ((eventPtr->type == MotionNotify)
  1306  	    && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
  1307  	/*
  1308  	 * Don't advance the ring pointer.
  1309  	 */
  1310      } else if (eventPtr->type == KeyPress) {
  1311  	int i;
  1312  
  1313  	for (i = 0; ; i++) {
  1314  	    if (i >= dispPtr->numModKeyCodes) {
  1315  		goto advanceRingPointer;
  1316  	    }
  1317  	    if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
  1318  		break;
  1319  	    }
  1320  	}
  1321  	ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1322  	if ((ringPtr->type != KeyRelease)
  1323  		|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
  1324  	    goto advanceRingPointer;
  1325  	}
  1326  	if (bindPtr->curEvent <= 0) {
  1327  	    i = EVENT_BUFFER_SIZE - 1;
  1328  	} else {
  1329  	    i = bindPtr->curEvent - 1;
  1330  	}
  1331  	ringPtr = &bindPtr->eventRing[i];
  1332  	if ((ringPtr->type != KeyPress)
  1333  		|| (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
  1334  	    goto advanceRingPointer;
  1335  	}
  1336  	bindPtr->eventRing[bindPtr->curEvent].type = -1;
  1337  	bindPtr->curEvent = i;
  1338      } else {
  1339  
  1340      advanceRingPointer:
  1341  	bindPtr->curEvent++;
  1342  	if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
  1343  	    bindPtr->curEvent = 0;
  1344  	}
  1345      }
  1346      ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1347      memcpy(ringPtr, eventPtr, sizeof(XEvent));
  1348      detail.clientData = 0;
  1349      flags = flagArray[ringPtr->type];
  1350      if (flags & KEY) {
  1351  	detail.keySym = TkpGetKeySym(dispPtr, ringPtr);
  1352  	if (detail.keySym == NoSymbol) {
  1353  	    detail.keySym = 0;
  1354  	}
  1355      } else if (flags & BUTTON) {
  1356  	detail.button = ringPtr->xbutton.button;
  1357      } else if (flags & VIRTUAL) {
  1358  	detail.name = ((XVirtualEvent *) ringPtr)->name;
  1359      }
  1360      bindPtr->detailRing[bindPtr->curEvent] = detail;
  1361  
  1362      /*
  1363       * Find out if there are any virtual events that correspond to this
  1364       * physical event (or sequence of physical events).
  1365       */
  1366  
  1367      vMatchDetailList = NULL;
  1368      vMatchNoDetailList = NULL;
  1369      memset(&key, 0, sizeof(key));
  1370  
  1371      if (ringPtr->type != VirtualEvent) {
  1372  	Tcl_HashTable *veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
  1373  	Tcl_HashEntry *hPtr;
  1374  
  1375  	key.object = NULL;
  1376  	key.type = ringPtr->type;
  1377  	key.detail = detail;
  1378  
  1379  	hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
  1380  	if (hPtr != NULL) {
  1381  	    vMatchDetailList = Tcl_GetHashValue(hPtr);
  1382  	}
  1383  
  1384  	if (key.detail.clientData != 0) {
  1385  	    key.detail.clientData = 0;
  1386  	    hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
  1387  	    if (hPtr != NULL) {
  1388  		vMatchNoDetailList = Tcl_GetHashValue(hPtr);
  1389  	    }
  1390  	}
  1391      }
  1392  
  1393      /*
  1394       * Loop over all the binding tags, finding the binding script or callback
  1395       * for each one. Append all of the binding scripts, with %-sequences
  1396       * expanded, to "scripts", with null characters separating the scripts for
  1397       * each object.
  1398       */
  1399  
  1400      scriptCount = 0;
  1401      Tcl_DStringInit(&scripts);
  1402  
  1403      for ( ; numObjects > 0; numObjects--, objectPtr++) {
  1404  	PatSeq *matchPtr = NULL, *sourcePtr = NULL;
  1405  	Tcl_HashEntry *hPtr;
  1406  
  1407  	/*
  1408  	 * Match the new event against those recorded in the pattern table,
  1409  	 * saving the longest matching pattern. For events with details
  1410  	 * (button and key events), look for a binding for the specific key or
  1411  	 * button. First see if the event matches a physical event that the
  1412  	 * object is interested in, then look for a virtual event.
  1413  	 */
  1414  
  1415  	key.object = *objectPtr;
  1416  	key.type = ringPtr->type;
  1417  	key.detail = detail;
  1418  	hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1419  	if (hPtr != NULL) {
  1420  	    matchPtr = MatchPatterns(dispPtr, bindPtr, Tcl_GetHashValue(hPtr),
  1421  		    matchPtr, NULL, &sourcePtr);
  1422  	}
  1423  
  1424  	if (vMatchDetailList != NULL) {
  1425  	    matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
  1426  		    matchPtr, objectPtr, &sourcePtr);
  1427  	}
  1428  
  1429  	/*
  1430  	 * If no match was found, look for a binding for all keys or buttons
  1431  	 * (detail of 0). Again, first match on a virtual event.
  1432  	 */
  1433  
  1434  	if ((detail.clientData != 0) && (matchPtr == NULL)) {
  1435  	    key.detail.clientData = 0;
  1436  	    hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1437  	    if (hPtr != NULL) {
  1438  		matchPtr = MatchPatterns(dispPtr, bindPtr,
  1439  			Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr);
  1440  	    }
  1441  
  1442  	    if (vMatchNoDetailList != NULL) {
  1443  		matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
  1444  			matchPtr, objectPtr, &sourcePtr);
  1445  	    }
  1446  	}
  1447  
  1448  	if (matchPtr != NULL) {
  1449  	    ExpandPercents(winPtr, sourcePtr->script, eventPtr,
  1450  		    detail.keySym, scriptCount++, &scripts);
  1451  
  1452  	    /*
  1453  	     * A "" is added to the scripts string to separate the various
  1454  	     * scripts that should be invoked.
  1455  	     */
  1456  
  1457  	    Tcl_DStringAppend(&scripts, "", 1);
  1458  	}
  1459      }
  1460      if (Tcl_DStringLength(&scripts) == 0) {
  1461  	return;
  1462      }
  1463  
  1464      /*
  1465       * Now go back through and evaluate the binding for each object, in order,
  1466       * dealing with "break" and "continue" exceptions appropriately.
  1467       *
  1468       * There are two tricks here:
  1469       * 1. Bindings can be invoked from in the middle of Tcl commands, where
  1470       *    the interp's result is significant (for example, a widget might be
  1471       *    deleted because of an error in creating it, so the result contains
  1472       *    an error message that is eventually going to be returned by the
  1473       *    creating command). To preserve the result, we save it in a dynamic
  1474       *    string.
  1475       * 2. The binding's action can potentially delete the binding, so bindPtr
  1476       *    may not point to anything valid once the action completes. Thus we
  1477       *    have to save bindPtr->interp in a local variable in order to restore
  1478       *    the result.
  1479       */
  1480  
  1481      interp = bindPtr->interp;
  1482  
  1483      /*
  1484       * Save information about the current screen, then invoke a script if the
  1485       * screen has changed.
  1486       */
  1487  
  1488      interpState = Tcl_SaveInterpState(interp, TCL_OK);
  1489      screenPtr = &bindInfoPtr->screenInfo;
  1490      oldDispPtr = screenPtr->curDispPtr;
  1491      oldScreen = screenPtr->curScreenIndex;
  1492      if ((dispPtr != screenPtr->curDispPtr)
  1493  	    || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
  1494  	screenPtr->curDispPtr = dispPtr;
  1495  	screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
  1496  	ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
  1497      }
  1498  
  1499      p = Tcl_DStringValue(&scripts);
  1500      end = p + Tcl_DStringLength(&scripts);
  1501  
  1502      /*
  1503       * Be careful when dereferencing screenPtr or bindInfoPtr. If we evaluate
  1504       * something that destroys ".", bindInfoPtr would have been freed, but we
  1505       * can tell that by first checking to see if winPtr->mainPtr == NULL.
  1506       */
  1507  
  1508      Tcl_Preserve(bindInfoPtr);
  1509      while (p < end) {
  1510  	int len = (int) strlen(p);
  1511  	int code;
  1512  
  1513  	if (!bindInfoPtr->deleted) {
  1514  	    screenPtr->bindingDepth++;
  1515  	}
  1516  	Tcl_AllowExceptions(interp);
  1517  
  1518  	code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
  1519  	p += len + 1;
  1520  
  1521  	if (!bindInfoPtr->deleted) {
  1522  	    screenPtr->bindingDepth--;
  1523  	}
  1524  	if (code != TCL_OK) {
  1525  	    if (code == TCL_CONTINUE) {
  1526  		/*
  1527  		 * Do nothing: just go on to the next command.
  1528  		 */
  1529  	    } else if (code == TCL_BREAK) {
  1530  		break;
  1531  	    } else {
  1532  		Tcl_AddErrorInfo(interp, "\n    (command bound to event)");
  1533  		Tcl_BackgroundException(interp, code);
  1534  		break;
  1535  	    }
  1536  	}
  1537      }
  1538  
  1539      if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
  1540  	    && ((oldDispPtr != screenPtr->curDispPtr)
  1541  		    || (oldScreen != screenPtr->curScreenIndex))) {
  1542  	/*
  1543  	 * Some other binding script is currently executing, but its screen is
  1544  	 * no longer current. Change the current display back again.
  1545  	 */
  1546  
  1547  	screenPtr->curDispPtr = oldDispPtr;
  1548  	screenPtr->curScreenIndex = oldScreen;
  1549  	ChangeScreen(interp, oldDispPtr->name, oldScreen);
  1550      }
  1551      (void) Tcl_RestoreInterpState(interp, interpState);
  1552      Tcl_DStringFree(&scripts);
  1553  
  1554      Tcl_Release(bindInfoPtr);
  1555  }
  1556  
  1557  /*
  1558   *----------------------------------------------------------------------
  1559   *
  1560   * MatchPatterns --
  1561   *
  1562   *	Given a list of pattern sequences and a list of recent events, return
  1563   *	the pattern sequence that best matches the event list, if there is
  1564   *	one.
  1565   *
  1566   *	This function is used in two different ways. In the simplest use,
  1567   *	"object" is NULL and psPtr is a list of pattern sequences, each of
  1568   *	which corresponds to a binding. In this case, the function finds the
  1569   *	pattern sequences that match the event list and returns the most
  1570   *	specific of those, if there is more than one.
  1571   *
  1572   *	In the second case, psPtr is a list of pattern sequences, each of
  1573   *	which corresponds to a definition for a virtual binding. In order for
  1574   *	one of these sequences to "match", it must match the events (as above)
  1575   *	but in addition there must be a binding for its associated virtual
  1576   *	event on the current object. The "object" argument indicates which
  1577   *	object the binding must be for.
  1578   *
  1579   * Results:
  1580  
  1581   *	The return value is NULL if bestPtr is NULL and no pattern matches the
  1582   *	recent events from bindPtr. Otherwise the return value is the most
  1583   *	specific pattern sequence among bestPtr and all those at psPtr that
  1584   *	match the event list and object. If a pattern sequence other than
  1585   *	bestPtr is returned, then *bestCommandPtr is filled in with a pointer
  1586   *	to the command from the best sequence.
  1587   *
  1588   * Side effects:
  1589   *	None.
  1590   *
  1591   *----------------------------------------------------------------------
  1592   */
  1593  
  1594  static PatSeq *
  1595  MatchPatterns(
  1596      TkDisplay *dispPtr,		/* Display from which the event came. */
  1597      BindingTable *bindPtr,	/* Information about binding table, such as
  1598  				 * ring of recent events. */
  1599      PatSeq *psPtr,		/* List of pattern sequences. */
  1600      PatSeq *bestPtr,		/* The best match seen so far, from a previous
  1601  				 * call to this function. NULL means no prior
  1602  				 * best match. */
  1603      ClientData *objectPtr,	/* If NULL, the sequences at psPtr correspond
  1604  				 * to "normal" bindings. If non-NULL, the
  1605  				 * sequences at psPtr correspond to virtual
  1606  				 * bindings; in order to match each sequence
  1607  				 * must correspond to a virtual binding for
  1608  				 * which a binding exists for object in
  1609  				 * bindPtr. */
  1610      PatSeq **sourcePtrPtr)	/* Filled with the pattern sequence that
  1611  				 * contains the eventProc and clientData
  1612  				 * associated with the best match. If this
  1613  				 * differs from the return value, it is the
  1614  				 * virtual event that most closely matched the
  1615  				 * return value (a physical event). Not
  1616  				 * modified unless a result other than bestPtr
  1617  				 * is returned. */
  1618  {
  1619      PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
  1620  
  1621      bestSourcePtr = *sourcePtrPtr;
  1622  
  1623      /*
  1624       * Iterate over all the pattern sequences.
  1625       */
  1626  
  1627      for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
  1628  	XEvent *eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1629  	Detail *detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
  1630  	TkPattern *patPtr = psPtr->pats;
  1631  	Window window = eventPtr->xany.window;
  1632  	int patCount, ringCount, flags, state, modMask, i;
  1633  
  1634  	/*
  1635  	 * Iterate over all the patterns in a sequence to be sure that they
  1636  	 * all match.
  1637  	 */
  1638  
  1639  	patCount = psPtr->numPats;
  1640  	ringCount = EVENT_BUFFER_SIZE;
  1641  	while (patCount > 0) {
  1642  	    if (ringCount <= 0) {
  1643  		goto nextSequence;
  1644  	    }
  1645  	    if (eventPtr->xany.type != patPtr->eventType) {
  1646  		/*
  1647  		 * Most of the event types are considered superfluous in that
  1648  		 * they are ignored if they occur in the middle of a pattern
  1649  		 * sequence and have mismatching types. The only ones that
  1650  		 * cannot be ignored are ButtonPress and ButtonRelease events
  1651  		 * (if the next event in the pattern is a KeyPress or
  1652  		 * KeyRelease) and KeyPress and KeyRelease events (if the next
  1653  		 * pattern event is a ButtonPress or ButtonRelease). Here are
  1654  		 * some tricky cases to consider:
  1655  		 * 1. Double-Button or Double-Key events.
  1656  		 * 2. Double-ButtonRelease or Double-KeyRelease events.
  1657  		 * 3. The arrival of various events like Enter and Leave and
  1658  		 *    FocusIn and GraphicsExpose between two button presses or
  1659  		 *    key presses.
  1660  		 * 4. Modifier keys like Shift and Control shouldn't generate
  1661  		 *    conflicts with button events.
  1662  		 */
  1663  
  1664  		if ((patPtr->eventType == KeyPress)
  1665  			|| (patPtr->eventType == KeyRelease)) {
  1666  		    if ((eventPtr->xany.type == ButtonPress)
  1667  			    || (eventPtr->xany.type == ButtonRelease)) {
  1668  			goto nextSequence;
  1669  		    }
  1670  		} else if ((patPtr->eventType == ButtonPress)
  1671  			|| (patPtr->eventType == ButtonRelease)) {
  1672  		    if ((eventPtr->xany.type == KeyPress)
  1673  			    || (eventPtr->xany.type == KeyRelease)) {
  1674  			/*
  1675  			 * Ignore key events if they are modifier keys.
  1676  			 */
  1677  
  1678  			for (i = 0; i < dispPtr->numModKeyCodes; i++) {
  1679  			    if (dispPtr->modKeyCodes[i]
  1680  				    == eventPtr->xkey.keycode) {
  1681  				/*
  1682  				 * This key is a modifier key, so ignore it.
  1683  				 */
  1684  
  1685  				goto nextEvent;
  1686  			    }
  1687  			}
  1688  			goto nextSequence;
  1689  		    }
  1690  		}
  1691  		goto nextEvent;
  1692  	    }
  1693  	    if (eventPtr->xany.type == CreateNotify
  1694  		    && eventPtr->xcreatewindow.parent != window) {
  1695  		goto nextSequence;
  1696  	    } else if (eventPtr->xany.window != window) {
  1697  		goto nextSequence;
  1698  	    }
  1699  
  1700  	    /*
  1701  	     * Note: it's important for the keysym check to go before the
  1702  	     * modifier check, so we can ignore unwanted modifier keys before
  1703  	     * choking on the modifier check.
  1704  	     */
  1705  
  1706  	    if ((patPtr->detail.clientData != 0)
  1707  		    && (patPtr->detail.clientData != detailPtr->clientData)) {
  1708  		/*
  1709  		 * The detail appears not to match. However, if the event is a
  1710  		 * KeyPress for a modifier key then just ignore the event.
  1711  		 * Otherwise event sequences like "aD" never match because the
  1712  		 * shift key goes down between the "a" and the "D".
  1713  		 */
  1714  
  1715  		if (eventPtr->xany.type == KeyPress) {
  1716  		    for (i = 0; i < dispPtr->numModKeyCodes; i++) {
  1717  			if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
  1718  			    goto nextEvent;
  1719  			}
  1720  		    }
  1721  		}
  1722  		goto nextSequence;
  1723  	    }
  1724  	    flags = flagArray[eventPtr->type];
  1725  	    if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
  1726  		state = eventPtr->xkey.state;
  1727  	    } else if (flags & CROSSING) {
  1728  		state = eventPtr->xcrossing.state;
  1729  	    } else {
  1730  		state = 0;
  1731  	    }
  1732  	    if (patPtr->needMods != 0) {
  1733  		modMask = patPtr->needMods;
  1734  		if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
  1735  		    modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
  1736  		}
  1737  		if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
  1738  		    modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
  1739  		}
  1740  
  1741  		if ((state & META_MASK) && (dispPtr->metaModMask != 0)) {
  1742  		    state = (state & ~META_MASK) | dispPtr->metaModMask;
  1743  		}
  1744  		if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) {
  1745  		    state = (state & ~ALT_MASK) | dispPtr->altModMask;
  1746  		}
  1747  
  1748  		if ((state & modMask) != modMask) {
  1749  		    goto nextSequence;
  1750  		}
  1751  	    }
  1752  	    if (psPtr->flags & PAT_NEARBY) {
  1753  		XEvent *firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1754  		long timeDiff;
  1755  
  1756  		timeDiff = ((long)firstPtr->xkey.time -
  1757  			    (long)eventPtr->xkey.time);
  1758  		if ((firstPtr->xkey.x_root
  1759  			    < (eventPtr->xkey.x_root - NEARBY_PIXELS))
  1760  			|| (firstPtr->xkey.x_root
  1761  			    > (eventPtr->xkey.x_root + NEARBY_PIXELS))
  1762  			|| (firstPtr->xkey.y_root
  1763  			    < (eventPtr->xkey.y_root - NEARBY_PIXELS))
  1764  			|| (firstPtr->xkey.y_root
  1765  			    > (eventPtr->xkey.y_root + NEARBY_PIXELS))
  1766  			|| (timeDiff > NEARBY_MS)) {
  1767  		    goto nextSequence;
  1768  		}
  1769  	    }
  1770  	    patPtr++;
  1771  	    patCount--;
  1772  	nextEvent:
  1773  	    if (eventPtr == bindPtr->eventRing) {
  1774  		eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
  1775  		detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
  1776  	    } else {
  1777  		eventPtr--;
  1778  		detailPtr--;
  1779  	    }
  1780  	    ringCount--;
  1781  	}
  1782  
  1783  	matchPtr = psPtr;
  1784  	sourcePtr = psPtr;
  1785  
  1786  	if (objectPtr != NULL) {
  1787  	    int iVirt;
  1788  	    VirtualOwners *voPtr;
  1789  	    PatternTableKey key;
  1790  
  1791  	    /*
  1792  	     * The sequence matches the physical constraints. Is this object
  1793  	     * interested in any of the virtual events that correspond to this
  1794  	     * sequence?
  1795  	     */
  1796  
  1797  	    voPtr = psPtr->voPtr;
  1798  
  1799  	    memset(&key, 0, sizeof(key));
  1800  	    key.object = *objectPtr;
  1801  	    key.type = VirtualEvent;
  1802  	    key.detail.clientData = 0;
  1803  
  1804  	    for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
  1805  		Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
  1806  
  1807  		key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
  1808  			hPtr);
  1809  		hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
  1810  			(char *) &key);
  1811  		if (hPtr != NULL) {
  1812  		    /*
  1813  		     * This tag is interested in this virtual event and its
  1814  		     * corresponding physical event is a good match with the
  1815  		     * virtual event's definition.
  1816  		     */
  1817  
  1818  		    PatSeq *virtMatchPtr = Tcl_GetHashValue(hPtr);
  1819  
  1820  		    if ((virtMatchPtr->numPats != 1)
  1821  			    || (virtMatchPtr->nextSeqPtr != NULL)) {
  1822  			Tcl_Panic("MatchPattern: badly constructed virtual event");
  1823  		    }
  1824  		    sourcePtr = virtMatchPtr;
  1825  		    goto match;
  1826  		}
  1827  	    }
  1828  
  1829  	    /*
  1830  	     * The physical event matches a virtual event's definition, but
  1831  	     * the tag isn't interested in it.
  1832  	     */
  1833  
  1834  	    goto nextSequence;
  1835  	}
  1836      match:
  1837  
  1838  	/*
  1839  	 * This sequence matches. If we've already got another match, pick
  1840  	 * whichever is most specific. Detail is most important, then
  1841  	 * needMods.
  1842  	 */
  1843  
  1844  	if (bestPtr != NULL) {
  1845  	    TkPattern *patPtr2;
  1846  
  1847  	    if (matchPtr->numPats != bestPtr->numPats) {
  1848  		if (bestPtr->numPats > matchPtr->numPats) {
  1849  		    goto nextSequence;
  1850  		} else {
  1851  		    goto newBest;
  1852  		}
  1853  	    }
  1854  	    for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
  1855  		    i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
  1856  		if (patPtr->detail.clientData != patPtr2->detail.clientData) {
  1857  		    if (patPtr->detail.clientData == 0) {
  1858  			goto nextSequence;
  1859  		    } else {
  1860  			goto newBest;
  1861  		    }
  1862  		}
  1863  		if (patPtr->needMods != patPtr2->needMods) {
  1864  		    if ((patPtr->needMods & patPtr2->needMods)
  1865  			    == patPtr->needMods) {
  1866  			goto nextSequence;
  1867  		    } else if ((patPtr->needMods & patPtr2->needMods)
  1868  			    == patPtr2->needMods) {
  1869  			goto newBest;
  1870  		    }
  1871  		}
  1872  	    }
  1873  
  1874  	    /*
  1875  	     * Tie goes to current best pattern.
  1876  	     *
  1877  	     * (1) For virtual vs. virtual, the least recently defined virtual
  1878  	     * wins, because virtuals are examined in order of definition.
  1879  	     * This order is _not_ guaranteed in the documentation.
  1880  	     *
  1881  	     * (2) For virtual vs. physical, the physical wins because all the
  1882  	     * physicals are examined before the virtuals. This order is
  1883  	     * guaranteed in the documentation.
  1884  	     *
  1885  	     * (3) For physical vs. physical pattern, the most recently
  1886  	     * defined physical wins, because physicals are examined in
  1887  	     * reverse order of definition. This order is guaranteed in the
  1888  	     * documentation.
  1889  	     */
  1890  
  1891  	    goto nextSequence;
  1892  	}
  1893      newBest:
  1894  	bestPtr = matchPtr;
  1895  	bestSourcePtr = sourcePtr;
  1896  
  1897      nextSequence:
  1898  	continue;
  1899      }
  1900  
  1901      *sourcePtrPtr = bestSourcePtr;
  1902      return bestPtr;
  1903  }
  1904  
  1905  /*
  1906   *--------------------------------------------------------------
  1907   *
  1908   * ExpandPercents --
  1909   *
  1910   *	Given a command and an event, produce a new command by replacing %
  1911   *	constructs in the original command with information from the X event.
  1912   *
  1913   * Results:
  1914   *	The new expanded command is appended to the dynamic string given by
  1915   *	dsPtr.
  1916   *
  1917   * Side effects:
  1918   *	None.
  1919   *
  1920   *--------------------------------------------------------------
  1921   */
  1922  
  1923  static void
  1924  ExpandPercents(
  1925      TkWindow *winPtr,		/* Window where event occurred: needed to get
  1926  				 * input context. */
  1927      const char *before,		/* Command containing percent expressions to
  1928  				 * be replaced. */
  1929      XEvent *eventPtr,		/* X event containing information to be used
  1930  				 * in % replacements. */
  1931      KeySym keySym,		/* KeySym: only relevant for KeyPress and
  1932  				 * KeyRelease events). */
  1933      unsigned int scriptCount,	/* The number of script-based binding patterns
  1934  				 * matched so far for this event. */
  1935      Tcl_DString *dsPtr)		/* Dynamic string in which to append new
  1936  				 * command. */
  1937  {
  1938      int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
  1939  				 * list element. */
  1940      int number, flags, length;
  1941  #define NUM_SIZE 40
  1942      const char *string;
  1943      Tcl_DString buf;
  1944      char numStorage[NUM_SIZE+1];
  1945  
  1946      Tcl_DStringInit(&buf);
  1947  
  1948      if (eventPtr->type < TK_LASTEVENT) {
  1949  	flags = flagArray[eventPtr->type];
  1950      } else {
  1951  	flags = 0;
  1952      }
  1953  
  1954      while (1) {
  1955  	/*
  1956  	 * Find everything up to the next % character and append it to the
  1957  	 * result string.
  1958  	 */
  1959  
  1960  	for (string = before; (*string != 0) && (*string != '%'); string++) {
  1961  	    /* Empty loop body. */
  1962  	}
  1963  	if (string != before) {
  1964  	    Tcl_DStringAppend(dsPtr, before, (int) (string-before));
  1965  	    before = string;
  1966  	}
  1967  	if (*before == 0) {
  1968  	    break;
  1969  	}
  1970  
  1971  	/*
  1972  	 * There's a percent sequence here. Process it.
  1973  	 */
  1974  
  1975  	number = 0;
  1976  	string = "??";
  1977  	switch (before[1]) {
  1978  	case '#':
  1979  	    number = eventPtr->xany.serial;
  1980  	    goto doNumber;
  1981  	case 'a':
  1982  	    if (flags & CONFIG) {
  1983  		TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
  1984  		string = numStorage;
  1985  	    }
  1986  	    goto doString;
  1987  	case 'b':
  1988  	    if (flags & BUTTON) {
  1989  		number = eventPtr->xbutton.button;
  1990  		goto doNumber;
  1991  	    }
  1992  	    goto doString;
  1993  	case 'c':
  1994  	    if (flags & EXPOSE) {
  1995  		number = eventPtr->xexpose.count;
  1996  		goto doNumber;
  1997  	    }
  1998  	    goto doString;
  1999  	case 'd':
  2000  	    if (flags & (CROSSING|FOCUS)) {
  2001  		if (flags & FOCUS) {
  2002  		    number = eventPtr->xfocus.detail;
  2003  		} else {
  2004  		    number = eventPtr->xcrossing.detail;
  2005  		}
  2006  		string = TkFindStateString(notifyDetail, number);
  2007  	    } else if (flags & CONFIGREQ) {
  2008  		if (eventPtr->xconfigurerequest.value_mask & CWStackMode) {
  2009  		    string = TkFindStateString(configureRequestDetail,
  2010  			    eventPtr->xconfigurerequest.detail);
  2011  		} else {
  2012  		    string = "";
  2013  		}
  2014  	    } else if (flags & VIRTUAL) {
  2015  		XVirtualEvent *vePtr = (XVirtualEvent *) eventPtr;
  2016  
  2017  		if (vePtr->user_data != NULL) {
  2018  		    string = Tcl_GetString(vePtr->user_data);
  2019  		} else {
  2020  		    string = "";
  2021  		}
  2022  	    }
  2023  	    goto doString;
  2024  	case 'f':
  2025  	    if (flags & CROSSING) {
  2026  		number = eventPtr->xcrossing.focus;
  2027  		goto doNumber;
  2028  	    }
  2029  	    goto doString;
  2030  	case 'h':
  2031  	    if (flags & EXPOSE) {
  2032  		number = eventPtr->xexpose.height;
  2033  	    } else if (flags & CONFIG) {
  2034  		number = eventPtr->xconfigure.height;
  2035  	    } else if (flags & CREATE) {
  2036  		number = eventPtr->xcreatewindow.height;
  2037  	    } else if (flags & CONFIGREQ) {
  2038  		number = eventPtr->xconfigurerequest.height;
  2039  	    } else if (flags & RESIZEREQ) {
  2040  		number = eventPtr->xresizerequest.height;
  2041  	    } else {
  2042  		goto doString;
  2043  	    }
  2044  	    goto doNumber;
  2045  	case 'i':
  2046  	    if (flags & CREATE) {
  2047  		TkpPrintWindowId(numStorage, eventPtr->xcreatewindow.window);
  2048  	    } else if (flags & CONFIGREQ) {
  2049  		TkpPrintWindowId(numStorage,
  2050  			eventPtr->xconfigurerequest.window);
  2051  	    } else if (flags & MAPREQ) {
  2052  		TkpPrintWindowId(numStorage, eventPtr->xmaprequest.window);
  2053  	    } else {
  2054  		TkpPrintWindowId(numStorage, eventPtr->xany.window);
  2055  	    }
  2056  	    string = numStorage;
  2057  	    goto doString;
  2058  	case 'k':
  2059  	    if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
  2060  		number = eventPtr->xkey.keycode;
  2061  		goto doNumber;
  2062  	    }
  2063  	    goto doString;
  2064  	case 'm':
  2065  	    if (flags & CROSSING) {
  2066  		number = eventPtr->xcrossing.mode;
  2067  		string = TkFindStateString(notifyMode, number);
  2068  	    } else if (flags & FOCUS) {
  2069  		number = eventPtr->xfocus.mode;
  2070  		string = TkFindStateString(notifyMode, number);
  2071  	    }
  2072  	    goto doString;
  2073  	case 'o':
  2074  	    if (flags & CREATE) {
  2075  		number = eventPtr->xcreatewindow.override_redirect;
  2076  	    } else if (flags & MAP) {
  2077  		number = eventPtr->xmap.override_redirect;
  2078  	    } else if (flags & REPARENT) {
  2079  		number = eventPtr->xreparent.override_redirect;
  2080  	    } else if (flags & CONFIG) {
  2081  		number = eventPtr->xconfigure.override_redirect;
  2082  	    } else {
  2083  		goto doString;
  2084  	    }
  2085  	    goto doNumber;
  2086  	case 'p':
  2087  	    if (flags & CIRC) {
  2088  		string = TkFindStateString(circPlace,
  2089  			eventPtr->xcirculate.place);
  2090  	    } else if (flags & CIRCREQ) {
  2091  		string = TkFindStateString(circPlace,
  2092  			eventPtr->xcirculaterequest.place);
  2093  	    }
  2094  	    goto doString;
  2095  	case 's':
  2096  	    if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
  2097  		number = eventPtr->xkey.state;
  2098  		goto doNumber;
  2099  	    } else if (flags & CROSSING) {
  2100  		number = eventPtr->xcrossing.state;
  2101  		goto doNumber;
  2102  	    } else if (flags & PROP) {
  2103  		string = TkFindStateString(propNotify,
  2104  			eventPtr->xproperty.state);
  2105  	    } else if (flags & VISIBILITY) {
  2106  		string = TkFindStateString(visNotify,
  2107  			eventPtr->xvisibility.state);
  2108  	    }
  2109  	    goto doString;
  2110  	case 't':
  2111  	    if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
  2112  		number = (int) eventPtr->xkey.time;
  2113  	    } else if (flags & CROSSING) {
  2114  		number = (int) eventPtr->xcrossing.time;
  2115  	    } else if (flags & PROP) {
  2116  		number = (int) eventPtr->xproperty.time;
  2117  	    } else {
  2118  		goto doString;
  2119  	    }
  2120  	    goto doNumber;
  2121  	case 'v':
  2122  	    number = eventPtr->xconfigurerequest.value_mask;
  2123  	    goto doNumber;
  2124  	case 'w':
  2125  	    if (flags & EXPOSE) {
  2126  		number = eventPtr->xexpose.width;
  2127  	    } else if (flags & CONFIG) {
  2128  		number = eventPtr->xconfigure.width;
  2129  	    } else if (flags & CREATE) {
  2130  		number = eventPtr->xcreatewindow.width;
  2131  	    } else if (flags & CONFIGREQ) {
  2132  		number = eventPtr->xconfigurerequest.width;
  2133  	    } else if (flags & RESIZEREQ) {
  2134  		number = eventPtr->xresizerequest.width;
  2135  	    } else {
  2136  		goto doString;
  2137  	    }
  2138  	    goto doNumber;
  2139  	case 'x':
  2140  	    if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
  2141  		number = eventPtr->xkey.x;
  2142  	    } else if (flags & CROSSING) {
  2143  		number = eventPtr->xcrossing.x;
  2144  	    } else if (flags & EXPOSE) {
  2145  		number = eventPtr->xexpose.x;
  2146  	    } else if (flags & (CREATE|CONFIG|GRAVITY)) {
  2147  		number = eventPtr->xcreatewindow.x;
  2148  	    } else if (flags & REPARENT) {
  2149  		number = eventPtr->xreparent.x;
  2150  	    } else if (flags & CREATE) {
  2151  		number = eventPtr->xcreatewindow.x;
  2152  	    } else if (flags & CONFIGREQ) {
  2153  		number = eventPtr->xconfigurerequest.x;
  2154  	    } else {
  2155  		goto doString;
  2156  	    }
  2157  	    goto doNumber;
  2158  	case 'y':
  2159  	    if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
  2160  		number = eventPtr->xkey.y;
  2161  	    } else if (flags & EXPOSE) {
  2162  		number = eventPtr->xexpose.y;
  2163  	    } else if (flags & (CREATE|CONFIG|GRAVITY)) {
  2164  		number = eventPtr->xcreatewindow.y;
  2165  	    } else if (flags & REPARENT) {
  2166  		number = eventPtr->xreparent.y;
  2167  	    } else if (flags & CROSSING) {
  2168  		number = eventPtr->xcrossing.y;
  2169  	    } else if (flags & CREATE) {
  2170  		number = eventPtr->xcreatewindow.y;
  2171  	    } else if (flags & CONFIGREQ) {
  2172  		number = eventPtr->xconfigurerequest.y;
  2173  	    } else {
  2174  		goto doString;
  2175  	    }
  2176  	    goto doNumber;
  2177  	case 'A':
  2178  	    if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
  2179  		Tcl_DStringFree(&buf);
  2180  		string = TkpGetString(winPtr, eventPtr, &buf);
  2181  	    }
  2182  	    goto doString;
  2183  	case 'B':
  2184  	    if (flags & CREATE) {
  2185  		number = eventPtr->xcreatewindow.border_width;
  2186  	    } else if (flags & CONFIGREQ) {
  2187  		number = eventPtr->xconfigurerequest.border_width;
  2188  	    } else if (flags & CONFIG) {
  2189  		number = eventPtr->xconfigure.border_width;
  2190  	    } else {
  2191  		goto doString;
  2192  	    }
  2193  	    goto doNumber;
  2194  	case 'D':
  2195  	    /*
  2196  	     * This is used only by the MouseWheel event.
  2197  	     */
  2198  
  2199  	    if ((flags & KEY) && (eventPtr->type == MouseWheelEvent)) {
  2200  		number = eventPtr->xkey.keycode;
  2201  		goto doNumber;
  2202  	    }
  2203  	    goto doString;
  2204  	case 'E':
  2205  	    number = (int) eventPtr->xany.send_event;
  2206  	    goto doNumber;
  2207  	case 'K':
  2208  	    if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
  2209  		const char *name = TkKeysymToString(keySym);
  2210  
  2211  		if (name != NULL) {
  2212  		    string = name;
  2213  		}
  2214  	    }
  2215  	    goto doString;
  2216  	case 'M':
  2217  	    number = scriptCount;
  2218  	    goto doNumber;
  2219  	case 'N':
  2220  	    if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) {
  2221  		number = (int) keySym;
  2222  		goto doNumber;
  2223  	    }
  2224  	    goto doString;
  2225  	case 'P':
  2226  	    if (flags & PROP) {
  2227  		string = Tk_GetAtomName((Tk_Window) winPtr,
  2228  			eventPtr->xproperty.atom);
  2229  	    }
  2230  	    goto doString;
  2231  	case 'R':
  2232  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  2233  		TkpPrintWindowId(numStorage, eventPtr->xkey.root);
  2234  		string = numStorage;
  2235  	    }
  2236  	    goto doString;
  2237  	case 'S':
  2238  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  2239  		TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
  2240  		string = numStorage;
  2241  	    }
  2242  	    goto doString;
  2243  	case 'T':
  2244  	    number = eventPtr->type;
  2245  	    goto doNumber;
  2246  	case 'W': {
  2247  	    Tk_Window tkwin;
  2248  
  2249  	    tkwin = Tk_IdToWindow(eventPtr->xany.display,
  2250  		    eventPtr->xany.window);
  2251  	    if (tkwin != NULL) {
  2252  		string = Tk_PathName(tkwin);
  2253  	    } else {
  2254  		string = "??";
  2255  	    }
  2256  	    goto doString;
  2257  	}
  2258  	case 'X':
  2259  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  2260  
  2261  		number = eventPtr->xkey.x_root;
  2262  		Tk_IdToWindow(eventPtr->xany.display,
  2263  			eventPtr->xany.window);
  2264  		goto doNumber;
  2265  	    }
  2266  	    goto doString;
  2267  	case 'Y':
  2268  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  2269  
  2270  		number = eventPtr->xkey.y_root;
  2271  		Tk_IdToWindow(eventPtr->xany.display,
  2272  			eventPtr->xany.window);
  2273  		goto doNumber;
  2274  	    }
  2275  	    goto doString;
  2276  	default:
  2277  	    numStorage[0] = before[1];
  2278  	    numStorage[1] = '\0';
  2279  	    string = numStorage;
  2280  	    goto doString;
  2281  	}
  2282  
  2283      doNumber:
  2284  	sprintf(numStorage, "%d", number);
  2285  	string = numStorage;
  2286  
  2287      doString:
  2288  	spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
  2289  	length = Tcl_DStringLength(dsPtr);
  2290  	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
  2291  	spaceNeeded = Tcl_ConvertElement(string,
  2292  		Tcl_DStringValue(dsPtr) + length,
  2293  		cvtFlags | TCL_DONT_USE_BRACES);
  2294  	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
  2295  	before += 2;
  2296      }
  2297      Tcl_DStringFree(&buf);
  2298  }
  2299  
  2300  /*
  2301   *----------------------------------------------------------------------
  2302   *
  2303   * ChangeScreen --
  2304   *
  2305   *	This function is invoked whenever the current screen changes in an
  2306   *	application. It invokes a Tcl command named "tk::ScreenChanged",
  2307   *	passing it the screen name as argument. tk::ScreenChanged does things
  2308   *	like making the tk::Priv variable point to an array for the current
  2309   *	display.
  2310   *
  2311   * Results:
  2312   *	None.
  2313   *
  2314   * Side effects:
  2315   *	Depends on what tk::ScreenChanged does. If an error occurs then
  2316   *	bgerror will be invoked.
  2317   *
  2318   *----------------------------------------------------------------------
  2319   */
  2320  
  2321  static void
  2322  ChangeScreen(
  2323      Tcl_Interp *interp,		/* Interpreter in which to invoke command. */
  2324      char *dispName,		/* Name of new display. */
  2325      int screenIndex)		/* Index of new screen. */
  2326  {
  2327      Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d",
  2328  	    dispName, screenIndex);
  2329      int code;
  2330  
  2331      Tcl_IncrRefCount(cmdObj);
  2332      code = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL);
  2333      if (code != TCL_OK) {
  2334  	Tcl_AddErrorInfo(interp,
  2335  		"\n    (changing screen in event binding)");
  2336  	Tcl_BackgroundException(interp, code);
  2337      }
  2338      Tcl_DecrRefCount(cmdObj);
  2339  }
  2340  
  2341  /*
  2342   *----------------------------------------------------------------------
  2343   *
  2344   * Tk_EventCmd --
  2345   *
  2346   *	This function is invoked to process the "event" Tcl command. It is
  2347   *	used to define and generate events.
  2348   *
  2349   * Results:
  2350   *	A standard Tcl result.
  2351   *
  2352   * Side effects:
  2353   *	See the user documentation.
  2354   *
  2355   *----------------------------------------------------------------------
  2356   */
  2357  
  2358  int
  2359  Tk_EventObjCmd(
  2360      ClientData clientData,	/* Main window associated with interpreter. */
  2361      Tcl_Interp *interp,		/* Current interpreter. */
  2362      int objc,			/* Number of arguments. */
  2363      Tcl_Obj *const objv[])	/* Argument objects. */
  2364  {
  2365      int index, i;
  2366      char *name;
  2367      const char *event;
  2368      Tk_Window tkwin = clientData;
  2369      TkBindInfo bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
  2370      VirtualEventTable *vetPtr = &bindInfo->virtualEventTable;
  2371      static const char *const optionStrings[] = {
  2372  	"add",		"delete",	"generate",	"info",
  2373  	NULL
  2374      };
  2375      enum options {
  2376  	EVENT_ADD,	EVENT_DELETE,	EVENT_GENERATE,	EVENT_INFO
  2377      };
  2378  
  2379  
  2380      if (objc < 2) {
  2381  	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
  2382  	return TCL_ERROR;
  2383      }
  2384      if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings,
  2385  	    sizeof(char *), "option", 0, &index) != TCL_OK) {
  2386  	return TCL_ERROR;
  2387      }
  2388  
  2389      switch ((enum options) index) {
  2390      case EVENT_ADD:
  2391  	if (objc < 4) {
  2392  	    Tcl_WrongNumArgs(interp, 2, objv,
  2393  		    "virtual sequence ?sequence ...?");
  2394  	    return TCL_ERROR;
  2395  	}
  2396  	name = Tcl_GetString(objv[2]);
  2397  	for (i = 3; i < objc; i++) {
  2398  	    event = Tcl_GetString(objv[i]);
  2399  	    if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
  2400  		return TCL_ERROR;
  2401  	    }
  2402  	}
  2403  	break;
  2404      case EVENT_DELETE:
  2405  	if (objc < 3) {
  2406  	    Tcl_WrongNumArgs(interp, 2, objv, "virtual ?sequence ...?");
  2407  	    return TCL_ERROR;
  2408  	}
  2409  	name = Tcl_GetString(objv[2]);
  2410  	if (objc == 3) {
  2411  	    return DeleteVirtualEvent(interp, vetPtr, name, NULL);
  2412  	}
  2413  	for (i = 3; i < objc; i++) {
  2414  	    event = Tcl_GetString(objv[i]);
  2415  	    if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {
  2416  		return TCL_ERROR;
  2417  	    }
  2418  	}
  2419  	break;
  2420      case EVENT_GENERATE:
  2421  	if (objc < 4) {
  2422  	    Tcl_WrongNumArgs(interp, 2, objv,
  2423  		    "window event ?-option value ...?");
  2424  	    return TCL_ERROR;
  2425  	}
  2426  	return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);
  2427      case EVENT_INFO:
  2428  	if (objc == 2) {
  2429  	    GetAllVirtualEvents(interp, vetPtr);
  2430  	    return TCL_OK;
  2431  	} else if (objc == 3) {
  2432  	    return GetVirtualEvent(interp, vetPtr, objv[2]);
  2433  	} else {
  2434  	    Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
  2435  	    return TCL_ERROR;
  2436  	}
  2437      }
  2438      return TCL_OK;
  2439  }
  2440  
  2441  /*
  2442   *---------------------------------------------------------------------------
  2443   *
  2444   * InitVirtualEventTable --
  2445   *
  2446   *	Given storage for a virtual event table, set up the fields to prepare
  2447   *	a new domain in which virtual events may be defined.
  2448   *
  2449   * Results:
  2450   *	None.
  2451   *
  2452   * Side effects:
  2453   *	*vetPtr is now initialized.
  2454   *
  2455   *---------------------------------------------------------------------------
  2456   */
  2457  
  2458  static void
  2459  InitVirtualEventTable(
  2460      VirtualEventTable *vetPtr)	/* Pointer to virtual event table. Memory is
  2461  				 * supplied by the caller. */
  2462  {
  2463      Tcl_InitHashTable(&vetPtr->patternTable,
  2464  	    sizeof(PatternTableKey) / sizeof(int));
  2465      Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
  2466  }
  2467  
  2468  /*
  2469   *---------------------------------------------------------------------------
  2470   *
  2471   * DeleteVirtualEventTable --
  2472   *
  2473   *	Delete the contents of a virtual event table. The caller is
  2474   *	responsible for freeing any memory used by the table itself.
  2475   *
  2476   * Results:
  2477   *	None.
  2478   *
  2479   * Side effects:
  2480   *	Memory is freed.
  2481   *
  2482   *---------------------------------------------------------------------------
  2483   */
  2484  
  2485  static void
  2486  DeleteVirtualEventTable(
  2487      VirtualEventTable *vetPtr)	/* The virtual event table to delete. */
  2488  {
  2489      Tcl_HashEntry *hPtr;
  2490      Tcl_HashSearch search;
  2491      PatSeq *psPtr, *nextPtr;
  2492  
  2493      hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
  2494      for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  2495  	psPtr = Tcl_GetHashValue(hPtr);
  2496  	for ( ; psPtr != NULL; psPtr = nextPtr) {
  2497  	    nextPtr = psPtr->nextSeqPtr;
  2498  	    ckfree(psPtr->voPtr);
  2499  	    ckfree(psPtr);
  2500  	}
  2501      }
  2502      Tcl_DeleteHashTable(&vetPtr->patternTable);
  2503  
  2504      hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
  2505      for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  2506  	ckfree(Tcl_GetHashValue(hPtr));
  2507      }
  2508      Tcl_DeleteHashTable(&vetPtr->nameTable);
  2509  }
  2510  
  2511  /*
  2512   *----------------------------------------------------------------------
  2513   *
  2514   * CreateVirtualEvent --
  2515   *
  2516   *	Add a new definition for a virtual event. If the virtual event is
  2517   *	already defined, the new definition augments those that already exist.
  2518   *
  2519   * Results:
  2520   *	The return value is TCL_ERROR if an error occured while creating the
  2521   *	virtual binding. In this case, an error message will be left in the
  2522   *	interp's result. If all went well then the return value is TCL_OK.
  2523   *
  2524   * Side effects:
  2525   *	The virtual event may cause future calls to Tk_BindEvent to behave
  2526   *	differently than they did previously.
  2527   *
  2528   *----------------------------------------------------------------------
  2529   */
  2530  
  2531  static int
  2532  CreateVirtualEvent(
  2533      Tcl_Interp *interp,		/* Used for error reporting. */
  2534      VirtualEventTable *vetPtr,	/* Table in which to augment virtual event. */
  2535      char *virtString,		/* Name of new virtual event. */
  2536      const char *eventString)		/* String describing physical event that
  2537  				 * triggers virtual event. */
  2538  {
  2539      PatSeq *psPtr;
  2540      int dummy;
  2541      Tcl_HashEntry *vhPtr;
  2542      unsigned long eventMask;
  2543      PhysicalsOwned *poPtr;
  2544      VirtualOwners *voPtr;
  2545      Tk_Uid virtUid;
  2546  
  2547      virtUid = GetVirtualEventUid(interp, virtString);
  2548      if (virtUid == NULL) {
  2549  	return TCL_ERROR;
  2550      }
  2551  
  2552      /*
  2553       * Find/create physical event
  2554       */
  2555  
  2556      psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
  2557  	    1, 0, &eventMask);
  2558      if (psPtr == NULL) {
  2559  	return TCL_ERROR;
  2560      }
  2561  
  2562      /*
  2563       * Find/create virtual event.
  2564       */
  2565  
  2566      vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
  2567  
  2568      /*
  2569       * Make virtual event own the physical event.
  2570       */
  2571  
  2572      poPtr = Tcl_GetHashValue(vhPtr);
  2573      if (poPtr == NULL) {
  2574  	poPtr = ckalloc(sizeof(PhysicalsOwned));
  2575  	poPtr->numOwned = 0;
  2576      } else {
  2577  	/*
  2578  	 * See if this virtual event is already defined for this physical
  2579  	 * event and just return if it is.
  2580  	 */
  2581  
  2582  	int i;
  2583  
  2584  	for (i = 0; i < poPtr->numOwned; i++) {
  2585  	    if (poPtr->patSeqs[i] == psPtr) {
  2586  		return TCL_OK;
  2587  	    }
  2588  	}
  2589  	poPtr = ckrealloc(poPtr, sizeof(PhysicalsOwned)
  2590  		+ poPtr->numOwned * sizeof(PatSeq *));
  2591      }
  2592      Tcl_SetHashValue(vhPtr, poPtr);
  2593      poPtr->patSeqs[poPtr->numOwned] = psPtr;
  2594      poPtr->numOwned++;
  2595  
  2596      /*
  2597       * Make physical event so it can trigger the virtual event.
  2598       */
  2599  
  2600      voPtr = psPtr->voPtr;
  2601      if (voPtr == NULL) {
  2602  	voPtr = ckalloc(sizeof(VirtualOwners));
  2603  	voPtr->numOwners = 0;
  2604      } else {
  2605  	voPtr = ckrealloc(voPtr, sizeof(VirtualOwners)
  2606  		+ voPtr->numOwners * sizeof(Tcl_HashEntry *));
  2607      }
  2608      psPtr->voPtr = voPtr;
  2609      voPtr->owners[voPtr->numOwners] = vhPtr;
  2610      voPtr->numOwners++;
  2611  
  2612      return TCL_OK;
  2613  }
  2614  
  2615  /*
  2616   *--------------------------------------------------------------
  2617   *
  2618   * DeleteVirtualEvent --
  2619   *
  2620   *	Remove the definition of a given virtual event. If the event string is
  2621   *	NULL, all definitions of the virtual event will be removed.
  2622   *	Otherwise, just the specified definition of the virtual event will be
  2623   *	removed.
  2624   *
  2625   * Results:
  2626   *	The result is a standard Tcl return value. If an error occurs then the
  2627   *	interp's result will contain an error message. It is not an error to
  2628   *	attempt to delete a virtual event that does not exist or a definition
  2629   *	that does not exist.
  2630   *
  2631   * Side effects:
  2632   *	The virtual event given by virtString may be removed from the virtual
  2633   *	event table.
  2634   *
  2635   *--------------------------------------------------------------
  2636   */
  2637  
  2638  static int
  2639  DeleteVirtualEvent(
  2640      Tcl_Interp *interp,		/* Used for error reporting. */
  2641      VirtualEventTable *vetPtr,	/* Table in which to delete event. */
  2642      char *virtString,		/* String describing event sequence that
  2643  				 * triggers binding. */
  2644      const char *eventString)		/* The event sequence that should be deleted,
  2645  				 * or NULL to delete all event sequences for
  2646  				 * the entire virtual event. */
  2647  {
  2648      int iPhys;
  2649      Tk_Uid virtUid;
  2650      Tcl_HashEntry *vhPtr;
  2651      PhysicalsOwned *poPtr;
  2652      PatSeq *eventPSPtr;
  2653  
  2654      virtUid = GetVirtualEventUid(interp, virtString);
  2655      if (virtUid == NULL) {
  2656  	return TCL_ERROR;
  2657      }
  2658  
  2659      vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
  2660      if (vhPtr == NULL) {
  2661  	return TCL_OK;
  2662      }
  2663      poPtr = Tcl_GetHashValue(vhPtr);
  2664  
  2665      eventPSPtr = NULL;
  2666      if (eventString != NULL) {
  2667  	unsigned long eventMask;
  2668  
  2669  	/*
  2670  	 * Delete only the specific physical event associated with the virtual
  2671  	 * event. If the physical event doesn't already exist, or the virtual
  2672  	 * event doesn't own that physical event, return w/o doing anything.
  2673  	 */
  2674  
  2675  	eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
  2676  		eventString, 0, 0, &eventMask);
  2677  	if (eventPSPtr == NULL) {
  2678  	    const char *string = Tcl_GetString(Tcl_GetObjResult(interp));
  2679  
  2680  	    return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
  2681  	}
  2682      }
  2683  
  2684      for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
  2685  	PatSeq *psPtr = poPtr->patSeqs[iPhys];
  2686  
  2687  	if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
  2688  	    int iVirt;
  2689  	    VirtualOwners *voPtr;
  2690  
  2691  	    /*
  2692  	     * Remove association between this physical event and the given
  2693  	     * virtual event that it triggers.
  2694  	     */
  2695  
  2696  	    voPtr = psPtr->voPtr;
  2697  	    for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
  2698  		if (voPtr->owners[iVirt] == vhPtr) {
  2699  		    break;
  2700  		}
  2701  	    }
  2702  	    if (iVirt == voPtr->numOwners) {
  2703  		Tcl_Panic("DeleteVirtualEvent: couldn't find owner");
  2704  	    }
  2705  	    voPtr->numOwners--;
  2706  	    if (voPtr->numOwners == 0) {
  2707  		/*
  2708  		 * Removed last reference to this physical event, so remove it
  2709  		 * from physical->virtual map.
  2710  		 */
  2711  
  2712  		PatSeq *prevPtr = Tcl_GetHashValue(psPtr->hPtr);
  2713  
  2714  		if (prevPtr == psPtr) {
  2715  		    if (psPtr->nextSeqPtr == NULL) {
  2716  			Tcl_DeleteHashEntry(psPtr->hPtr);
  2717  		    } else {
  2718  			Tcl_SetHashValue(psPtr->hPtr,
  2719  				psPtr->nextSeqPtr);
  2720  		    }
  2721  		} else {
  2722  		    for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  2723  			if (prevPtr == NULL) {
  2724  			    Tcl_Panic("DeleteVirtualEvent couldn't find on hash chain");
  2725  			}
  2726  			if (prevPtr->nextSeqPtr == psPtr) {
  2727  			    prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  2728  			    break;
  2729  			}
  2730  		    }
  2731  		}
  2732  		ckfree(psPtr->voPtr);
  2733  		ckfree(psPtr);
  2734  	    } else {
  2735  		/*
  2736  		 * This physical event still triggers some other virtual
  2737  		 * event(s). Consolidate the list of virtual owners for this
  2738  		 * physical event so it no longer triggers the given virtual
  2739  		 * event.
  2740  		 */
  2741  
  2742  		voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
  2743  	    }
  2744  
  2745  	    /*
  2746  	     * Now delete the virtual event's reference to the physical event.
  2747  	     */
  2748  
  2749  	    poPtr->numOwned--;
  2750  	    if (eventPSPtr != NULL && poPtr->numOwned != 0) {
  2751  		/*
  2752  		 * Just deleting this one physical event. Consolidate list of
  2753  		 * owned physical events and return.
  2754  		 */
  2755  
  2756  		poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
  2757  		return TCL_OK;
  2758  	    }
  2759  	}
  2760      }
  2761  
  2762      if (poPtr->numOwned == 0) {
  2763  	/*
  2764  	 * All the physical events for this virtual event were deleted, either
  2765  	 * because there was only one associated physical event or because the
  2766  	 * caller was deleting the entire virtual event. Now the virtual event
  2767  	 * itself should be deleted.
  2768  	 */
  2769  
  2770  	ckfree(poPtr);
  2771  	Tcl_DeleteHashEntry(vhPtr);
  2772      }
  2773      return TCL_OK;
  2774  }
  2775  
  2776  /*
  2777   *---------------------------------------------------------------------------
  2778   *
  2779   * GetVirtualEvent --
  2780   *
  2781   *	Return the list of physical events that can invoke the given virtual
  2782   *	event.
  2783   *
  2784   * Results:
  2785   *	The return value is TCL_OK and the interp's result is filled with the
  2786   *	string representation of the physical events associated with the
  2787   *	virtual event; if there are no physical events for the given virtual
  2788   *	event, the interp's result is filled with and empty string. If the
  2789   *	virtual event string is improperly formed, then TCL_ERROR is returned
  2790   *	and an error message is left in the interp's result.
  2791   *
  2792   * Side effects:
  2793   *	None.
  2794   *
  2795   *---------------------------------------------------------------------------
  2796   */
  2797  
  2798  static int
  2799  GetVirtualEvent(
  2800      Tcl_Interp *interp,		/* Interpreter for reporting. */
  2801      VirtualEventTable *vetPtr,	/* Table in which to look for event. */
  2802      Tcl_Obj *virtName)		/* String describing virtual event. */
  2803  {
  2804      Tcl_HashEntry *vhPtr;
  2805      int iPhys;
  2806      PhysicalsOwned *poPtr;
  2807      Tk_Uid virtUid;
  2808      Tcl_Obj *resultObj;
  2809  
  2810      virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName));
  2811      if (virtUid == NULL) {
  2812  	return TCL_ERROR;
  2813      }
  2814  
  2815      vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
  2816      if (vhPtr == NULL) {
  2817  	return TCL_OK;
  2818      }
  2819  
  2820      resultObj = Tcl_NewObj();
  2821      poPtr = Tcl_GetHashValue(vhPtr);
  2822      for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
  2823  	Tcl_ListObjAppendElement(NULL, resultObj,
  2824  		GetPatternObj(poPtr->patSeqs[iPhys]));
  2825      }
  2826      Tcl_SetObjResult(interp, resultObj);
  2827  
  2828      return TCL_OK;
  2829  }
  2830  
  2831  /*
  2832   *--------------------------------------------------------------
  2833   *
  2834   * GetAllVirtualEvents --
  2835   *
  2836   *	Return a list that contains the names of all the virtual event
  2837   *	defined.
  2838   *
  2839   * Results:
  2840   *	There is no return value. The interp's result is modified to hold a
  2841   *	Tcl list with one entry for each virtual event in nameTable.
  2842   *
  2843   * Side effects:
  2844   *	None.
  2845   *
  2846   *--------------------------------------------------------------
  2847   */
  2848  
  2849  static void
  2850  GetAllVirtualEvents(
  2851      Tcl_Interp *interp,		/* Interpreter returning result. */
  2852      VirtualEventTable *vetPtr)	/* Table containing events. */
  2853  {
  2854      Tcl_HashEntry *hPtr;
  2855      Tcl_HashSearch search;
  2856      Tcl_Obj *resultObj;
  2857  
  2858      resultObj = Tcl_NewObj();
  2859      hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
  2860      for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  2861  	Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
  2862  		"<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr)));
  2863      }
  2864      Tcl_SetObjResult(interp, resultObj);
  2865  }
  2866  
  2867  /*
  2868   *---------------------------------------------------------------------------
  2869   *
  2870   * HandleEventGenerate --
  2871   *
  2872   *	Helper function for the "event generate" command. Generate and process
  2873   *	an XEvent, constructed from information parsed from the event
  2874   *	description string and its optional arguments.
  2875   *
  2876   *	argv[0] contains name of the target window.
  2877   *	argv[1] contains pattern string for one event (e.g, <Control-v>).
  2878   *	argv[2..argc-1] contains -field/option pairs for specifying additional
  2879   *			detail in the generated event.
  2880   *
  2881   *	Either virtual or physical events can be generated this way. The event
  2882   *	description string must contain the specification for only one event.
  2883   *
  2884   * Results:
  2885   *	None.
  2886   *
  2887   * Side effects:
  2888   *	When constructing the event,
  2889   *	    event.xany.serial is filled with the current X serial number.
  2890   *	    event.xany.window is filled with the target window.
  2891   *	    event.xany.display is filled with the target window's display.
  2892   *	Any other fields in eventPtr which are not specified by the pattern
  2893   *	string or the optional arguments, are set to 0.
  2894   *
  2895   *	The event may be handled synchronously or asynchronously, depending on
  2896   *	the value specified by the optional "-when" option. The default
  2897   *	setting is synchronous.
  2898   *
  2899   *---------------------------------------------------------------------------
  2900   */
  2901  
  2902  static int
  2903  HandleEventGenerate(
  2904      Tcl_Interp *interp,		/* Interp for errors return and name lookup. */
  2905      Tk_Window mainWin,		/* Main window associated with interp. */
  2906      int objc,			/* Number of arguments. */
  2907      Tcl_Obj *const objv[])	/* Argument objects. */
  2908  {
  2909      union {XEvent general; XVirtualEvent virtual;} event;
  2910      const char *p;
  2911      const char *name, *windowName;
  2912      int count, flags, synch, i, number, warp;
  2913      Tcl_QueuePosition pos;
  2914      TkPattern pat;
  2915      Tk_Window tkwin, tkwin2;
  2916      TkWindow *mainPtr;
  2917      unsigned long eventMask;
  2918      Tcl_Obj *userDataObj;
  2919  
  2920      static const char *const fieldStrings[] = {
  2921  	"-when",	"-above",	"-borderwidth",	"-button",
  2922  	"-count",	"-data",	"-delta",	"-detail",
  2923  	"-focus",	"-height",
  2924  	"-keycode",	"-keysym",	"-mode",	"-override",
  2925  	"-place",	"-root",	"-rootx",	"-rooty",
  2926  	"-sendevent",	"-serial",	"-state",	"-subwindow",
  2927  	"-time",	"-warp",	"-width",	"-window",
  2928  	"-x",		"-y",	NULL
  2929      };
  2930      enum field {
  2931  	EVENT_WHEN,	EVENT_ABOVE,	EVENT_BORDER,	EVENT_BUTTON,
  2932  	EVENT_COUNT,	EVENT_DATA,	EVENT_DELTA,	EVENT_DETAIL,
  2933  	EVENT_FOCUS,	EVENT_HEIGHT,
  2934  	EVENT_KEYCODE,	EVENT_KEYSYM,	EVENT_MODE,	EVENT_OVERRIDE,
  2935  	EVENT_PLACE,	EVENT_ROOT,	EVENT_ROOTX,	EVENT_ROOTY,
  2936  	EVENT_SEND,	EVENT_SERIAL,	EVENT_STATE,	EVENT_SUBWINDOW,
  2937  	EVENT_TIME,	EVENT_WARP,	EVENT_WIDTH,	EVENT_WINDOW,
  2938  	EVENT_X,	EVENT_Y
  2939      };
  2940  
  2941      windowName = Tcl_GetString(objv[0]);
  2942      if (!windowName[0]) {
  2943  	tkwin = mainWin;
  2944      } else if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
  2945  	return TCL_ERROR;
  2946      }
  2947  
  2948      mainPtr = (TkWindow *) mainWin;
  2949      if ((tkwin == NULL)
  2950  	    || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
  2951  	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  2952  		"window id \"%s\" doesn't exist in this application",
  2953  		Tcl_GetString(objv[0])));
  2954  	Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW",
  2955  		Tcl_GetString(objv[0]), NULL);
  2956  	return TCL_ERROR;
  2957      }
  2958  
  2959      name = Tcl_GetString(objv[1]);
  2960  
  2961      p = name;
  2962      eventMask = 0;
  2963      userDataObj = NULL;
  2964      count = ParseEventDescription(interp, &p, &pat, &eventMask);
  2965      if (count == 0) {
  2966  	return TCL_ERROR;
  2967      }
  2968      if (count != 1) {
  2969  	Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2970  		"Double or Triple modifier not allowed", -1));
  2971  	Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL);
  2972  	return TCL_ERROR;
  2973      }
  2974      if (*p != '\0') {
  2975  	Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2976  		"only one event specification allowed", -1));
  2977  	Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL);
  2978  	return TCL_ERROR;
  2979      }
  2980  
  2981      memset(&event, 0, sizeof(event));
  2982      event.general.xany.type = pat.eventType;
  2983      event.general.xany.serial = NextRequest(Tk_Display(tkwin));
  2984      event.general.xany.send_event = False;
  2985      if (windowName[0]) {
  2986  	event.general.xany.window = Tk_WindowId(tkwin);
  2987      } else {
  2988  	event.general.xany.window =
  2989  		RootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
  2990      }
  2991      event.general.xany.display = Tk_Display(tkwin);
  2992  
  2993      flags = flagArray[event.general.xany.type];
  2994      if (flags & DESTROY) {
  2995  	/*
  2996  	 * Event DestroyNotify should be generated by destroying the window.
  2997  	 */
  2998  
  2999  	Tk_DestroyWindow(tkwin);
  3000  	return TCL_OK;
  3001      }
  3002      if (flags & KEY_BUTTON_MOTION_VIRTUAL) {
  3003  	event.general.xkey.state = pat.needMods;
  3004  	if ((flags & KEY) && (event.general.xany.type != MouseWheelEvent)) {
  3005  	    TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event.general);
  3006  	} else if (flags & BUTTON) {
  3007  	    event.general.xbutton.button = pat.detail.button;
  3008  	} else if (flags & VIRTUAL) {
  3009  	    event.virtual.name = pat.detail.name;
  3010  	}
  3011      }
  3012      if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
  3013  	event.general.xcreatewindow.window = event.general.xany.window;
  3014      }
  3015  
  3016      if (flags & KEY_BUTTON_MOTION_CROSSING) {
  3017  	event.general.xkey.x_root = -1;
  3018  	event.general.xkey.y_root = -1;
  3019      }
  3020  
  3021      if (event.general.xany.type == FocusIn
  3022  	    || event.general.xany.type == FocusOut) {
  3023  	event.general.xany.send_event = GENERATED_FOCUS_EVENT_MAGIC;
  3024      }
  3025  
  3026      /*
  3027       * Process the remaining arguments to fill in additional fields of the
  3028       * event.
  3029       */
  3030  
  3031      synch = 1;
  3032      warp = 0;
  3033      pos = TCL_QUEUE_TAIL;
  3034      for (i = 2; i < objc; i += 2) {
  3035  	Tcl_Obj *optionPtr, *valuePtr;
  3036  	int index;
  3037  
  3038  	optionPtr = objv[i];
  3039  	valuePtr = objv[i + 1];
  3040  
  3041  	if (Tcl_GetIndexFromObjStruct(interp, optionPtr, fieldStrings,
  3042  		sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
  3043  	    return TCL_ERROR;
  3044  	}
  3045  	if (objc & 1) {
  3046  	    /*
  3047  	     * This test occurs after Tcl_GetIndexFromObj() so that "event
  3048  	     * generate <Button> -xyz" will return the error message that
  3049  	     * "-xyz" is a bad option, rather than that the value for "-xyz"
  3050  	     * is missing.
  3051  	     */
  3052  
  3053  	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  3054  		    "value for \"%s\" missing", Tcl_GetString(optionPtr)));
  3055  	    Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL);
  3056  	    return TCL_ERROR;
  3057  	}
  3058  
  3059  	switch ((enum field) index) {
  3060  	case EVENT_WARP:
  3061  	    if (Tcl_GetBooleanFromObj(interp, valuePtr, &warp) != TCL_OK) {
  3062  		return TCL_ERROR;
  3063  	    }
  3064  	    if (!(flags & KEY_BUTTON_MOTION_VIRTUAL)) {
  3065  		goto badopt;
  3066  	    }
  3067  	    break;
  3068  	case EVENT_WHEN:
  3069  	    pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr,
  3070  		    queuePosition, valuePtr);
  3071  	    if ((int) pos < -1) {
  3072  		return TCL_ERROR;
  3073  	    }
  3074  	    synch = 0;
  3075  	    if ((int) pos == -1) {
  3076  		synch = 1;
  3077  	    }
  3078  	    break;
  3079  	case EVENT_ABOVE:
  3080  	    if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
  3081  		return TCL_ERROR;
  3082  	    }
  3083  	    if (flags & CONFIG) {
  3084  		event.general.xconfigure.above = Tk_WindowId(tkwin2);
  3085  	    } else {
  3086  		goto badopt;
  3087  	    }
  3088  	    break;
  3089  	case EVENT_BORDER:
  3090  	    if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
  3091  		return TCL_ERROR;
  3092  	    }
  3093  	    if (flags & (CREATE|CONFIG)) {
  3094  		event.general.xcreatewindow.border_width = number;
  3095  	    } else {
  3096  		goto badopt;
  3097  	    }
  3098  	    break;
  3099  	case EVENT_BUTTON:
  3100  	    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
  3101  		return TCL_ERROR;
  3102  	    }
  3103  	    if (flags & BUTTON) {
  3104  		event.general.xbutton.button = number;
  3105  	    } else {
  3106  		goto badopt;
  3107  	    }
  3108  	    break;
  3109  	case EVENT_COUNT:
  3110  	    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
  3111  		return TCL_ERROR;
  3112  	    }
  3113  	    if (flags & EXPOSE) {
  3114  		event.general.xexpose.count = number;
  3115  	    } else {
  3116  		goto badopt;
  3117  	    }
  3118  	    break;
  3119  	case EVENT_DATA:
  3120  	    if (flags & VIRTUAL) {
  3121  		/*
  3122  		 * Do not increment reference count until after parsing
  3123  		 * completes and we know that the event generation is really
  3124  		 * going to happen.
  3125  		 */
  3126  
  3127  		userDataObj = valuePtr;
  3128  	    } else {
  3129  		goto badopt;
  3130  	    }
  3131  	    break;
  3132  	case EVENT_DELTA:
  3133  	    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
  3134  		return TCL_ERROR;
  3135  	    }
  3136  	    if ((flags & KEY) && (event.general.xkey.type == MouseWheelEvent)) {
  3137  		event.general.xkey.keycode = number;
  3138  	    } else {
  3139  		goto badopt;
  3140  	    }
  3141  	    break;
  3142  	case EVENT_DETAIL:
  3143  	    number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
  3144  		    valuePtr);
  3145  	    if (number < 0) {
  3146  		return TCL_ERROR;
  3147  	    }
  3148  	    if (flags & FOCUS) {
  3149  		event.general.xfocus.detail = number;
  3150  	    } else if (flags & CROSSING) {
  3151  		event.general.xcrossing.detail = number;
  3152  	    } else {
  3153  		goto badopt;
  3154  	    }
  3155  	    break;
  3156  	case EVENT_FOCUS:
  3157  	    if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
  3158  		return TCL_ERROR;
  3159  	    }
  3160  	    if (flags & CROSSING) {
  3161  		event.general.xcrossing.focus = number;
  3162  	    } else {
  3163  		goto badopt;
  3164  	    }
  3165  	    break;
  3166  	case EVENT_HEIGHT:
  3167  	    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
  3168  		    &number) != TCL_OK) {
  3169  		return TCL_ERROR;
  3170  	    }
  3171  	    if (flags & EXPOSE) {
  3172  		event.general.xexpose.height = number;
  3173  	    } else if (flags & CONFIG) {
  3174  		event.general.xconfigure.height = number;
  3175  	    } else {
  3176  		goto badopt;
  3177  	    }
  3178  	    break;
  3179  	case EVENT_KEYCODE:
  3180  	    if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
  3181  		return TCL_ERROR;
  3182  	    }
  3183  	    if ((flags & KEY) && (event.general.xkey.type != MouseWheelEvent)) {
  3184  		event.general.xkey.keycode = number;
  3185  	    } else {
  3186  		goto badopt;
  3187  	    }
  3188  	    break;
  3189  	case EVENT_KEYSYM: {
  3190  	    KeySym keysym;
  3191  	    const char *value;
  3192  
  3193  	    value = Tcl_GetString(valuePtr);
  3194  	    keysym = TkStringToKeysym(value);
  3195  	    if (keysym == NoSymbol) {
  3196  		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  3197  			"unknown keysym \"%s\"", value));
  3198  		Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value,
  3199  			NULL);
  3200  		return TCL_ERROR;
  3201  	    }
  3202  
  3203  	    TkpSetKeycodeAndState(tkwin, keysym, &event.general);
  3204  	    if (event.general.xkey.keycode == 0) {
  3205  		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  3206  			"no keycode for keysym \"%s\"", value));
  3207  		Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value,
  3208  			NULL);
  3209  		return TCL_ERROR;
  3210  	    }
  3211  	    if (!(flags & KEY)
  3212  		    || (event.general.xkey.type == MouseWheelEvent)) {
  3213  		goto badopt;
  3214  	    }
  3215  	    break;
  3216  	}
  3217  	case EVENT_MODE:
  3218  	    number = TkFindStateNumObj(interp,optionPtr,notifyMode,valuePtr);
  3219  	    if (number < 0) {
  3220  		return TCL_ERROR;
  3221  	    }
  3222  	    if (flags & CROSSING) {
  3223  		event.general.xcrossing.mode = number;
  3224  	    } else if (flags & FOCUS) {
  3225  		event.general.xfocus.mode = number;
  3226  	    } else {
  3227  		goto badopt;
  3228  	    }
  3229  	    break;
  3230  	case EVENT_OVERRIDE:
  3231  	    if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
  3232  		return TCL_ERROR;
  3233  	    }
  3234  	    if (flags & CREATE) {
  3235  		event.general.xcreatewindow.override_redirect = number;
  3236  	    } else if (flags & MAP) {
  3237  		event.general.xmap.override_redirect = number;
  3238  	    } else if (flags & REPARENT) {
  3239  		event.general.xreparent.override_redirect = number;
  3240  	    } else if (flags & CONFIG) {
  3241  		event.general.xconfigure.override_redirect = number;
  3242  	    } else {
  3243  		goto badopt;
  3244  	    }
  3245  	    break;
  3246  	case EVENT_PLACE:
  3247  	    number = TkFindStateNumObj(interp, optionPtr, circPlace, valuePtr);
  3248  	    if (number < 0) {
  3249  		return TCL_ERROR;
  3250  	    }
  3251  	    if (flags & CIRC) {
  3252  		event.general.xcirculate.place = number;
  3253  	    } else {
  3254  		goto badopt;
  3255  	    }
  3256  	    break;
  3257  	case EVENT_ROOT:
  3258  	    if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
  3259  		return TCL_ERROR;
  3260  	    }
  3261  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  3262  		event.general.xkey.root = Tk_WindowId(tkwin2);
  3263  	    } else {
  3264  		goto badopt;
  3265  	    }
  3266  	    break;
  3267  	case EVENT_ROOTX:
  3268  	    if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
  3269  		return TCL_ERROR;
  3270  	    }
  3271  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  3272  		event.general.xkey.x_root = number;
  3273  	    } else {
  3274  		goto badopt;
  3275  	    }
  3276  	    break;
  3277  	case EVENT_ROOTY:
  3278  	    if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) {
  3279  		return TCL_ERROR;
  3280  	    }
  3281  	    if (flags & KEY_BUTTON_MOTION_CROSSING) {
  3282  		event.general.xkey.y_root = number;
  3283  	    } else {
  3284  		goto badopt;
  3285  	    }
  3286  	    break;
3287 case EVENT_SEND: { 3288 const char *value; 3289 3290 value = Tcl_GetString(valuePtr); 3291 if (isdigit(UCHAR(value[0]))) { 3292 /* 3293 * Allow arbitrary integer values for the field; they are 3294 * needed by a few of the tests in the Tk test suite. 3295 */ 3296 3297 if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { 3298 return TCL_ERROR; 3299 } 3300 } else { 3301 if (Tcl_GetBooleanFromObj(interp,valuePtr,&number) != TCL_OK) { 3302 return TCL_ERROR; 3303 } 3304 } 3305 event.general.xany.send_event = number; 3306 break; 3307 }
3308 case EVENT_SERIAL: 3309 if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { 3310 return TCL_ERROR; 3311 } 3312 event.general.xany.serial = number; 3313 break; 3314 case EVENT_STATE: 3315 if (flags & KEY_BUTTON_MOTION_CROSSING) { 3316 if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { 3317 return TCL_ERROR; 3318 } 3319 if (flags & KEY_BUTTON_MOTION_VIRTUAL) { 3320 event.general.xkey.state = number; 3321 } else { 3322 event.general.xcrossing.state = number; 3323 } 3324 } else if (flags & VISIBILITY) { 3325 number = TkFindStateNumObj(interp, optionPtr, visNotify, 3326 valuePtr); 3327 if (number < 0) { 3328 return TCL_ERROR; 3329 } 3330 event.general.xvisibility.state = number; 3331 } else { 3332 goto badopt; 3333 } 3334 break; 3335 case EVENT_SUBWINDOW: 3336 if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { 3337 return TCL_ERROR; 3338 } 3339 if (flags & KEY_BUTTON_MOTION_CROSSING) { 3340 event.general.xkey.subwindow = Tk_WindowId(tkwin2); 3341 } else { 3342 goto badopt; 3343 } 3344 break; 3345 case EVENT_TIME: 3346 if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { 3347 return TCL_ERROR; 3348 } 3349 if (flags & KEY_BUTTON_MOTION_CROSSING) { 3350 event.general.xkey.time = number; 3351 } else if (flags & PROP) { 3352 event.general.xproperty.time = number; 3353 } else { 3354 goto badopt; 3355 } 3356 break; 3357 case EVENT_WIDTH: 3358 if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { 3359 return TCL_ERROR; 3360 } 3361 if (flags & EXPOSE) { 3362 event.general.xexpose.width = number; 3363 } else if (flags & (CREATE|CONFIG)) { 3364 event.general.xcreatewindow.width = number; 3365 } else { 3366 goto badopt; 3367 } 3368 break; 3369 case EVENT_WINDOW: 3370 if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) { 3371 return TCL_ERROR; 3372 } 3373 if (flags & (CREATE|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) { 3374 event.general.xcreatewindow.window = Tk_WindowId(tkwin2); 3375 } else { 3376 goto badopt; 3377 } 3378 break; 3379 case EVENT_X: 3380 if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { 3381 return TCL_ERROR; 3382 } 3383 if (flags & KEY_BUTTON_MOTION_CROSSING) { 3384 event.general.xkey.x = number; 3385 3386 /* 3387 * Only modify rootx as well if it hasn't been changed. 3388 */ 3389 3390 if (event.general.xkey.x_root == -1) { 3391 int rootX, rootY; 3392 3393 Tk_GetRootCoords(tkwin, &rootX, &rootY); 3394 event.general.xkey.x_root = rootX + number; 3395 } 3396 } else if (flags & EXPOSE) { 3397 event.general.xexpose.x = number; 3398 } else if (flags & (CREATE|CONFIG|GRAVITY)) { 3399 event.general.xcreatewindow.x = number; 3400 } else if (flags & REPARENT) { 3401 event.general.xreparent.x = number; 3402 } else { 3403 goto badopt; 3404 } 3405 break; 3406 case EVENT_Y: 3407 if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { 3408 return TCL_ERROR; 3409 } 3410 if (flags & KEY_BUTTON_MOTION_CROSSING) { 3411 event.general.xkey.y = number; 3412 3413 /* 3414 * Only modify rooty as well if it hasn't been changed. 3415 */ 3416 3417 if (event.general.xkey.y_root == -1) { 3418 int rootX, rootY; 3419 3420 Tk_GetRootCoords(tkwin, &rootX, &rootY); 3421 event.general.xkey.y_root = rootY + number; 3422 } 3423 } else if (flags & EXPOSE) { 3424 event.general.xexpose.y = number; 3425 } else if (flags & (CREATE|CONFIG|GRAVITY)) { 3426 event.general.xcreatewindow.y = number; 3427 } else if (flags & REPARENT) { 3428 event.general.xreparent.y = number; 3429 } else { 3430 goto badopt; 3431 } 3432 break; 3433 } 3434 continue; 3435 3436 badopt: 3437 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 3438 "%s event doesn't accept \"%s\" option", 3439 name, Tcl_GetString(optionPtr))); 3440 Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL); 3441 return TCL_ERROR; 3442 } 3443 3444 /* 3445 * Don't generate events for windows that don't exist yet. 3446 */ 3447 3448 if (!event.general.xany.window) { 3449 goto done; 3450 } 3451 3452 if (userDataObj != NULL) { 3453 3454 /* 3455 * Must be virtual event to set that variable to non-NULL. Now we want 3456 * to install the object into the event. Note that we must incr the 3457 * refcount before firing it into the low-level event subsystem; the 3458 * refcount will be decremented once the event has been processed. 3459 */ 3460 3461 event.virtual.user_data = userDataObj; 3462 Tcl_IncrRefCount(userDataObj); 3463 } 3464 3465 /* 3466 * Now we have constructed the event, inject it into the event handling 3467 * code. 3468 */ 3469 3470 if (synch != 0) { 3471 Tk_HandleEvent(&event.general); 3472 } else { 3473 Tk_QueueWindowEvent(&event.general, pos); 3474 } 3475 3476 /* 3477 * We only allow warping if the window is mapped. 3478 */ 3479 3480 if ((warp != 0) && Tk_IsMapped(tkwin)) { 3481 TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display); 3482 3483 Tk_Window warpWindow = Tk_IdToWindow(dispPtr->display, 3484 event.general.xmotion.window); 3485 3486 if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) { 3487 Tcl_DoWhenIdle(DoWarp, dispPtr); 3488 dispPtr->flags |= TK_DISPLAY_IN_WARP; 3489 } 3490 3491 if (warpWindow != dispPtr->warpWindow) { 3492 if (warpWindow) { 3493 Tcl_Preserve(warpWindow); 3494 } 3495 if (dispPtr->warpWindow) { 3496 Tcl_Release(dispPtr->warpWindow); 3497 } 3498 dispPtr->warpWindow = warpWindow; 3499 } 3500 dispPtr->warpMainwin = mainWin; 3501 dispPtr->warpX = event.general.xmotion.x; 3502 dispPtr->warpY = event.general.xmotion.y; 3503 } 3504 3505 done: 3506 Tcl_ResetResult(interp); 3507 return TCL_OK; 3508 } 3509 3510 static int 3511 NameToWindow( 3512 Tcl_Interp *interp, /* Interp for error return and name lookup. */ 3513 Tk_Window mainWin, /* Main window of application. */ 3514 Tcl_Obj *objPtr, /* Contains name or id string of window. */ 3515 Tk_Window *tkwinPtr) /* Filled with token for window. */ 3516 { 3517 const char *name = Tcl_GetString(objPtr); 3518 Tk_Window tkwin; 3519 3520 if (name[0] == '.') { 3521 tkwin = Tk_NameToWindow(interp, name, mainWin); 3522 if (tkwin == NULL) { 3523 return TCL_ERROR; 3524 } 3525 } else { 3526 Window id; 3527 3528 /* 3529 * Check for the winPtr being valid, even if it looks ok to 3530 * TkpScanWindowId. [Bug #411307] 3531 */ 3532 3533 if (TkpScanWindowId(NULL, name, &id) != TCL_OK) { 3534 goto badWindow; 3535 } 3536 tkwin = Tk_IdToWindow(Tk_Display(mainWin), id); 3537 if (tkwin == NULL) { 3538 goto badWindow; 3539 } 3540 } 3541 *tkwinPtr = tkwin; 3542 return TCL_OK; 3543 3544 badWindow: 3545 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 3546 "bad window name/identifier \"%s\"", name)); 3547 Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL); 3548 return TCL_ERROR; 3549 } 3550 3551 /* 3552 *------------------------------------------------------------------------- 3553 * 3554 * DoWarp -- 3555 * 3556 * Perform Warping of X pointer. Executed as an idle handler only. 3557 * 3558 * Results: 3559 * None 3560 * 3561 * Side effects: 3562 * X Pointer will move to a new location. 3563 * 3564 *------------------------------------------------------------------------- 3565 */ 3566 3567 static void 3568 DoWarp( 3569 ClientData clientData) 3570 { 3571 TkDisplay *dispPtr = clientData; 3572 3573 /* 3574 * DoWarp was scheduled only if the window was mapped. It needs to be 3575 * still mapped at the time the present idle callback is executed. Also 3576 * one needs to guard against window destruction in the meantime. 3577 * Finally, the case warpWindow == NULL is special in that it means 3578 * the whole screen. 3579 */ 3580 3581 if ((dispPtr->warpWindow == NULL) || 3582 (Tk_IsMapped(dispPtr->warpWindow) 3583 && (Tk_WindowId(dispPtr->warpWindow) != None))) { 3584 TkpWarpPointer(dispPtr); 3585 XForceScreenSaver(dispPtr->display, ScreenSaverReset); 3586 } 3587 3588 if (dispPtr->warpWindow) { 3589 Tcl_Release(dispPtr->warpWindow); 3590 dispPtr->warpWindow = None; 3591 } 3592 dispPtr->flags &= ~TK_DISPLAY_IN_WARP; 3593 } 3594 3595 /* 3596 *------------------------------------------------------------------------- 3597 * 3598 * GetVirtualEventUid -- 3599 * 3600 * Determine if the given string is in the proper format for a virtual 3601 * event. 3602 * 3603 * Results: 3604 * The return value is NULL if the virtual event string was not in the 3605 * proper format. In this case, an error message will be left in the 3606 * interp's result. Otherwise the return value is a Tk_Uid that 3607 * represents the virtual event. 3608 * 3609 * Side effects: 3610 * None. 3611 * 3612 *------------------------------------------------------------------------- 3613 */ 3614 3615 static Tk_Uid 3616 GetVirtualEventUid( 3617 Tcl_Interp *interp, 3618 char *virtString) 3619 { 3620 Tk_Uid uid; 3621 size_t length; 3622 3623 length = strlen(virtString); 3624 3625 if (length < 5 || virtString[0] != '<' || virtString[1] != '<' || 3626 virtString[length - 2] != '>' || virtString[length - 1] != '>') { 3627 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 3628 "virtual event \"%s\" is badly formed", virtString)); 3629 Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); 3630 return NULL; 3631 } 3632 virtString[length - 2] = '\0'; 3633 uid = Tk_GetUid(virtString + 2); 3634 virtString[length - 2] = '>'; 3635 3636 return uid; 3637 } 3638 3639 /* 3640 *---------------------------------------------------------------------- 3641 * 3642 * FindSequence -- 3643 * 3644 * Find the entry in the pattern table that corresponds to a particular 3645 * pattern string, and return a pointer to that entry. 3646 * 3647 * Results: 3648 * The return value is normally a pointer to the PatSeq in patternTable 3649 * that corresponds to eventString. If an error was found while parsing 3650 * eventString, or if "create" is 0 and no pattern sequence previously 3651 * existed, then NULL is returned and the interp's result contains a 3652 * message describing the problem. If no pattern sequence previously 3653 * existed for eventString, then a new one is created with a NULL command 3654 * field. In a successful return, *maskPtr is filled in with a mask of 3655 * the event types on which the pattern sequence depends. 3656 * 3657 * Side effects: 3658 * A new pattern sequence may be allocated. 3659 * 3660 *---------------------------------------------------------------------- 3661 */ 3662 3663 static PatSeq * 3664 FindSequence( 3665 Tcl_Interp *interp, /* Interpreter to use for error reporting. */ 3666 Tcl_HashTable *patternTablePtr, 3667 /* Table to use for lookup. */ 3668 ClientData object, /* For binding table, token for object with 3669 * which binding is associated. For virtual 3670 * event table, NULL. */ 3671 const char *eventString, /* String description of pattern to match on. 3672 * See user documentation for details. */ 3673 int create, /* 0 means don't create the entry if it 3674 * doesn't already exist. Non-zero means 3675 * create. */ 3676 int allowVirtual, /* 0 means that virtual events are not allowed 3677 * in the sequence. Non-zero otherwise. */ 3678 unsigned long *maskPtr) /* *maskPtr is filled in with the event types 3679 * on which this pattern sequence depends. */ 3680 { 3681 TkPattern pats[EVENT_BUFFER_SIZE]; 3682 int numPats, virtualFound; 3683 const char *p; 3684 TkPattern *patPtr; 3685 PatSeq *psPtr; 3686 Tcl_HashEntry *hPtr; 3687 int flags, count, isNew; 3688 size_t sequenceSize; 3689 unsigned long eventMask; 3690 PatternTableKey key; 3691 3692 /* 3693 *------------------------------------------------------------- 3694 * Step 1: parse the pattern string to produce an array of Patterns. The 3695 * array is generated backwards, so that the lowest-indexed pattern 3696 * corresponds to the last event that must occur. 3697 *------------------------------------------------------------- 3698 */ 3699 3700 p = eventString; 3701 flags = 0; 3702 eventMask = 0; 3703 virtualFound = 0; 3704 3705 patPtr = &pats[EVENT_BUFFER_SIZE-1]; 3706 for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) { 3707 while (isspace(UCHAR(*p))) { 3708 p++; 3709 } 3710 if (*p == '\0') { 3711 break; 3712 } 3713 3714 count = ParseEventDescription(interp, &p, patPtr, &eventMask); 3715 if (count == 0) { 3716 return NULL; 3717 } 3718 3719 if (eventMask & VirtualEventMask) { 3720 if (allowVirtual == 0) { 3721 Tcl_SetObjResult(interp, Tcl_NewStringObj( 3722 "virtual event not allowed in definition of another virtual event", 3723 -1)); 3724 Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", 3725 NULL); 3726 return NULL; 3727 } 3728 virtualFound = 1; 3729 } 3730 3731 /* 3732 * Replicate events for DOUBLE, TRIPLE, QUADRUPLE. 3733 */ 3734 3735 while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) { 3736 flags |= PAT_NEARBY; 3737 patPtr[-1] = patPtr[0]; 3738 patPtr--; 3739 numPats++; 3740 } 3741 } 3742 3743 /* 3744 *------------------------------------------------------------- 3745 * Step 2: find the sequence in the binding table if it exists, and add a 3746 * new sequence to the table if it doesn't. 3747 *------------------------------------------------------------- 3748 */ 3749 3750 if (numPats == 0) { 3751 Tcl_SetObjResult(interp, Tcl_NewStringObj( 3752 "no events specified in binding", -1)); 3753 Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL); 3754 return NULL; 3755 } 3756 if ((numPats > 1) && (virtualFound != 0)) { 3757 Tcl_SetObjResult(interp, Tcl_NewStringObj( 3758 "virtual events may not be composed", -1)); 3759 Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", 3760 NULL); 3761 return NULL; 3762 } 3763 3764 patPtr = &pats[EVENT_BUFFER_SIZE-numPats]; 3765 memset(&key, 0, sizeof(key)); 3766 key.object = object; 3767 key.type = patPtr->eventType; 3768 key.detail = patPtr->detail; 3769 hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &isNew); 3770 sequenceSize = numPats*sizeof(TkPattern); 3771 if (!isNew) { 3772 for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; 3773 psPtr = psPtr->nextSeqPtr) { 3774 if ((numPats == psPtr->numPats) 3775 && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY)) 3776 && (memcmp(patPtr, psPtr->pats, sequenceSize) == 0)) { 3777 goto done; 3778 } 3779 } 3780 } 3781 if (!create) { 3782 if (isNew) { 3783 Tcl_DeleteHashEntry(hPtr); 3784 } 3785 3786 /* 3787 * No binding exists for the sequence, so return an empty error. This 3788 * is a special error that the caller will check for in order to 3789 * silently ignore this case. This is a hack that maintains backward 3790 * compatibility for Tk_GetBinding but the various "bind" commands 3791 * silently ignore missing bindings. 3792 */ 3793 3794 return NULL; 3795 } 3796 psPtr = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(TkPattern)); 3797 psPtr->numPats = numPats; 3798 psPtr->script = NULL; 3799 psPtr->flags = flags; 3800 psPtr->nextSeqPtr = Tcl_GetHashValue(hPtr); 3801 psPtr->hPtr = hPtr; 3802 psPtr->voPtr = NULL; 3803 psPtr->nextObjPtr = NULL; 3804 Tcl_SetHashValue(hPtr, psPtr); 3805 3806 memcpy(psPtr->pats, patPtr, sequenceSize); 3807 3808 done: 3809 *maskPtr = eventMask; 3810 return psPtr; 3811 } 3812 3813 /* 3814 *--------------------------------------------------------------------------- 3815 * 3816 * ParseEventDescription -- 3817 * 3818 * Fill Pattern buffer with information about event from event string. 3819 * 3820 * Results: 3821 * Leaves error message in interp and returns 0 if there was an error due 3822 * to a badly formed event string. Returns 1 if proper event was 3823 * specified, 2 if Double modifier was used in event string, or 3 if 3824 * Triple was used. 3825 * 3826 * Side effects: 3827 * On exit, eventStringPtr points to rest of event string (after the 3828 * closing '>', so that this function can be called repeatedly to parse 3829 * all the events in the entire sequence. 3830 * 3831 *--------------------------------------------------------------------------- 3832 */ 3833 3834 static int 3835 ParseEventDescription( 3836 Tcl_Interp *interp, /* For error messages. */ 3837 const char **eventStringPtr,/* On input, holds a pointer to start of event 3838 * string. On exit, gets pointer to rest of 3839 * string after parsed event. */ 3840 TkPattern *patPtr, /* Filled with the pattern parsed from the 3841 * event string. */ 3842 unsigned long *eventMaskPtr)/* Filled with event mask of matched event. */ 3843 { 3844 char *p; 3845 unsigned long eventMask; 3846 int count, eventFlags; 3847 #define FIELD_SIZE 48 3848 char field[FIELD_SIZE]; 3849 Tcl_HashEntry *hPtr; 3850 Tcl_DString copy; 3851 3852 Tcl_DStringInit(&copy); 3853 p = Tcl_DStringAppend(&copy, *eventStringPtr, -1); 3854 3855 patPtr->eventType = -1; 3856 patPtr->needMods = 0; 3857 patPtr->detail.clientData = 0; 3858 3859 eventMask = 0; 3860 count = 1; 3861 3862 /* 3863 * Handle simple ASCII characters. 3864 */ 3865 3866 if (*p != '<') { 3867 char string[2]; 3868 3869 patPtr->eventType = KeyPress; 3870 eventMask = KeyPressMask; 3871 string[0] = *p; 3872 string[1] = 0; 3873 patPtr->detail.keySym = TkStringToKeysym(string); 3874 if (patPtr->detail.keySym == NoSymbol) { 3875 if (isprint(UCHAR(*p))) { 3876 patPtr->detail.keySym = *p; 3877 } else { 3878 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 3879 "bad ASCII character 0x%x", UCHAR(*p))); 3880 Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL); 3881 count = 0; 3882 goto done; 3883 } 3884 } 3885 p++; 3886 goto end; 3887 } 3888 3889 /* 3890 * A fancier event description. This can be either a virtual event or a 3891 * physical event. 3892 * 3893 * A virtual event description consists of: 3894 * 3895 * 1. double open angle brackets. 3896 * 2. virtual event name. 3897 * 3. double close angle brackets. 3898 * 3899 * A physical event description consists of: 3900 * 3901 * 1. open angle bracket. 3902 * 2. any number of modifiers, each followed by spaces or dashes. 3903 * 3. an optional event name. 3904 * 4. an option button or keysym name. Either this or item 3 *must* be 3905 * present; if both are present then they are separated by spaces or 3906 * dashes. 3907 * 5. a close angle bracket. 3908 */ 3909 3910 p++; 3911 if (*p == '<') { 3912 /* 3913 * This is a virtual event: soak up all the characters up to the next 3914 * '>'. 3915 */ 3916 3917 char *field = p + 1; 3918 3919 p = strchr(field, '>'); 3920 if (p == field) { 3921 Tcl_SetObjResult(interp, Tcl_NewStringObj( 3922 "virtual event \"<<>>\" is badly formed", -1)); 3923 Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", 3924 NULL); 3925 count = 0; 3926 goto done; 3927 } 3928 if ((p == NULL) || (p[1] != '>')) { 3929 Tcl_SetObjResult(interp, Tcl_NewStringObj( 3930 "missing \">\" in virtual binding", -1)); 3931 Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", 3932 NULL); 3933 count = 0; 3934 goto done; 3935 } 3936 *p = '\0'; 3937 patPtr->eventType = VirtualEvent; 3938 eventMask = VirtualEventMask; 3939 patPtr->detail.name = Tk_GetUid(field); 3940 *p = '>'; 3941 3942 p += 2; 3943 goto end; 3944 } 3945 3946 while (1) { 3947 ModInfo *modPtr; 3948 3949 p = GetField(p, field, FIELD_SIZE); 3950 if (*p == '>') { 3951 /* 3952 * This solves the problem of, e.g., <Control-M> being 3953 * misinterpreted as Control + Meta + missing keysym instead of 3954 * Control + KeyPress + M. 3955 */ 3956 3957 break; 3958 } 3959 hPtr = Tcl_FindHashEntry(&modTable, field); 3960 if (hPtr == NULL) { 3961 break; 3962 } 3963 modPtr = Tcl_GetHashValue(hPtr); 3964 patPtr->needMods |= modPtr->mask; 3965 if (modPtr->flags & MULT_CLICKS) { 3966 int i = modPtr->flags & MULT_CLICKS; 3967 3968 count = 2; 3969 while (i >>= 1) { 3970 count++; 3971 } 3972 } 3973 while ((*p == '-') || isspace(UCHAR(*p))) { 3974 p++; 3975 } 3976 } 3977 3978 eventFlags = 0; 3979 hPtr = Tcl_FindHashEntry(&eventTable, field); 3980 if (hPtr != NULL) { 3981 const EventInfo *eiPtr = Tcl_GetHashValue(hPtr); 3982 3983 patPtr->eventType = eiPtr->type; 3984 eventFlags = flagArray[eiPtr->type]; 3985 eventMask = eiPtr->eventMask; 3986 while ((*p == '-') || isspace(UCHAR(*p))) { 3987 p++; 3988 } 3989 p = GetField(p, field, FIELD_SIZE); 3990 } 3991 if (*field != '\0') { 3992 if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) { 3993 if (eventFlags == 0) { 3994 patPtr->eventType = ButtonPress; 3995 eventMask = ButtonPressMask; 3996 } else if (eventFlags & KEY) { 3997 goto getKeysym; 3998 } else if (!(eventFlags & BUTTON)) { 3999 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 4000 "specified button \"%s\" for non-button event", 4001 field)); 4002 Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL); 4003 count = 0; 4004 goto done; 4005 } 4006 patPtr->detail.button = (*field - '0'); 4007 } else { 4008 4009 getKeysym: 4010 patPtr->detail.keySym = TkStringToKeysym(field); 4011 if (patPtr->detail.keySym == NoSymbol) { 4012 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 4013 "bad event type or keysym \"%s\"", field)); 4014 Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field, 4015 NULL); 4016 count = 0; 4017 goto done; 4018 } 4019 if (eventFlags == 0) { 4020 patPtr->eventType = KeyPress; 4021 eventMask = KeyPressMask; 4022 } else if (!(eventFlags & KEY)) { 4023 Tcl_SetObjResult(interp, Tcl_ObjPrintf( 4024 "specified keysym \"%s\" for non-key event", field)); 4025 Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL); 4026 count = 0; 4027 goto done; 4028 } 4029 } 4030 } else if (eventFlags == 0) { 4031 Tcl_SetObjResult(interp, Tcl_NewStringObj( 4032 "no event type or button # or keysym", -1)); 4033 Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); 4034 count = 0; 4035 goto done; 4036 } 4037 4038 while ((*p == '-') || isspace(UCHAR(*p))) { 4039 p++; 4040 } 4041 if (*p != '>') { 4042 while (*p != '\0') { 4043 p++; 4044 if (*p == '>') { 4045 Tcl_SetObjResult(interp, Tcl_NewStringObj( 4046 "extra characters after detail in binding", -1)); 4047 Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); 4048 count = 0; 4049 goto done; 4050 } 4051 } 4052 Tcl_SetObjResult(interp, Tcl_NewStringObj( 4053 "missing \">\" in binding", -1)); 4054 Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); 4055 count = 0; 4056 goto done; 4057 } 4058 p++; 4059 4060 end: 4061 *eventStringPtr += (p - Tcl_DStringValue(&copy)); 4062 *eventMaskPtr |= eventMask; 4063 done: 4064 Tcl_DStringFree(&copy); 4065 return count; 4066 } 4067 4068 /* 4069 *---------------------------------------------------------------------- 4070 * 4071 * GetField -- 4072 * 4073 * Used to parse pattern descriptions. Copies up to size characters from 4074 * p to copy, stopping at end of string, space, "-", ">", or whenever 4075 * size is exceeded. 4076 * 4077 * Results: 4078 * The return value is a pointer to the character just after the last one 4079 * copied (usually "-" or space or ">", but could be anything if size was 4080 * exceeded). Also places NULL-terminated string (up to size character, 4081 * including NULL), at copy. 4082 * 4083 * Side effects: 4084 * None. 4085 * 4086 *---------------------------------------------------------------------- 4087 */ 4088 4089 static char * 4090 GetField( 4091 char *p, /* Pointer to part of pattern. */ 4092 char *copy, /* Place to copy field. */ 4093 int size) /* Maximum number of characters to copy. */ 4094 { 4095 while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>') 4096 && (*p != '-') && (size > 1)) { 4097 *copy = *p; 4098 p++; 4099 copy++; 4100 size--; 4101 } 4102 *copy = '\0'; 4103 return p; 4104 } 4105 4106 /* 4107 *--------------------------------------------------------------------------- 4108 * 4109 * GetPatternObj -- 4110 * 4111 * Produce a string version of the given event, for displaying to the 4112 * user. 4113 * 4114 * Results: 4115 * The string is returned as a Tcl_Obj. 4116 * 4117 * Side effects: 4118 * It is the caller's responsibility to arrange for the object to be 4119 * released; it starts with a refCount of zero. 4120 * 4121 *--------------------------------------------------------------------------- 4122 */ 4123 4124 static Tcl_Obj * 4125 GetPatternObj( 4126 PatSeq *psPtr) 4127 { 4128 TkPattern *patPtr; 4129 int patsLeft, needMods; 4130 const ModInfo *modPtr; 4131 const EventInfo *eiPtr; 4132 Tcl_Obj *patternObj = Tcl_NewObj(); 4133 4134 /* 4135 * The order of the patterns in the sequence is backwards from the order 4136 * in which they must be output. 4137 */ 4138 4139 for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1]; 4140 patsLeft > 0; patsLeft--, patPtr--) { 4141 /* 4142 * Check for simple case of an ASCII character. 4143 */ 4144 4145 if ((patPtr->eventType == KeyPress) 4146 && !(psPtr->flags & PAT_NEARBY) 4147 && (patPtr->needMods == 0) 4148 && (patPtr->detail.keySym < 128) 4149 && isprint(UCHAR(patPtr->detail.keySym)) 4150 && (patPtr->detail.keySym != '<') 4151 && (patPtr->detail.keySym != ' ')) { 4152 char c = (char) patPtr->detail.keySym; 4153 4154 Tcl_AppendToObj(patternObj, &c, 1); 4155 continue; 4156 } 4157 4158 /* 4159 * Check for virtual event. 4160 */ 4161 4162 if (patPtr->eventType == VirtualEvent) { 4163 Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name); 4164 continue; 4165 } 4166 4167 /* 4168 * It's a more general event specification. First check for "Double", 4169 * "Triple", "Quadruple", then modifiers, then event type, then keysym 4170 * or button detail. 4171 */ 4172 4173 Tcl_AppendToObj(patternObj, "<", 1); 4174 4175 if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) 4176 && (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { 4177 patsLeft--; 4178 patPtr--; 4179 if ((patsLeft > 1) && 4180 (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { 4181 patsLeft--; 4182 patPtr--; 4183 if ((patsLeft > 1) && 4184 (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { 4185 patsLeft--; 4186 patPtr--; 4187 Tcl_AppendToObj(patternObj, "Quadruple-", 10); 4188 } else { 4189 Tcl_AppendToObj(patternObj, "Triple-", 7); 4190 } 4191 } else { 4192 Tcl_AppendToObj(patternObj, "Double-", 7); 4193 } 4194 } 4195 4196 for (needMods = patPtr->needMods, modPtr = modArray; 4197 needMods != 0; modPtr++) { 4198 if (modPtr->mask & needMods) { 4199 needMods &= ~modPtr->mask; 4200 Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name); 4201 } 4202 } 4203 4204 for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { 4205 if (eiPtr->type == patPtr->eventType) { 4206 Tcl_AppendToObj(patternObj, eiPtr->name, -1); 4207 if (patPtr->detail.clientData != 0) { 4208 Tcl_AppendToObj(patternObj, "-", 1); 4209 } 4210 break; 4211 } 4212 } 4213 4214 if (patPtr->detail.clientData != 0) { 4215 if ((patPtr->eventType == KeyPress) 4216 || (patPtr->eventType == KeyRelease)) { 4217 const char *string = TkKeysymToString(patPtr->detail.keySym); 4218 4219 if (string != NULL) { 4220 Tcl_AppendToObj(patternObj, string, -1); 4221 } 4222 } else { 4223 Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button); 4224 } 4225 } 4226 4227 Tcl_AppendToObj(patternObj, ">", 1); 4228 } 4229 4230 return patternObj; 4231 } 4232 4233 /* 4234 *---------------------------------------------------------------------- 4235 * 4236 * TkStringToKeysym -- 4237 * 4238 * This function finds the keysym associated with a given keysym name. 4239 * 4240 * Results: 4241 * The return value is the keysym that corresponds to name, or NoSymbol 4242 * if there is no such keysym. 4243 * 4244 * Side effects: 4245 * None. 4246 * 4247 *---------------------------------------------------------------------- 4248 */ 4249 4250 KeySym 4251 TkStringToKeysym( 4252 const char *name) /* Name of a keysym. */ 4253 { 4254 #ifdef REDO_KEYSYM_LOOKUP 4255 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&keySymTable, name); 4256 4257 if (hPtr != NULL) { 4258 return (KeySym) Tcl_GetHashValue(hPtr); 4259 } 4260 if (strlen(name) == 1) { 4261 KeySym keysym = (KeySym) (unsigned char) name[0]; 4262 4263 if (TkKeysymToString(keysym) != NULL) { 4264 return keysym; 4265 } 4266 } 4267 #endif /* REDO_KEYSYM_LOOKUP */ 4268 return XStringToKeysym(name); 4269 } 4270 4271 /* 4272 *---------------------------------------------------------------------- 4273 * 4274 * TkKeysymToString -- 4275 * 4276 * This function finds the keysym name associated with a given keysym. 4277 * 4278 * Results: 4279 * The return value is a pointer to a static string containing the name 4280 * of the given keysym, or NULL if there is no known name. 4281 * 4282 * Side effects: 4283 * None. 4284 * 4285 *---------------------------------------------------------------------- 4286 */ 4287 4288 const char * 4289 TkKeysymToString( 4290 KeySym keysym) 4291 { 4292 #ifdef REDO_KEYSYM_LOOKUP 4293 Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym); 4294 4295 if (hPtr != NULL) { 4296 return Tcl_GetHashValue(hPtr); 4297 } 4298 #endif /* REDO_KEYSYM_LOOKUP */ 4299 4300 return XKeysymToString(keysym); 4301 } 4302 4303 /* 4304 *---------------------------------------------------------------------- 4305 * 4306 * TkpGetBindingXEvent -- 4307 * 4308 * This function returns the XEvent associated with the currently 4309 * executing binding. This function can only be invoked while a binding 4310 * is executing. 4311 * 4312 * Results: 4313 * Returns a pointer to the XEvent that caused the current binding code 4314 * to be run. 4315 * 4316 * Side effects: 4317 * None. 4318 * 4319 *---------------------------------------------------------------------- 4320 */ 4321 4322 XEvent * 4323 TkpGetBindingXEvent( 4324 Tcl_Interp *interp) /* Interpreter. */ 4325 { 4326 TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp); 4327 BindingTable *bindPtr = winPtr->mainPtr->bindingTable; 4328 4329 return &(bindPtr->eventRing[bindPtr->curEvent]); 4330 } 4331 4332 /* 4333 *---------------------------------------------------------------------- 4334 * 4335 * TkpCancelWarp -- 4336 * 4337 * This function cancels an outstanding pointer warp and 4338 * is called during tear down of the display. 4339 * 4340 * Results: 4341 * None. 4342 * 4343 * Side effects: 4344 * None. 4345 * 4346 *---------------------------------------------------------------------- 4347 */ 4348 4349 void 4350 TkpCancelWarp( 4351 TkDisplay *dispPtr) 4352 { 4353 if (dispPtr->flags & TK_DISPLAY_IN_WARP) { 4354 Tcl_CancelIdleCall(DoWarp, dispPtr); 4355 dispPtr->flags &= ~TK_DISPLAY_IN_WARP; 4356 } 4357 } 4358 4359 /* 4360 * Local Variables: 4361 * mode: c 4362 * c-basic-offset: 4 4363 * fill-column: 78 4364 * End: 4365 */