tk/generic/tkBind.c

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