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 1baa549b0a06a42807c017d6d145e56e6d40c33c7575681cd95f4b69d291a555:


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