tkBind.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:133k
源码类别:

通讯编程

开发平台:

Visual 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: tkBind.c,v 1.28.2.4 2006/07/21 06:26:54 das Exp $
  15.  */
  16. #include "tkPort.h"
  17. #include "tkInt.h"
  18. #ifdef __WIN32__
  19. #include "tkWinInt.h"
  20. #endif
  21. #if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* UNIX */
  22. #include "tkUnixInt.h"
  23. #endif
  24. /*
  25.  * File structure:
  26.  *
  27.  * Structure definitions and static variables.
  28.  *
  29.  * Init/Free this package.
  30.  *
  31.  * Tcl "bind" command (actually located in tkCmds.c).
  32.  * "bind" command implementation.
  33.  * "bind" implementation helpers.
  34.  *
  35.  * Tcl "event" command.
  36.  * "event" command implementation.
  37.  * "event" implementation helpers.
  38.  *
  39.  * Package-specific common helpers.
  40.  *
  41.  * Non-package-specific helpers.
  42.  */
  43. /*
  44.  * The following union is used to hold the detail information from an
  45.  * XEvent (including Tk's XVirtualEvent extension).
  46.  */
  47. typedef union {
  48.     KeySym keySym;     /* KeySym that corresponds to xkey.keycode. */
  49.     int button;     /* Button that was pressed (xbutton.button). */
  50.     Tk_Uid name;     /* Tk_Uid of virtual event. */
  51.     ClientData clientData; /* Used when type of Detail is unknown, and to
  52.      * ensure that all bytes of Detail are initialized
  53.      * when this structure is used in a hash key. */
  54. } Detail;
  55. /*
  56.  * The structure below represents a binding table.  A binding table
  57.  * represents a domain in which event bindings may occur.  It includes
  58.  * a space of objects relative to which events occur (usually windows,
  59.  * but not always), a history of recent events in the domain, and
  60.  * a set of mappings that associate particular Tcl commands with sequences
  61.  * of events in the domain.  Multiple binding tables may exist at once,
  62.  * either because there are multiple applications open, or because there
  63.  * are multiple domains within an application with separate event
  64.  * bindings for each (for example, each canvas widget has a separate
  65.  * binding table for associating events with the items in the canvas).
  66.  *
  67.  * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
  68.  * below 30.  To see this, consider a triple mouse button click while
  69.  * the Shift key is down (and auto-repeating).  There may be as many
  70.  * as 3 auto-repeat events after each mouse button press or release
  71.  * (see the first large comment block within Tk_BindEvent for more on
  72.  * this), for a total of 20 events to cover the three button presses
  73.  * and two intervening releases.  If you reduce EVENT_BUFFER_SIZE too
  74.  * much, shift multi-clicks will be lost.
  75.  * 
  76.  */
  77. #define EVENT_BUFFER_SIZE 30
  78. typedef struct BindingTable {
  79.     XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
  80.  * (higher indices are for more recent
  81.  * events). */
  82.     Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym,
  83.  * button, Tk_Uid, or 0) for each
  84.  * entry in eventRing. */
  85.     int curEvent; /* Index in eventRing of most recent
  86.  * event.  Newer events have higher
  87.  * indices. */
  88.     Tcl_HashTable patternTable; /* Used to map from an event to a
  89.  * list of patterns that may match that
  90.  * event.  Keys are PatternTableKey
  91.  * structs, values are (PatSeq *). */
  92.     Tcl_HashTable objectTable; /* Used to map from an object to a
  93.  * list of patterns associated with
  94.  * that object.  Keys are ClientData,
  95.  * values are (PatSeq *). */
  96.     Tcl_Interp *interp; /* Interpreter in which commands are
  97.  * executed. */
  98. } BindingTable;
  99. /*
  100.  * The following structure represents virtual event table.  A virtual event
  101.  * table provides a way to map from platform-specific physical events such
  102.  * as button clicks or key presses to virtual events such as <<Paste>>,
  103.  * <<Close>>, or <<ScrollWindow>>.
  104.  *
  105.  * A virtual event is usually never part of the event stream, but instead is
  106.  * synthesized inline by matching low-level events.  However, a virtual
  107.  * event may be generated by platform-specific code or by Tcl scripts.  In
  108.  * that case, no lookup of the virtual event will need to be done using
  109.  * this table, because the virtual event is actually in the event stream.
  110.  */
  111. typedef struct VirtualEventTable {
  112.     Tcl_HashTable patternTable;     /* Used to map from a physical event to
  113.      * a list of patterns that may match that
  114.      * event.  Keys are PatternTableKey
  115.      * structs, values are (PatSeq *). */
  116.     Tcl_HashTable nameTable;     /* Used to map a virtual event name to
  117.      * the array of physical events that can
  118.      * trigger it.  Keys are the Tk_Uid names
  119.      * of the virtual events, values are
  120.      * PhysicalsOwned structs. */
  121. } VirtualEventTable;
  122. /*
  123.  * The following structure is used as a key in a patternTable for both 
  124.  * binding tables and a virtual event tables.
  125.  *
  126.  * In a binding table, the object field corresponds to the binding tag
  127.  * for the widget whose bindings are being accessed.
  128.  *
  129.  * In a virtual event table, the object field is always NULL.  Virtual
  130.  * events are a global definiton and are not tied to a particular
  131.  * binding tag.
  132.  *
  133.  * The same key is used for both types of pattern tables so that the 
  134.  * helper functions that traverse and match patterns will work for both
  135.  * binding tables and virtual event tables.
  136.  */
  137. typedef struct PatternTableKey {
  138.     ClientData object; /* For binding table, identifies the binding
  139.  * tag of the object (or class of objects)
  140.  * relative to which the event occurred.
  141.  * For virtual event table, always NULL. */
  142.     int type; /* Type of event (from X). */
  143.     Detail detail; /* Additional information, such as keysym,
  144.  * button, Tk_Uid, or 0 if nothing
  145.  * additional. */
  146. } PatternTableKey;
  147. /*
  148.  * The following structure defines a pattern, which is matched against X
  149.  * events as part of the process of converting X events into Tcl commands.
  150.  */
  151. typedef struct Pattern {
  152.     int eventType; /* Type of X event, e.g. ButtonPress. */
  153.     int needMods; /* Mask of modifiers that must be
  154.  * present (0 means no modifiers are
  155.  * required). */
  156.     Detail detail; /* Additional information that must
  157.  * match event.  Normally this is 0,
  158.  * meaning no additional information
  159.  * must match.  For KeyPress and
  160.  * KeyRelease events, a keySym may
  161.  * be specified to select a
  162.  * particular keystroke (0 means any
  163.  * keystrokes).  For button events,
  164.  * specifies a particular button (0
  165.  * means any buttons are OK).  For virtual
  166.  * events, specifies the Tk_Uid of the
  167.  * virtual event name (never 0). */
  168. } Pattern;
  169. /*
  170.  * The following structure defines a pattern sequence, which consists of one
  171.  * or more patterns.  In order to trigger, a pattern sequence must match
  172.  * the most recent X events (first pattern to most recent event, next
  173.  * pattern to next event, and so on).  It is used as the hash value in a
  174.  * patternTable for both binding tables and virtual event tables.
  175.  *
  176.  * In a binding table, it is the sequence of physical events that make up
  177.  * a binding for an object.
  178.  * 
  179.  * In a virtual event table, it is the sequence of physical events that
  180.  * define a virtual event.
  181.  *
  182.  * The same structure is used for both types of pattern tables so that the 
  183.  * helper functions that traverse and match patterns will work for both
  184.  * binding tables and virtual event tables.
  185.  */
  186. typedef struct PatSeq {
  187.     int numPats; /* Number of patterns in sequence (usually
  188.  * 1). */
  189.     TkBindEvalProc *eventProc; /* The procedure that will be invoked on
  190.  * the clientData when this pattern sequence
  191.  * matches. */
  192.     TkBindFreeProc *freeProc; /* The procedure that will be invoked to
  193.  * release the clientData when this pattern
  194.  * sequence is freed. */
  195.     ClientData clientData; /* Arbitray data passed to eventProc and
  196.  * freeProc when sequence matches. */
  197.     int flags; /* Miscellaneous flag values; see below for
  198.  * definitions. */
  199.     int refCount; /* Number of times that this binding is in
  200.  * the midst of executing.  If greater than 1,
  201.  * then a recursive invocation is happening.
  202.  * Only when this is zero can the binding
  203.  * actually be freed. */
  204.     struct PatSeq *nextSeqPtr;  /* Next in list of all pattern sequences
  205.  * that have the same initial pattern.  NULL
  206.  * means end of list. */
  207.     Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the
  208.  * initial pattern.  This is the head of the
  209.  * list of which nextSeqPtr forms a part. */
  210.     struct VirtualOwners *voPtr;/* In a binding table, always NULL.  In a
  211.  * virtual event table, identifies the array
  212.  * of virtual events that can be triggered by
  213.  * this event. */
  214.     struct PatSeq *nextObjPtr;  /* In a binding table, next in list of all
  215.  * pattern sequences for the same object (NULL
  216.  * for end of list).  Needed to implement
  217.  * Tk_DeleteAllBindings.  In a virtual event
  218.  * table, always NULL. */
  219.     Pattern pats[1]; /* Array of "numPats" patterns.  Only one
  220.  * element is declared here but in actuality
  221.  * enough space will be allocated for "numPats"
  222.  * patterns.  To match, pats[0] must match
  223.  * event n, pats[1] must match event n-1, etc.
  224.  */
  225. } PatSeq;
  226. /*
  227.  * Flag values for PatSeq structures:
  228.  *
  229.  * PAT_NEARBY 1 means that all of the events matching
  230.  * this sequence must occur with nearby X
  231.  * and Y mouse coordinates and close in time.
  232.  * This is typically used to restrict multiple
  233.  * button presses.
  234.  * MARKED_DELETED 1 means that this binding has been marked as deleted
  235.  * and removed from the binding table, but its memory
  236.  * could not be released because it was already queued for
  237.  * execution.  When the binding is actually about to be
  238.  * executed, this flag will be checked and the binding
  239.  * skipped if set.
  240.  */
  241. #define PAT_NEARBY 0x1
  242. #define MARKED_DELETED 0x2
  243. /*
  244.  * Constants that define how close together two events must be
  245.  * in milliseconds or pixels to meet the PAT_NEARBY constraint:
  246.  */
  247. #define NEARBY_PIXELS 5
  248. #define NEARBY_MS 500
  249. /*
  250.  * The following structure keeps track of all the virtual events that are
  251.  * associated with a particular physical event.  It is pointed to by the
  252.  * voPtr field in a PatSeq in the patternTable of a  virtual event table.
  253.  */
  254. typedef struct VirtualOwners {
  255.     int numOwners;     /* Number of virtual events to trigger. */
  256.     Tcl_HashEntry *owners[1];     /* Array of pointers to entries in
  257.      * nameTable.  Enough space will
  258.      * actually be allocated for numOwners
  259.      * hash entries. */
  260. } VirtualOwners;
  261. /*
  262.  * The following structure is used in the nameTable of a virtual event
  263.  * table to associate a virtual event with all the physical events that can
  264.  * trigger it.
  265.  */
  266. typedef struct PhysicalsOwned {
  267.     int numOwned;     /* Number of physical events owned. */
  268.     PatSeq *patSeqs[1];     /* Array of pointers to physical event
  269.      * patterns.  Enough space will actually
  270.      * be allocated to hold numOwned. */
  271. } PhysicalsOwned;
  272. /*
  273.  * One of the following structures exists for each interpreter.  This
  274.  * structure keeps track of the current display and screen in the
  275.  * interpreter, so that a script can be invoked whenever the display/screen
  276.  * changes (the script does things like point tk::Priv at a display-specific
  277.  * structure).
  278.  */
  279. typedef struct {
  280.     TkDisplay *curDispPtr; /* Display for last binding command invoked
  281.  * in this application. */
  282.     int curScreenIndex; /* Index of screen for last binding command. */
  283.     int bindingDepth; /* Number of active instances of Tk_BindEvent
  284.  * in this application. */
  285. } ScreenInfo;
  286. /*
  287.  * The following structure is used to keep track of all the C bindings that
  288.  * are awaiting invocation and whether the window they refer to has been
  289.  * destroyed.  If the window is destroyed, then all pending callbacks for
  290.  * that window will be cancelled.  The Tcl bindings will still all be
  291.  * invoked, however.  
  292.  */
  293. typedef struct PendingBinding {
  294.     struct PendingBinding *nextPtr;
  295. /* Next in chain of pending bindings, in
  296.  * case a recursive binding evaluation is in
  297.  * progress. */
  298.     Tk_Window tkwin; /* The window that the following bindings
  299.  * depend upon. */
  300.     int deleted; /* Set to non-zero by window cleanup code
  301.  * if tkwin is deleted. */
  302.     PatSeq *matchArray[5]; /* Array of pending C bindings.  The actual
  303.  * size of this depends on how many C bindings
  304.  * matched the event passed to Tk_BindEvent.
  305.  * THIS FIELD MUST BE THE LAST IN THE
  306.  * STRUCTURE. */
  307. } PendingBinding;
  308. /*
  309.  * The following structure keeps track of all the information local to
  310.  * the binding package on a per interpreter basis.
  311.  */
  312. typedef struct BindInfo {
  313.     VirtualEventTable virtualEventTable;
  314. /* The virtual events that exist in this
  315.  * interpreter. */
  316.     ScreenInfo screenInfo; /* Keeps track of the current display and
  317.  * screen, so it can be restored after
  318.  * a binding has executed. */
  319.     PendingBinding *pendingList;/* The list of pending C bindings, kept in
  320.  * case a C or Tcl binding causes the target
  321.  * window to be deleted. */
  322.     int deleted; /* 1 the application has been deleted but
  323.  * the structure has been preserved. */
  324. } BindInfo;
  325.     
  326. /*
  327.  * In X11R4 and earlier versions, XStringToKeysym is ridiculously
  328.  * slow.  The data structure and hash table below, along with the
  329.  * code that uses them, implement a fast mapping from strings to
  330.  * keysyms.  In X11R5 and later releases XStringToKeysym is plenty
  331.  * fast so this stuff isn't needed.  The #define REDO_KEYSYM_LOOKUP
  332.  * is normally undefined, so that XStringToKeysym gets used.  It
  333.  * can be set in the Makefile to enable the use of the hash table
  334.  * below.
  335.  */
  336. #ifdef REDO_KEYSYM_LOOKUP
  337. typedef struct {
  338.     char *name; /* Name of keysym. */
  339.     KeySym value; /* Numeric identifier for keysym. */
  340. } KeySymInfo;
  341. static KeySymInfo keyArray[] = {
  342. #ifndef lint
  343. #include "ks_names.h"
  344. #endif
  345.     {(char *) NULL, 0}
  346. };
  347. static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
  348. static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
  349. #endif /* REDO_KEYSYM_LOOKUP */
  350. /*
  351.  * Set to non-zero when the package-wide static variables have been
  352.  * initialized.
  353.  */
  354. static int initialized = 0;
  355. TCL_DECLARE_MUTEX(bindMutex)
  356. /*
  357.  * A hash table is kept to map from the string names of event
  358.  * modifiers to information about those modifiers.  The structure
  359.  * for storing this information, and the hash table built at
  360.  * initialization time, are defined below.
  361.  */
  362. typedef struct {
  363.     char *name; /* Name of modifier. */
  364.     int mask; /* Button/modifier mask value,  * such as Button1Mask. */
  365.     int flags; /* Various flags;  see below for
  366.  * definitions. */
  367. } ModInfo;
  368. /*
  369.  * Flags for ModInfo structures:
  370.  *
  371.  * DOUBLE - Non-zero means duplicate this event,
  372.  * e.g. for double-clicks.
  373.  * TRIPLE - Non-zero means triplicate this event,
  374.  * e.g. for triple-clicks.
  375.  * QUADRUPLE - Non-zero means quadruple this event,
  376.  * e.g. for 4-fold-clicks.
  377.  * MULT_CLICKS - Combination of all of above.
  378.  */
  379. #define DOUBLE 1
  380. #define TRIPLE 2
  381. #define QUADRUPLE 4
  382. #define MULT_CLICKS 7
  383. static ModInfo modArray[] = {
  384.     {"Control", ControlMask, 0},
  385.     {"Shift", ShiftMask, 0},
  386.     {"Lock", LockMask, 0},
  387.     {"Meta", META_MASK, 0},
  388.     {"M", META_MASK, 0},
  389.     {"Alt", ALT_MASK, 0},
  390.     {"B1", Button1Mask, 0},
  391.     {"Button1", Button1Mask, 0},
  392.     {"B2", Button2Mask, 0},
  393.     {"Button2", Button2Mask, 0},
  394.     {"B3", Button3Mask, 0},
  395.     {"Button3", Button3Mask, 0},
  396.     {"B4", Button4Mask, 0},
  397.     {"Button4", Button4Mask, 0},
  398.     {"B5", Button5Mask, 0},
  399.     {"Button5", Button5Mask, 0},
  400.     {"Mod1", Mod1Mask, 0},
  401.     {"M1", Mod1Mask, 0},
  402.     {"Command", Mod1Mask, 0},
  403.     {"Mod2", Mod2Mask, 0},
  404.     {"M2", Mod2Mask, 0},
  405.     {"Option", Mod2Mask, 0},
  406.     {"Mod3", Mod3Mask, 0},
  407.     {"M3", Mod3Mask, 0},
  408.     {"Mod4", Mod4Mask, 0},
  409.     {"M4", Mod4Mask, 0},
  410.     {"Mod5", Mod5Mask, 0},
  411.     {"M5", Mod5Mask, 0},
  412.     {"Double", 0, DOUBLE},
  413.     {"Triple", 0, TRIPLE},
  414.     {"Quadruple", 0, QUADRUPLE},
  415.     {"Any", 0, 0}, /* Ignored: historical relic. */
  416.     {NULL, 0, 0}
  417. };
  418. static Tcl_HashTable modTable;
  419. /*
  420.  * This module also keeps a hash table mapping from event names
  421.  * to information about those events.  The structure, an array
  422.  * to use to initialize the hash table, and the hash table are
  423.  * all defined below.
  424.  */
  425. typedef struct {
  426.     char *name; /* Name of event. */
  427.     int type; /* Event type for X, such as
  428.  * ButtonPress. */
  429.     int eventMask; /* Mask bits (for XSelectInput)
  430.  * for this event type. */
  431. } EventInfo;
  432. /*
  433.  * Note:  some of the masks below are an OR-ed combination of
  434.  * several masks.  This is necessary because X doesn't report
  435.  * up events unless you also ask for down events.  Also, X
  436.  * doesn't report button state in motion events unless you've
  437.  * asked about button events.
  438.  */
  439. static EventInfo eventArray[] = {
  440.     {"Key", KeyPress, KeyPressMask},
  441.     {"KeyPress", KeyPress, KeyPressMask},
  442.     {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
  443.     {"Button", ButtonPress, ButtonPressMask},
  444.     {"ButtonPress", ButtonPress, ButtonPressMask},
  445.     {"ButtonRelease", ButtonRelease,
  446.     ButtonPressMask|ButtonReleaseMask},
  447.     {"Motion", MotionNotify,
  448.     ButtonPressMask|PointerMotionMask},
  449.     {"Enter", EnterNotify, EnterWindowMask},
  450.     {"Leave", LeaveNotify, LeaveWindowMask},
  451.     {"FocusIn", FocusIn, FocusChangeMask},
  452.     {"FocusOut", FocusOut, FocusChangeMask},
  453.     {"Expose", Expose, ExposureMask},
  454.     {"Visibility", VisibilityNotify, VisibilityChangeMask},
  455.     {"Destroy", DestroyNotify, StructureNotifyMask},
  456.     {"Unmap", UnmapNotify, StructureNotifyMask},
  457.     {"Map", MapNotify, StructureNotifyMask},
  458.     {"Reparent", ReparentNotify, StructureNotifyMask},
  459.     {"Configure", ConfigureNotify, StructureNotifyMask},
  460.     {"Gravity", GravityNotify, StructureNotifyMask},
  461.     {"Circulate", CirculateNotify, StructureNotifyMask},
  462.     {"Property", PropertyNotify, PropertyChangeMask},
  463.     {"Colormap", ColormapNotify, ColormapChangeMask},
  464.     {"Activate", ActivateNotify, ActivateMask},
  465.     {"Deactivate", DeactivateNotify, ActivateMask},
  466.     {"MouseWheel", MouseWheelEvent, MouseWheelMask},
  467.     {"CirculateRequest", CirculateRequest, SubstructureRedirectMask},
  468.     {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask},
  469.     {"Create", CreateNotify, SubstructureNotifyMask},
  470.     {"MapRequest", MapRequest,             SubstructureRedirectMask},
  471.     {"ResizeRequest", ResizeRequest, ResizeRedirectMask},
  472.     {(char *) NULL, 0, 0}
  473. };
  474. static Tcl_HashTable eventTable;
  475. /*
  476.  * The defines and table below are used to classify events into
  477.  * various groups.  The reason for this is that logically identical
  478.  * fields (e.g. "state") appear at different places in different
  479.  * types of events.  The classification masks can be used to figure
  480.  * out quickly where to extract information from events.
  481.  */
  482. #define KEY 0x1
  483. #define BUTTON 0x2
  484. #define MOTION 0x4
  485. #define CROSSING 0x8
  486. #define FOCUS 0x10
  487. #define EXPOSE 0x20
  488. #define VISIBILITY 0x40
  489. #define CREATE 0x80
  490. #define DESTROY 0x100
  491. #define UNMAP 0x200
  492. #define MAP 0x400
  493. #define REPARENT 0x800
  494. #define CONFIG 0x1000
  495. #define GRAVITY 0x2000
  496. #define CIRC 0x4000
  497. #define PROP 0x8000
  498. #define COLORMAP 0x10000
  499. #define VIRTUAL 0x20000
  500. #define ACTIVATE 0x40000
  501. #define MAPREQ 0x80000
  502. #define CONFIGREQ 0x100000
  503. #define RESIZEREQ 0x200000
  504. #define CIRCREQ 0x400000
  505. #define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
  506. #define KEY_BUTTON_MOTION_CROSSING (KEY|BUTTON|MOTION|CROSSING|VIRTUAL)
  507. static int flagArray[TK_LASTEVENT] = {
  508.    /* Not used */ 0,
  509.    /* Not used */ 0,
  510.    /* KeyPress */ KEY,
  511.    /* KeyRelease */ KEY,
  512.    /* ButtonPress */ BUTTON,
  513.    /* ButtonRelease */ BUTTON,
  514.    /* MotionNotify */ MOTION,
  515.    /* EnterNotify */ CROSSING,
  516.    /* LeaveNotify */ CROSSING,
  517.    /* FocusIn */ FOCUS,
  518.    /* FocusOut */ FOCUS,
  519.    /* KeymapNotify */ 0,
  520.    /* Expose */ EXPOSE,
  521.    /* GraphicsExpose */ EXPOSE,
  522.    /* NoExpose */ 0,
  523.    /* VisibilityNotify */ VISIBILITY,
  524.    /* CreateNotify */ CREATE,
  525.    /* DestroyNotify */ DESTROY,
  526.    /* UnmapNotify */ UNMAP,
  527.    /* MapNotify */ MAP,
  528.    /* MapRequest */ MAPREQ,
  529.    /* ReparentNotify */ REPARENT,
  530.    /* ConfigureNotify */ CONFIG,
  531.    /* ConfigureRequest */ CONFIGREQ,
  532.    /* GravityNotify */ GRAVITY,
  533.    /* ResizeRequest */ RESIZEREQ,
  534.    /* CirculateNotify */ CIRC,
  535.    /* CirculateRequest */ 0,
  536.    /* PropertyNotify */ PROP,
  537.    /* SelectionClear */ 0,
  538.    /* SelectionRequest */ 0,
  539.    /* SelectionNotify */ 0,
  540.    /* ColormapNotify */ COLORMAP,
  541.    /* ClientMessage */ 0,
  542.    /* MappingNotify */ 0,
  543.    /* VirtualEvent */ VIRTUAL,
  544.    /* Activate */ ACTIVATE,     
  545.    /* Deactivate */ ACTIVATE,
  546.    /* MouseWheel */ KEY
  547. };
  548. /*
  549.  * The following table is used to map between the location where an
  550.  * generated event should be queued and the string used to specify the
  551.  * location.
  552.  */
  553.  
  554. static TkStateMap queuePosition[] = {
  555.     {-1, "now"},
  556.     {TCL_QUEUE_HEAD, "head"},
  557.     {TCL_QUEUE_MARK, "mark"},
  558.     {TCL_QUEUE_TAIL, "tail"},
  559.     {-2, NULL}
  560. };
  561. /*
  562.  * The following tables are used as a two-way map between X's internal
  563.  * numeric values for fields in an XEvent and the strings used in Tcl.  The
  564.  * tables are used both when constructing an XEvent from user input and
  565.  * when providing data from an XEvent to the user.
  566.  */
  567. static TkStateMap notifyMode[] = {
  568.     {NotifyNormal, "NotifyNormal"},
  569.     {NotifyGrab, "NotifyGrab"},
  570.     {NotifyUngrab, "NotifyUngrab"},
  571.     {NotifyWhileGrabbed, "NotifyWhileGrabbed"},
  572.     {-1, NULL}
  573. };
  574. static TkStateMap notifyDetail[] = {
  575.     {NotifyAncestor, "NotifyAncestor"},
  576.     {NotifyVirtual, "NotifyVirtual"},
  577.     {NotifyInferior, "NotifyInferior"},
  578.     {NotifyNonlinear, "NotifyNonlinear"},
  579.     {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
  580.     {NotifyPointer, "NotifyPointer"},
  581.     {NotifyPointerRoot, "NotifyPointerRoot"},
  582.     {NotifyDetailNone, "NotifyDetailNone"},
  583.     {-1, NULL}
  584. };
  585. static TkStateMap circPlace[] = {
  586.     {PlaceOnTop, "PlaceOnTop"},
  587.     {PlaceOnBottom, "PlaceOnBottom"},
  588.     {-1, NULL}
  589. };
  590. static TkStateMap visNotify[] = {
  591.     {VisibilityUnobscured,     "VisibilityUnobscured"},
  592.     {VisibilityPartiallyObscured,   "VisibilityPartiallyObscured"},
  593.     {VisibilityFullyObscured,     "VisibilityFullyObscured"},
  594.     {-1, NULL}
  595. };
  596. static TkStateMap configureRequestDetail[] = {
  597.     {None, "None"},
  598.     {Above, "Above"},
  599.     {Below, "Below"},
  600.     {BottomIf, "BottomIf"},
  601.     {TopIf, "TopIf"},
  602.     {Opposite, "Opposite"},
  603.     {-1, NULL}
  604. };
  605. static TkStateMap propNotify[] = {
  606.     {PropertyNewValue, "NewValue"},
  607.     {PropertyDelete, "Delete"},
  608.     {-1, NULL}
  609. };
  610. /*
  611.  * Prototypes for local procedures defined in this file:
  612.  */
  613. static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
  614.     char *dispName, int screenIndex));
  615. static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
  616.     VirtualEventTable *vetPtr, char *virtString,
  617.     char *eventString));
  618. static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
  619.     VirtualEventTable *vetPtr, char *virtString,
  620.     char *eventString));
  621. static void DeleteVirtualEventTable _ANSI_ARGS_((
  622.     VirtualEventTable *vetPtr));
  623. static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
  624.     CONST char *before, XEvent *eventPtr, KeySym keySym,
  625.     Tcl_DString *dsPtr));
  626. static void FreeTclBinding _ANSI_ARGS_((ClientData clientData));
  627. static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
  628.     Tcl_HashTable *patternTablePtr, ClientData object,
  629.     CONST char *eventString, int create,
  630.     int allowVirtual, unsigned long *maskPtr));
  631. static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
  632.     VirtualEventTable *vetPtr));
  633. static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
  634. static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
  635.     Tcl_DString *dsPtr));
  636. static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
  637.     VirtualEventTable *vetPtr, char *virtString));
  638. static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
  639.     char *virtString));
  640. static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
  641.     Tk_Window main, int objc,
  642.     Tcl_Obj *CONST objv[]));
  643. static void InitVirtualEventTable _ANSI_ARGS_((
  644.     VirtualEventTable *vetPtr));
  645. static PatSeq * MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
  646.     BindingTable *bindPtr, PatSeq *psPtr,
  647.     PatSeq *bestPtr, ClientData *objectPtr,
  648.     PatSeq **sourcePtrPtr));
  649. static int NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
  650.     Tk_Window main, Tcl_Obj *objPtr,
  651.     Tk_Window *tkwinPtr));
  652. static int ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
  653.     CONST char **eventStringPtr, Pattern *patPtr,
  654.     unsigned long *eventMaskPtr));
  655. static void DoWarp _ANSI_ARGS_((ClientData clientData));
  656. /*
  657.  * The following define is used as a short circuit for the callback
  658.  * procedure to evaluate a TclBinding.  The actual evaluation of the
  659.  * binding is handled inline, because special things have to be done
  660.  * with a Tcl binding before evaluation time.
  661.  */
  662. #define EvalTclBinding ((TkBindEvalProc *) 1)
  663. /*
  664.  *---------------------------------------------------------------------------
  665.  *
  666.  * TkBindInit --
  667.  *
  668.  * This procedure is called when an application is created.  It
  669.  * initializes all the structures used by bindings and virtual
  670.  * events.  It must be called before any other functions in this
  671.  * file are called.
  672.  *
  673.  * Results:
  674.  * None.
  675.  *
  676.  * Side effects:
  677.  * Memory allocated.
  678.  *
  679.  *---------------------------------------------------------------------------
  680.  */
  681. void
  682. TkBindInit(mainPtr)
  683.     TkMainInfo *mainPtr; /* The newly created application. */
  684. {
  685.     BindInfo *bindInfoPtr;
  686.     if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
  687. panic("TkBindInit: virtual events can't be supported");
  688.     }
  689.     /*
  690.      * Initialize the static data structures used by the binding package.
  691.      * They are only initialized once, no matter how many interps are
  692.      * created.
  693.      */
  694.     if (!initialized) {
  695.         Tcl_MutexLock(&bindMutex);
  696. if (!initialized) {
  697.     Tcl_HashEntry *hPtr;
  698.     ModInfo *modPtr;
  699.     EventInfo *eiPtr;
  700.     int newEntry;
  701. #ifdef REDO_KEYSYM_LOOKUP
  702.     KeySymInfo *kPtr;
  703.     Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
  704.     Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
  705.     for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
  706.         hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &newEntry);
  707. Tcl_SetHashValue(hPtr, kPtr->value);
  708. hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
  709.         &newEntry);
  710. if (newEntry) {
  711.     Tcl_SetHashValue(hPtr, kPtr->name);
  712. }
  713.     }
  714. #endif /* REDO_KEYSYM_LOOKUP */
  715.     Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
  716.     for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
  717.         hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &newEntry);
  718. Tcl_SetHashValue(hPtr, modPtr);
  719.     }
  720.     
  721.     Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
  722.     for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
  723.         hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &newEntry);
  724. Tcl_SetHashValue(hPtr, eiPtr);
  725.     }
  726.     initialized = 1;
  727. }
  728.         Tcl_MutexUnlock(&bindMutex);
  729.     }
  730.     mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
  731.     bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
  732.     InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
  733.     bindInfoPtr->screenInfo.curDispPtr = NULL;
  734.     bindInfoPtr->screenInfo.curScreenIndex = -1;
  735.     bindInfoPtr->screenInfo.bindingDepth = 0;
  736.     bindInfoPtr->pendingList = NULL;
  737.     bindInfoPtr->deleted = 0;
  738.     mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
  739.     TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
  740. }
  741. /*
  742.  *---------------------------------------------------------------------------
  743.  *
  744.  * TkBindFree --
  745.  *
  746.  * This procedure is called when an application is deleted.  It
  747.  * deletes all the structures used by bindings and virtual events.
  748.  *
  749.  * Results:
  750.  * None.
  751.  *
  752.  * Side effects:
  753.  * Memory freed.
  754.  *
  755.  *---------------------------------------------------------------------------
  756.  */
  757. void
  758. TkBindFree(mainPtr)
  759.     TkMainInfo *mainPtr; /* The newly created application. */
  760. {
  761.     BindInfo *bindInfoPtr;
  762.     
  763.     Tk_DeleteBindingTable(mainPtr->bindingTable);
  764.     mainPtr->bindingTable = NULL;
  765.     bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
  766.     DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
  767.     bindInfoPtr->deleted = 1;
  768.     Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC);
  769.     mainPtr->bindInfo = NULL;
  770. }
  771. /*
  772.  *--------------------------------------------------------------
  773.  *
  774.  * Tk_CreateBindingTable --
  775.  *
  776.  * Set up a new domain in which event bindings may be created.
  777.  *
  778.  * Results:
  779.  * The return value is a token for the new table, which must
  780.  * be passed to procedures like Tk_CreateBinding.
  781.  *
  782.  * Side effects:
  783.  * Memory is allocated for the new table.
  784.  *
  785.  *--------------------------------------------------------------
  786.  */
  787. Tk_BindingTable
  788. Tk_CreateBindingTable(interp)
  789.     Tcl_Interp *interp; /* Interpreter to associate with the binding
  790.  * table:  commands are executed in this
  791.  * interpreter. */
  792. {
  793.     BindingTable *bindPtr;
  794.     int i;
  795.     /*
  796.      * Create and initialize a new binding table.
  797.      */
  798.     bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
  799.     for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
  800. bindPtr->eventRing[i].type = -1;
  801.     }
  802.     bindPtr->curEvent = 0;
  803.     Tcl_InitHashTable(&bindPtr->patternTable,
  804.     sizeof(PatternTableKey)/sizeof(int));
  805.     Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
  806.     bindPtr->interp = interp;
  807.     return (Tk_BindingTable) bindPtr;
  808. }
  809. /*
  810.  *--------------------------------------------------------------
  811.  *
  812.  * Tk_DeleteBindingTable --
  813.  *
  814.  * Destroy a binding table and free up all its memory.
  815.  * The caller should not use bindingTable again after
  816.  * this procedure returns.
  817.  *
  818.  * Results:
  819.  * None.
  820.  *
  821.  * Side effects:
  822.  * Memory is freed.
  823.  *
  824.  *--------------------------------------------------------------
  825.  */
  826. void
  827. Tk_DeleteBindingTable(bindingTable)
  828.     Tk_BindingTable bindingTable; /* Token for the binding table to
  829.  * destroy. */
  830. {
  831.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  832.     PatSeq *psPtr, *nextPtr;
  833.     Tcl_HashEntry *hPtr;
  834.     Tcl_HashSearch search;
  835.     /*
  836.      * Find and delete all of the patterns associated with the binding
  837.      * table.
  838.      */
  839.     for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
  840.     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  841. for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  842. psPtr != NULL; psPtr = nextPtr) {
  843.     nextPtr = psPtr->nextSeqPtr;
  844.     psPtr->flags |= MARKED_DELETED;
  845.     if (psPtr->refCount == 0) {
  846. if (psPtr->freeProc != NULL) {
  847.     (*psPtr->freeProc)(psPtr->clientData);
  848. }
  849. ckfree((char *) psPtr);
  850.     }
  851. }
  852.     }
  853.     /*
  854.      * Clean up the rest of the information associated with the
  855.      * binding table.
  856.      */
  857.     Tcl_DeleteHashTable(&bindPtr->patternTable);
  858.     Tcl_DeleteHashTable(&bindPtr->objectTable);
  859.     ckfree((char *) bindPtr);
  860. }
  861. /*
  862.  *--------------------------------------------------------------
  863.  *
  864.  * Tk_CreateBinding --
  865.  *
  866.  * Add a binding to a binding table, so that future calls to
  867.  * Tk_BindEvent may execute the command in the binding.
  868.  *
  869.  * Results:
  870.  * The return value is 0 if an error occurred while setting
  871.  * up the binding.  In this case, an error message will be
  872.  * left in the interp's result.  If all went well then the return
  873.  * value is a mask of the event types that must be made
  874.  * available to Tk_BindEvent in order to properly detect when
  875.  * this binding triggers.  This value can be used to determine
  876.  * what events to select for in a window, for example.
  877.  *
  878.  * Side effects:
  879.  * An existing binding on the same event sequence may be
  880.  * replaced.  
  881.  * The new binding may cause future calls to Tk_BindEvent to
  882.  * behave differently than they did previously.
  883.  *
  884.  *--------------------------------------------------------------
  885.  */
  886. unsigned long
  887. Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
  888.     Tcl_Interp *interp; /* Used for error reporting. */
  889.     Tk_BindingTable bindingTable;
  890. /* Table in which to create binding. */
  891.     ClientData object; /* Token for object with which binding is
  892.  * associated. */
  893.     CONST char *eventString; /* String describing event sequence that
  894.  * triggers binding. */
  895.     CONST char *command; /* Contains Tcl command to execute when
  896.  * binding triggers. */
  897.     int append; /* 0 means replace any existing binding for
  898.  * eventString; 1 means append to that
  899.  * binding.  If the existing binding is for a
  900.  * callback function and not a Tcl command
  901.  * string, the existing binding will always be
  902.  * replaced. */
  903. {
  904.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  905.     PatSeq *psPtr;
  906.     unsigned long eventMask;
  907.     char *new, *old;
  908.     psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
  909.     1, 1, &eventMask);
  910.     if (psPtr == NULL) {
  911. return 0;
  912.     }
  913.     if (psPtr->eventProc == NULL) {
  914. int new;
  915. Tcl_HashEntry *hPtr;
  916. /*
  917.  * This pattern sequence was just created.
  918.  * Link the pattern into the list associated with the object, so
  919.  * that if the object goes away, these bindings will all
  920.  * automatically be deleted.
  921.  */
  922. hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
  923. &new);
  924. if (new) {
  925.     psPtr->nextObjPtr = NULL;
  926. } else {
  927.     psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  928. }
  929. Tcl_SetHashValue(hPtr, psPtr);
  930.     } else if (psPtr->eventProc != EvalTclBinding) {
  931. /*
  932.  * Free existing procedural binding.
  933.  */
  934. if (psPtr->freeProc != NULL) {
  935.     (*psPtr->freeProc)(psPtr->clientData);
  936. }
  937. psPtr->clientData = NULL;
  938. append = 0;
  939.     }
  940.     old = (char *) psPtr->clientData;
  941.     if ((append != 0) && (old != NULL)) {
  942. int length;
  943. length = strlen(old) + strlen(command) + 2;
  944. new = (char *) ckalloc((unsigned) length);
  945. sprintf(new, "%sn%s", old, command);
  946.     } else {
  947. new = (char *) ckalloc((unsigned) strlen(command) + 1);
  948. strcpy(new, command);
  949.     }
  950.     if (old != NULL) {
  951. ckfree(old);
  952.     }
  953.     psPtr->eventProc = EvalTclBinding;
  954.     psPtr->freeProc = FreeTclBinding;
  955.     psPtr->clientData = (ClientData) new;
  956.     return eventMask;
  957. }
  958. /*
  959.  *---------------------------------------------------------------------------
  960.  *
  961.  * TkCreateBindingProcedure --
  962.  *
  963.  * Add a C binding to a binding table, so that future calls to
  964.  * Tk_BindEvent may callback the procedure in the binding.
  965.  *
  966.  * Results:
  967.  * The return value is 0 if an error occurred while setting
  968.  * up the binding.  In this case, an error message will be
  969.  * left in the interp's result.  If all went well then the return
  970.  * value is a mask of the event types that must be made
  971.  * available to Tk_BindEvent in order to properly detect when
  972.  * this binding triggers.  This value can be used to determine
  973.  * what events to select for in a window, for example.
  974.  *
  975.  * Side effects:
  976.  * Any existing binding on the same event sequence will be
  977.  * replaced.  
  978.  *
  979.  *---------------------------------------------------------------------------
  980.  */
  981. unsigned long
  982. TkCreateBindingProcedure(interp, bindingTable, object, eventString,
  983. eventProc, freeProc, clientData)
  984.     Tcl_Interp *interp; /* Used for error reporting. */
  985.     Tk_BindingTable bindingTable;
  986. /* Table in which to create binding. */
  987.     ClientData object; /* Token for object with which binding is
  988.  * associated. */
  989.     CONST char *eventString; /* String describing event sequence that
  990.  * triggers binding. */
  991.     TkBindEvalProc *eventProc; /* Procedure to invoke when binding
  992.  * triggers.  Must not be NULL. */
  993.     TkBindFreeProc *freeProc; /* Procedure to invoke when binding is
  994.  * freed.  May be NULL for no procedure. */
  995.     ClientData clientData; /* Arbitrary ClientData to pass to eventProc
  996.  * and freeProc. */
  997. {
  998.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  999.     PatSeq *psPtr;
  1000.     unsigned long eventMask;
  1001.     psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
  1002.     1, 1, &eventMask);
  1003.     if (psPtr == NULL) {
  1004. return 0;
  1005.     }
  1006.     if (psPtr->eventProc == NULL) {
  1007. int new;
  1008. Tcl_HashEntry *hPtr;
  1009. /*
  1010.  * This pattern sequence was just created.
  1011.  * Link the pattern into the list associated with the object, so
  1012.  * that if the object goes away, these bindings will all
  1013.  * automatically be deleted.
  1014.  */
  1015. hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
  1016. &new);
  1017. if (new) {
  1018.     psPtr->nextObjPtr = NULL;
  1019. } else {
  1020.     psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  1021. }
  1022. Tcl_SetHashValue(hPtr, psPtr);
  1023.     } else {
  1024. /*
  1025.  * Free existing callback.
  1026.  */
  1027. if (psPtr->freeProc != NULL) {
  1028.     (*psPtr->freeProc)(psPtr->clientData);
  1029. }
  1030.     }
  1031.     psPtr->eventProc = eventProc;
  1032.     psPtr->freeProc = freeProc;
  1033.     psPtr->clientData = clientData;
  1034.     return eventMask;
  1035. }
  1036. /*
  1037.  *--------------------------------------------------------------
  1038.  *
  1039.  * Tk_DeleteBinding --
  1040.  *
  1041.  * Remove an event binding from a binding table.
  1042.  *
  1043.  * Results:
  1044.  * The result is a standard Tcl return value.  If an error
  1045.  * occurs then the interp's result will contain an error message.
  1046.  *
  1047.  * Side effects:
  1048.  * The binding given by object and eventString is removed
  1049.  * from bindingTable.
  1050.  *
  1051.  *--------------------------------------------------------------
  1052.  */
  1053. int
  1054. Tk_DeleteBinding(interp, bindingTable, object, eventString)
  1055.     Tcl_Interp *interp; /* Used for error reporting. */
  1056.     Tk_BindingTable bindingTable; /* Table in which to delete binding. */
  1057.     ClientData object; /* Token for object with which binding
  1058.  * is associated. */
  1059.     CONST char *eventString; /* String describing event sequence
  1060.  * that triggers binding. */
  1061. {
  1062.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  1063.     PatSeq *psPtr, *prevPtr;
  1064.     unsigned long eventMask;
  1065.     Tcl_HashEntry *hPtr;
  1066.     psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
  1067.     0, 1, &eventMask);
  1068.     if (psPtr == NULL) {
  1069. Tcl_ResetResult(interp);
  1070. return TCL_OK;
  1071.     }
  1072.     /*
  1073.      * Unlink the binding from the list for its object, then from the
  1074.      * list for its pattern.
  1075.      */
  1076.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  1077.     if (hPtr == NULL) {
  1078. panic("Tk_DeleteBinding couldn't find object table entry");
  1079.     }
  1080.     prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  1081.     if (prevPtr == psPtr) {
  1082. Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
  1083.     } else {
  1084. for ( ; ; prevPtr = prevPtr->nextObjPtr) {
  1085.     if (prevPtr == NULL) {
  1086. panic("Tk_DeleteBinding couldn't find on object list");
  1087.     }
  1088.     if (prevPtr->nextObjPtr == psPtr) {
  1089. prevPtr->nextObjPtr = psPtr->nextObjPtr;
  1090. break;
  1091.     }
  1092. }
  1093.     }
  1094.     prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
  1095.     if (prevPtr == psPtr) {
  1096. if (psPtr->nextSeqPtr == NULL) {
  1097.     Tcl_DeleteHashEntry(psPtr->hPtr);
  1098. } else {
  1099.     Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  1100. }
  1101.     } else {
  1102. for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  1103.     if (prevPtr == NULL) {
  1104. panic("Tk_DeleteBinding couldn't find on hash chain");
  1105.     }
  1106.     if (prevPtr->nextSeqPtr == psPtr) {
  1107. prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  1108. break;
  1109.     }
  1110. }
  1111.     }
  1112.     psPtr->flags |= MARKED_DELETED;
  1113.     if (psPtr->refCount == 0) {
  1114. if (psPtr->freeProc != NULL) {
  1115.     (*psPtr->freeProc)(psPtr->clientData);
  1116. }
  1117. ckfree((char *) psPtr);
  1118.     }
  1119.     return TCL_OK;
  1120. }
  1121. /*
  1122.  *--------------------------------------------------------------
  1123.  *
  1124.  * Tk_GetBinding --
  1125.  *
  1126.  * Return the command associated with a given event string.
  1127.  *
  1128.  * Results:
  1129.  * The return value is a pointer to the command string
  1130.  * associated with eventString for object in the domain
  1131.  * given by bindingTable.  If there is no binding for
  1132.  * eventString, or if eventString is improperly formed,
  1133.  * then NULL is returned and an error message is left in
  1134.  * the interp's result.  The return value is semi-static:  it
  1135.  * will persist until the binding is changed or deleted.
  1136.  *
  1137.  * Side effects:
  1138.  * None.
  1139.  *
  1140.  *--------------------------------------------------------------
  1141.  */
  1142. CONST char *
  1143. Tk_GetBinding(interp, bindingTable, object, eventString)
  1144.     Tcl_Interp *interp; /* Interpreter for error reporting. */
  1145.     Tk_BindingTable bindingTable; /* Table in which to look for
  1146.  * binding. */
  1147.     ClientData object; /* Token for object with which binding
  1148.  * is associated. */
  1149.     CONST char *eventString; /* String describing event sequence
  1150.  * that triggers binding. */
  1151. {
  1152.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  1153.     PatSeq *psPtr;
  1154.     unsigned long eventMask;
  1155.     psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
  1156.     0, 1, &eventMask);
  1157.     if (psPtr == NULL) {
  1158. return NULL;
  1159.     }
  1160.     if (psPtr->eventProc == EvalTclBinding) {
  1161. return (CONST char *) psPtr->clientData;
  1162.     }
  1163.     return "";
  1164. }
  1165. /*
  1166.  *--------------------------------------------------------------
  1167.  *
  1168.  * Tk_GetAllBindings --
  1169.  *
  1170.  * Return a list of event strings for all the bindings
  1171.  * associated with a given object.
  1172.  *
  1173.  * Results:
  1174.  * There is no return value.  The interp's result is modified to
  1175.  * hold a Tcl list with one entry for each binding associated
  1176.  * with object in bindingTable.  Each entry in the list
  1177.  * contains the event string associated with one binding.
  1178.  *
  1179.  * Side effects:
  1180.  * None.
  1181.  *
  1182.  *--------------------------------------------------------------
  1183.  */
  1184. void
  1185. Tk_GetAllBindings(interp, bindingTable, object)
  1186.     Tcl_Interp *interp; /* Interpreter returning result or
  1187.  * error. */
  1188.     Tk_BindingTable bindingTable; /* Table in which to look for
  1189.  * bindings. */
  1190.     ClientData object; /* Token for object. */
  1191. {
  1192.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  1193.     PatSeq *psPtr;
  1194.     Tcl_HashEntry *hPtr;
  1195.     Tcl_DString ds;
  1196.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  1197.     if (hPtr == NULL) {
  1198. return;
  1199.     }
  1200.     Tcl_DStringInit(&ds);
  1201.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  1202.     psPtr = psPtr->nextObjPtr) {
  1203. /* 
  1204.  * For each binding, output information about each of the
  1205.  * patterns in its sequence.
  1206.  */
  1207.  
  1208. Tcl_DStringSetLength(&ds, 0);
  1209. GetPatternString(psPtr, &ds);
  1210. Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
  1211.     }
  1212.     Tcl_DStringFree(&ds);
  1213. }
  1214. /*
  1215.  *--------------------------------------------------------------
  1216.  *
  1217.  * Tk_DeleteAllBindings --
  1218.  *
  1219.  * Remove all bindings associated with a given object in a
  1220.  * given binding table.
  1221.  *
  1222.  * Results:
  1223.  * All bindings associated with object are removed from
  1224.  * bindingTable.
  1225.  *
  1226.  * Side effects:
  1227.  * None.
  1228.  *
  1229.  *--------------------------------------------------------------
  1230.  */
  1231. void
  1232. Tk_DeleteAllBindings(bindingTable, object)
  1233.     Tk_BindingTable bindingTable; /* Table in which to delete
  1234.  * bindings. */
  1235.     ClientData object; /* Token for object. */
  1236. {
  1237.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  1238.     PatSeq *psPtr, *prevPtr;
  1239.     PatSeq *nextPtr;
  1240.     Tcl_HashEntry *hPtr;
  1241.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  1242.     if (hPtr == NULL) {
  1243. return;
  1244.     }
  1245.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  1246.     psPtr = nextPtr) {
  1247. nextPtr  = psPtr->nextObjPtr;
  1248. /*
  1249.  * Be sure to remove each binding from its hash chain in the
  1250.  * pattern table.  If this is the last pattern in the chain,
  1251.  * then delete the hash entry too.
  1252.  */
  1253. prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
  1254. if (prevPtr == psPtr) {
  1255.     if (psPtr->nextSeqPtr == NULL) {
  1256. Tcl_DeleteHashEntry(psPtr->hPtr);
  1257.     } else {
  1258. Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  1259.     }
  1260. } else {
  1261.     for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  1262. if (prevPtr == NULL) {
  1263.     panic("Tk_DeleteAllBindings couldn't find on hash chain");
  1264. }
  1265. if (prevPtr->nextSeqPtr == psPtr) {
  1266.     prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  1267.     break;
  1268. }
  1269.     }
  1270. }
  1271. psPtr->flags |= MARKED_DELETED;
  1272. if (psPtr->refCount == 0) {
  1273.     if (psPtr->freeProc != NULL) {
  1274. (*psPtr->freeProc)(psPtr->clientData);
  1275.     }
  1276.     ckfree((char *) psPtr);
  1277. }
  1278.     }
  1279.     Tcl_DeleteHashEntry(hPtr);
  1280. }
  1281. /*
  1282.  *---------------------------------------------------------------------------
  1283.  *
  1284.  * Tk_BindEvent --
  1285.  *
  1286.  * This procedure is invoked to process an X event.  The
  1287.  * event is added to those recorded for the binding table.
  1288.  * Then each of the objects at *objectPtr is checked in
  1289.  * order to see if it has a binding that matches the recent
  1290.  * events.  If so, the most specific binding is invoked for
  1291.  * each object.
  1292.  *
  1293.  * Results:
  1294.  * None.
  1295.  *
  1296.  * Side effects:
  1297.  * Depends on the command associated with the matching binding.
  1298.  *
  1299.  * All Tcl bindings scripts for each object are accumulated before
  1300.  * the first binding is evaluated.  If the action of a Tcl binding
  1301.  * is to change or delete a binding, or delete the window associated
  1302.  * with the binding, all the original Tcl binding scripts will still
  1303.  * fire.  Contrast this with C binding procedures.  If a pending C
  1304.  * binding (one that hasn't fired yet, but is queued to be fired for
  1305.  * this window) is deleted, it will not be called, and if it is
  1306.  * changed, then the new binding procedure will be called.  If the
  1307.  * window itself is deleted, no further C binding procedures will be
  1308.  * called for this window.  When both Tcl binding scripts and C binding
  1309.  * procedures are interleaved, the above rules still apply. 
  1310.  *
  1311.  *---------------------------------------------------------------------------
  1312.  */
  1313. void
  1314. Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
  1315.     Tk_BindingTable bindingTable; /* Table in which to look for
  1316.  * bindings. */
  1317.     XEvent *eventPtr; /* What actually happened. */
  1318.     Tk_Window tkwin; /* Window on display where event
  1319.  * occurred (needed in order to
  1320.  * locate display information). */
  1321.     int numObjects; /* Number of objects at *objectPtr. */
  1322.     ClientData *objectPtr; /* Array of one or more objects
  1323.  * to check for a matching binding. */
  1324. {
  1325.     BindingTable *bindPtr;
  1326.     TkDisplay *dispPtr;
  1327.     ScreenInfo *screenPtr;
  1328.     BindInfo *bindInfoPtr;
  1329.     TkDisplay *oldDispPtr;
  1330.     XEvent *ringPtr;
  1331.     PatSeq *vMatchDetailList, *vMatchNoDetailList;
  1332.     int flags, oldScreen, i, deferModal;
  1333.     unsigned int matchCount, matchSpace;
  1334.     Tcl_Interp *interp;
  1335.     Tcl_DString scripts, savedResult;
  1336.     Detail detail;
  1337.     char *p, *end;
  1338.     PendingBinding *pendingPtr;
  1339.     PendingBinding staticPending;
  1340.     TkWindow *winPtr = (TkWindow *)tkwin;
  1341.     PatternTableKey key;
  1342.     Tk_ClassModalProc *modalProc;
  1343.     /*
  1344.      * Ignore events on windows that don't have names: these are windows
  1345.      * like wrapper windows that shouldn't be visible to the
  1346.      * application.
  1347.      */
  1348.     if (winPtr->pathName == NULL) {
  1349. return;
  1350.     }
  1351.     /*
  1352.      * Ignore the event completely if it is an Enter, Leave, FocusIn,
  1353.      * or FocusOut event with detail NotifyInferior.  The reason for
  1354.      * ignoring these events is that we don't want transitions between
  1355.      * a window and its children to visible to bindings on the parent:
  1356.      * this would cause problems for mega-widgets, since the internal
  1357.      * structure of a mega-widget isn't supposed to be visible to
  1358.      * people watching the parent.
  1359.      */
  1360.     if ((eventPtr->type == EnterNotify)  || (eventPtr->type == LeaveNotify)) {
  1361. if (eventPtr->xcrossing.detail == NotifyInferior) {
  1362.     return;
  1363. }
  1364.     }
  1365.     if ((eventPtr->type == FocusIn)  || (eventPtr->type == FocusOut)) {
  1366. if (eventPtr->xfocus.detail == NotifyInferior) {
  1367.     return;
  1368. }
  1369.     }
  1370.     bindPtr = (BindingTable *) bindingTable;
  1371.     dispPtr = ((TkWindow *) tkwin)->dispPtr;
  1372.     bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
  1373.     /*
  1374.      * Add the new event to the ring of saved events for the
  1375.      * binding table.  Two tricky points:
  1376.      *
  1377.      * 1. Combine consecutive MotionNotify events.  Do this by putting
  1378.      *    the new event *on top* of the previous event.
  1379.      * 2. If a modifier key is held down, it auto-repeats to generate
  1380.      *    continuous KeyPress and KeyRelease events.  These can flush
  1381.      *    the event ring so that valuable information is lost (such
  1382.      *    as repeated button clicks).  To handle this, check for the
  1383.      *    special case of a modifier KeyPress arriving when the previous
  1384.      *    two events are a KeyRelease and KeyPress of the same key.
  1385.      *    If this happens, mark the most recent event (the KeyRelease)
  1386.      *    invalid and put the new event on top of the event before that
  1387.      *    (the KeyPress).
  1388.      */
  1389.     if ((eventPtr->type == MotionNotify)
  1390.     && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
  1391. /*
  1392.  * Don't advance the ring pointer.
  1393.  */
  1394.     } else if (eventPtr->type == KeyPress) {
  1395. int i;
  1396. for (i = 0; ; i++) {
  1397.     if (i >= dispPtr->numModKeyCodes) {
  1398. goto advanceRingPointer;
  1399.     }
  1400.     if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
  1401. break;
  1402.     }
  1403. }
  1404. ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1405. if ((ringPtr->type != KeyRelease)
  1406. || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
  1407.     goto advanceRingPointer;
  1408. }
  1409. if (bindPtr->curEvent <= 0) {
  1410.     i = EVENT_BUFFER_SIZE - 1;
  1411. } else {
  1412.     i = bindPtr->curEvent - 1;
  1413. }
  1414. ringPtr = &bindPtr->eventRing[i];
  1415. if ((ringPtr->type != KeyPress)
  1416. || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
  1417.     goto advanceRingPointer;
  1418. }
  1419. bindPtr->eventRing[bindPtr->curEvent].type = -1;
  1420. bindPtr->curEvent = i;
  1421.     } else {
  1422. advanceRingPointer:
  1423. bindPtr->curEvent++;
  1424. if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
  1425.     bindPtr->curEvent = 0;
  1426. }
  1427.     }
  1428.     ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1429.     memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
  1430.     detail.clientData = 0;
  1431.     flags = flagArray[ringPtr->type];
  1432.     if (flags & KEY) {
  1433. detail.keySym = TkpGetKeySym(dispPtr, ringPtr);
  1434. if (detail.keySym == NoSymbol) {
  1435.     detail.keySym = 0;
  1436. }
  1437.     } else if (flags & BUTTON) {
  1438. detail.button = ringPtr->xbutton.button;
  1439.     } else if (flags & VIRTUAL) {
  1440. detail.name = ((XVirtualEvent *) ringPtr)->name;
  1441.     }
  1442.     bindPtr->detailRing[bindPtr->curEvent] = detail;
  1443.     /*
  1444.      * Find out if there are any virtual events that correspond to this
  1445.      * physical event (or sequence of physical events).
  1446.      */
  1447.     vMatchDetailList = NULL;
  1448.     vMatchNoDetailList = NULL;
  1449.     memset(&key, 0, sizeof(key));
  1450.     if (ringPtr->type != VirtualEvent) {
  1451. Tcl_HashTable *veptPtr;
  1452. Tcl_HashEntry *hPtr;
  1453. veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
  1454.         key.object  = NULL;
  1455. key.type    = ringPtr->type;
  1456. key.detail  = detail;
  1457. hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
  1458. if (hPtr != NULL) {
  1459.     vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
  1460. }
  1461. if (key.detail.clientData != 0) {
  1462.     key.detail.clientData = 0;
  1463.     hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
  1464.     if (hPtr != NULL) {
  1465.         vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
  1466.     }
  1467. }
  1468.     }
  1469.     /*
  1470.      * Loop over all the binding tags, finding the binding script or
  1471.      * callback for each one.  Append all of the binding scripts, with
  1472.      * %-sequences expanded, to "scripts", with null characters separating
  1473.      * the scripts for each object.  Append all the callbacks to the array
  1474.      * of pending callbacks.  
  1475.      */
  1476.        
  1477.     pendingPtr = &staticPending;
  1478.     matchCount = 0;
  1479.     matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
  1480.     Tcl_DStringInit(&scripts);
  1481.     for ( ; numObjects > 0; numObjects--, objectPtr++) {
  1482. PatSeq *matchPtr, *sourcePtr;
  1483. Tcl_HashEntry *hPtr;
  1484. matchPtr = NULL;
  1485. sourcePtr = NULL;
  1486. /*
  1487.  * Match the new event against those recorded in the pattern table,
  1488.  * saving the longest matching pattern.  For events with details
  1489.  * (button and key events), look for a binding for the specific
  1490.  * key or button.  First see if the event matches a physical event
  1491.  * that the object is interested in, then look for a virtual event.
  1492.  */
  1493. key.object = *objectPtr;
  1494. key.type = ringPtr->type;
  1495. key.detail = detail;
  1496. hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1497. if (hPtr != NULL) {
  1498.     matchPtr = MatchPatterns(dispPtr, bindPtr, 
  1499.     (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
  1500.     &sourcePtr);
  1501. }
  1502. if (vMatchDetailList != NULL) {
  1503.     matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
  1504.     matchPtr, objectPtr, &sourcePtr);
  1505. }
  1506. /*
  1507.  * If no match was found, look for a binding for all keys or buttons
  1508.  * (detail of 0).  Again, first match on a virtual event.
  1509.  */
  1510. if ((detail.clientData != 0) && (matchPtr == NULL)) {
  1511.     key.detail.clientData = 0;
  1512.     hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1513.     if (hPtr != NULL) {
  1514. matchPtr = MatchPatterns(dispPtr, bindPtr,
  1515. (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
  1516. &sourcePtr);
  1517.     }
  1518.     if (vMatchNoDetailList != NULL) {
  1519.         matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
  1520. matchPtr, objectPtr, &sourcePtr);
  1521.     }
  1522. }
  1523.     
  1524. if (matchPtr != NULL) {
  1525.     if (sourcePtr->eventProc == NULL) {
  1526. panic("Tk_BindEvent: missing command");
  1527.     }
  1528.     if (sourcePtr->eventProc == EvalTclBinding) {
  1529. ExpandPercents(winPtr, (char *) sourcePtr->clientData,
  1530. eventPtr, detail.keySym, &scripts);
  1531.     } else {
  1532. if (matchCount >= matchSpace) {
  1533.     PendingBinding *new;
  1534.     unsigned int oldSize, newSize;
  1535.     
  1536.     oldSize = sizeof(staticPending)
  1537.     - sizeof(staticPending.matchArray)
  1538.     + matchSpace * sizeof(PatSeq*);
  1539.     matchSpace *= 2;
  1540.     newSize = sizeof(staticPending)
  1541.     - sizeof(staticPending.matchArray)
  1542.     + matchSpace * sizeof(PatSeq*);
  1543.     new = (PendingBinding *) ckalloc(newSize);
  1544.     memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
  1545.     if (pendingPtr != &staticPending) {
  1546. ckfree((char *) pendingPtr);
  1547.     }
  1548.     pendingPtr = new;
  1549. }
  1550. sourcePtr->refCount++;
  1551. pendingPtr->matchArray[matchCount] = sourcePtr;
  1552. matchCount++;
  1553.     }
  1554.     /*
  1555.      * A "" is added to the scripts string to separate the
  1556.      * various scripts that should be invoked.
  1557.      */
  1558.     Tcl_DStringAppend(&scripts, "", 1);
  1559. }
  1560.     }
  1561.     if (Tcl_DStringLength(&scripts) == 0) {
  1562. return;
  1563.     }
  1564.     /*
  1565.      * Now go back through and evaluate the binding for each object,
  1566.      * in order, dealing with "break" and "continue" exceptions
  1567.      * appropriately.
  1568.      *
  1569.      * There are two tricks here:
  1570.      * 1. Bindings can be invoked from in the middle of Tcl commands,
  1571.      *    where the interp's result is significant (for example, a widget
  1572.      *    might be deleted because of an error in creating it, so the
  1573.      *    result contains an error message that is eventually going to
  1574.      *    be returned by the creating command).  To preserve the result,
  1575.      *    we save it in a dynamic string.
  1576.      * 2. The binding's action can potentially delete the binding,
  1577.      *    so bindPtr may not point to anything valid once the action
  1578.      *    completes.  Thus we have to save bindPtr->interp in a
  1579.      *    local variable in order to restore the result.
  1580.      */
  1581.     interp = bindPtr->interp;
  1582.     Tcl_DStringInit(&savedResult);
  1583.     /*
  1584.      * Save information about the current screen, then invoke a script
  1585.      * if the screen has changed.
  1586.      */
  1587.     Tcl_DStringGetResult(interp, &savedResult);
  1588.     screenPtr = &bindInfoPtr->screenInfo;
  1589.     oldDispPtr = screenPtr->curDispPtr;
  1590.     oldScreen = screenPtr->curScreenIndex;
  1591.     if ((dispPtr != screenPtr->curDispPtr)
  1592.     || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
  1593. screenPtr->curDispPtr = dispPtr;
  1594. screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
  1595. ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
  1596.     }
  1597.     if (matchCount > 0) {
  1598. /*
  1599.  * Remember the list of pending C binding callbacks, so we can mark
  1600.  * them as deleted and not call them if the act of evaluating a C
  1601.  * or Tcl binding deletes a C binding callback or even the whole
  1602.  * window.
  1603.  */
  1604. pendingPtr->nextPtr = bindInfoPtr->pendingList;
  1605. pendingPtr->tkwin = tkwin;
  1606. pendingPtr->deleted = 0;
  1607. bindInfoPtr->pendingList = pendingPtr;
  1608.     }
  1609.     
  1610.     /*
  1611.      * Save the current value of the TK_DEFER_MODAL flag so we can
  1612.      * restore it at the end of the loop.  Clear the flag so we can
  1613.      * detect any recursive requests for a modal loop.
  1614.      */
  1615.     flags = winPtr->flags;
  1616.     winPtr->flags &= ~TK_DEFER_MODAL;
  1617.     p = Tcl_DStringValue(&scripts);
  1618.     end = p + Tcl_DStringLength(&scripts);
  1619.     i = 0;
  1620.     /*
  1621.      * Be carefule when dereferencing screenPtr or bindInfoPtr.  If we
  1622.      * evaluate something that destroys ".", bindInfoPtr would have been
  1623.      * freed, but we can tell that by first checking to see if
  1624.      * winPtr->mainPtr == NULL.
  1625.      */
  1626.     Tcl_Preserve((ClientData) bindInfoPtr);
  1627.     while (p < end) {
  1628. int code;
  1629. if (!bindInfoPtr->deleted) {
  1630.     screenPtr->bindingDepth++;
  1631. }
  1632. Tcl_AllowExceptions(interp);
  1633. if (*p == '') {
  1634.     PatSeq *psPtr;
  1635.     
  1636.     psPtr = pendingPtr->matchArray[i];
  1637.     i++;
  1638.     code = TCL_OK;
  1639.     if ((pendingPtr->deleted == 0)
  1640.     && ((psPtr->flags & MARKED_DELETED) == 0)) {
  1641. code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
  1642. tkwin, detail.keySym);
  1643.     }
  1644.     psPtr->refCount--;
  1645.     if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
  1646. if (psPtr->freeProc != NULL) {
  1647.     (*psPtr->freeProc)(psPtr->clientData);
  1648. }
  1649. ckfree((char *) psPtr);
  1650.     }
  1651. } else {
  1652.     int len = (int) strlen(p);
  1653.     code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL);
  1654.     p += len;
  1655. }
  1656. p++;
  1657. if (!bindInfoPtr->deleted) {
  1658.     screenPtr->bindingDepth--;
  1659. }
  1660. if (code != TCL_OK) {
  1661.     if (code == TCL_CONTINUE) {
  1662. /*
  1663.  * Do nothing:  just go on to the next command.
  1664.  */
  1665.     } else if (code == TCL_BREAK) {
  1666. break;
  1667.     } else {
  1668. Tcl_AddErrorInfo(interp, "n    (command bound to event)");
  1669. Tcl_BackgroundError(interp);
  1670. break;
  1671.     }
  1672. }
  1673.     }
  1674.     if (matchCount > 0 && !pendingPtr->deleted) {
  1675. /*
  1676.  * Restore the original modal flag value and invoke the modal loop
  1677.  * if needed.
  1678.  */
  1679. deferModal = winPtr->flags & TK_DEFER_MODAL;
  1680. winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL) 
  1681.     | (flags & TK_DEFER_MODAL);
  1682. if (deferModal) {
  1683.     modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc);
  1684.     if (modalProc != NULL) {
  1685. (*modalProc)(tkwin, eventPtr);
  1686.     }
  1687. }
  1688.     }
  1689.     if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
  1690.     && ((oldDispPtr != screenPtr->curDispPtr)
  1691.                     || (oldScreen != screenPtr->curScreenIndex))) {
  1692. /*
  1693.  * Some other binding script is currently executing, but its
  1694.  * screen is no longer current.  Change the current display
  1695.  * back again.
  1696.  */
  1697. screenPtr->curDispPtr = oldDispPtr;
  1698. screenPtr->curScreenIndex = oldScreen;
  1699. ChangeScreen(interp, oldDispPtr->name, oldScreen);
  1700.     }
  1701.     Tcl_DStringResult(interp, &savedResult);
  1702.     Tcl_DStringFree(&scripts);
  1703.     if (matchCount > 0) {
  1704. if (!bindInfoPtr->deleted) {
  1705.     /*
  1706.      * Delete the pending list from the list of pending scripts
  1707.      * for this window.
  1708.      */
  1709.      
  1710.     PendingBinding **curPtrPtr;
  1711.     for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
  1712. if (*curPtrPtr == pendingPtr) {
  1713.     *curPtrPtr = pendingPtr->nextPtr;
  1714.     break;
  1715. }
  1716. curPtrPtr = &(*curPtrPtr)->nextPtr;
  1717.     }
  1718. }
  1719. if (pendingPtr != &staticPending) {
  1720.     ckfree((char *) pendingPtr);
  1721. }
  1722.     }
  1723.     Tcl_Release((ClientData) bindInfoPtr);
  1724. }
  1725. /*
  1726.  *---------------------------------------------------------------------------
  1727.  *
  1728.  * TkBindDeadWindow --
  1729.  *
  1730.  * This procedure is invoked when it is determined that a window is
  1731.  * dead.  It cleans up bind-related information about the window
  1732.  *
  1733.  * Results:
  1734.  * None.
  1735.  *
  1736.  * Side effects:
  1737.  * Any pending C bindings for this window are cancelled.
  1738.  *
  1739.  *---------------------------------------------------------------------------
  1740.  */
  1741.  
  1742. void
  1743. TkBindDeadWindow(winPtr)
  1744.     TkWindow *winPtr; /* The window that is being deleted. */
  1745. {
  1746.     BindInfo *bindInfoPtr;
  1747.     PendingBinding *curPtr;
  1748.     /*
  1749.      * Certain special windows like those used for send and clipboard
  1750.      * have no mainPtr.
  1751.      */
  1752.     if (winPtr->mainPtr == NULL)
  1753.         return;
  1754.     bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
  1755.     curPtr = bindInfoPtr->pendingList;
  1756.     while (curPtr != NULL) {
  1757. if (curPtr->tkwin == (Tk_Window) winPtr) {
  1758.     curPtr->deleted = 1;
  1759. }
  1760. curPtr = curPtr->nextPtr;
  1761.     }
  1762. }
  1763. /*
  1764.  *----------------------------------------------------------------------
  1765.  *
  1766.  * MatchPatterns --
  1767.  *
  1768.  *      Given a list of pattern sequences and a list of recent events,
  1769.  *      return the pattern sequence that best matches the event list,
  1770.  * if there is one.
  1771.  *
  1772.  * This procedure is used in two different ways.  In the simplest
  1773.  * use, "object" is NULL and psPtr is a list of pattern sequences,
  1774.  * each of which corresponds to a binding.  In this case, the
  1775.  * procedure finds the pattern sequences that match the event list
  1776.  * and returns the most specific of those, if there is more than one.
  1777.  *
  1778.  * In the second case, psPtr is a list of pattern sequences, each
  1779.  * of which corresponds to a definition for a virtual binding.
  1780.  * In order for one of these sequences to "match", it must match
  1781.  * the events (as above) but in addition there must be a binding
  1782.  * for its associated virtual event on the current object.  The
  1783.  * "object" argument indicates which object the binding must be for.
  1784.  *
  1785.  * Results:
  1786.  *      The return value is NULL if bestPtr is NULL and no pattern matches
  1787.  * the recent events from bindPtr.  Otherwise the return value is
  1788.  * the most specific pattern sequence among bestPtr and all those
  1789.  * at psPtr that match the event list and object.  If a pattern
  1790.  * sequence other than bestPtr is returned, then *bestCommandPtr
  1791.  * is filled in with a pointer to the command from the best sequence.
  1792.  *
  1793.  * Side effects:
  1794.  *      None.
  1795.  *
  1796.  *----------------------------------------------------------------------
  1797.  */
  1798. static PatSeq *
  1799. MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
  1800.     TkDisplay *dispPtr; /* Display from which the event came. */
  1801.     BindingTable *bindPtr; /* Information about binding table, such as
  1802.  * ring of recent events. */
  1803.     PatSeq *psPtr; /* List of pattern sequences. */
  1804.     PatSeq *bestPtr;  /* The best match seen so far, from a
  1805.  * previous call to this procedure.  NULL
  1806.  * means no prior best match. */
  1807.     ClientData *objectPtr; /* If NULL, the sequences at psPtr
  1808.  * correspond to "normal" bindings.  If
  1809.  * non-NULL, the sequences at psPtr correspond
  1810.  * to virtual bindings; in order to match each
  1811.  * sequence must correspond to a virtual
  1812.  * binding for which a binding exists for
  1813.  * object in bindPtr. */
  1814.     PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that
  1815.  * contains the eventProc and clientData
  1816.  * associated with the best match.  If this
  1817.  * differs from the return value, it is the
  1818.  * virtual event that most closely matched the
  1819.  * return value (a physical event).  Not
  1820.  * modified unless a result other than bestPtr
  1821.  * is returned. */
  1822. {
  1823.     PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
  1824.     bestSourcePtr = *sourcePtrPtr;
  1825.     /*
  1826.      * Iterate over all the pattern sequences.
  1827.      */
  1828.     for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
  1829. XEvent *eventPtr;
  1830. Pattern *patPtr;
  1831. Window window;
  1832. Detail *detailPtr;
  1833. int patCount, ringCount, flags, state;
  1834. int modMask;
  1835. /*
  1836.  * Iterate over all the patterns in a sequence to be
  1837.  * sure that they all match.
  1838.  */
  1839. eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1840. detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
  1841. window = eventPtr->xany.window;
  1842. patPtr = psPtr->pats;
  1843. patCount = psPtr->numPats;
  1844. ringCount = EVENT_BUFFER_SIZE;
  1845. while (patCount > 0) {
  1846.     if (ringCount <= 0) {
  1847. goto nextSequence;
  1848.     }
  1849.     if (eventPtr->xany.type != patPtr->eventType) {
  1850. /*
  1851.  * Most of the event types are considered superfluous
  1852.  * in that they are ignored if they occur in the middle
  1853.  * of a pattern sequence and have mismatching types.  The
  1854.  * only ones that cannot be ignored are ButtonPress and
  1855.  * ButtonRelease events (if the next event in the pattern
  1856.  * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
  1857.  * events (if the next pattern event is a ButtonPress or
  1858.  * ButtonRelease).  Here are some tricky cases to consider:
  1859.  * 1. Double-Button or Double-Key events.
  1860.  * 2. Double-ButtonRelease or Double-KeyRelease events.
  1861.  * 3. The arrival of various events like Enter and Leave
  1862.  *    and FocusIn and GraphicsExpose between two button
  1863.  *    presses or key presses.
  1864.  * 4. Modifier keys like Shift and Control shouldn't
  1865.  *    generate conflicts with button events.
  1866.  */
  1867. if ((patPtr->eventType == KeyPress)
  1868. || (patPtr->eventType == KeyRelease)) {
  1869.     if ((eventPtr->xany.type == ButtonPress)
  1870.     || (eventPtr->xany.type == ButtonRelease)) {
  1871. goto nextSequence;
  1872.     }
  1873. } else if ((patPtr->eventType == ButtonPress)
  1874. || (patPtr->eventType == ButtonRelease)) {
  1875.     if ((eventPtr->xany.type == KeyPress)
  1876.     || (eventPtr->xany.type == KeyRelease)) {
  1877. int i;
  1878. /*
  1879.  * Ignore key events if they are modifier keys.
  1880.  */
  1881. for (i = 0; i < dispPtr->numModKeyCodes; i++) {
  1882.     if (dispPtr->modKeyCodes[i]
  1883.     == eventPtr->xkey.keycode) {
  1884. /*
  1885.  * This key is a modifier key, so ignore it.
  1886.  */
  1887. goto nextEvent;
  1888.     }
  1889. }
  1890. goto nextSequence;
  1891.     }
  1892. }
  1893. goto nextEvent;
  1894.     }
  1895.     if (eventPtr->xany.type == CreateNotify
  1896. && eventPtr->xcreatewindow.parent != window) {
  1897. goto nextSequence;
  1898.     } else 
  1899.     if (eventPtr->xany.window != window) {
  1900. goto nextSequence;
  1901.     }
  1902.     /*
  1903.      * Note: it's important for the keysym check to go before
  1904.      * the modifier check, so we can ignore unwanted modifier
  1905.      * keys before choking on the modifier check.
  1906.      */
  1907.     if ((patPtr->detail.clientData != 0)
  1908.     && (patPtr->detail.clientData != detailPtr->clientData)) {
  1909. /*
  1910.  * The detail appears not to match.  However, if the event
  1911.  * is a KeyPress for a modifier key then just ignore the
  1912.  * event.  Otherwise event sequences like "aD" never match
  1913.  * because the shift key goes down between the "a" and the
  1914.  * "D".
  1915.  */
  1916. if (eventPtr->xany.type == KeyPress) {
  1917.     int i;
  1918.     for (i = 0; i < dispPtr->numModKeyCodes; i++) {
  1919. if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
  1920.     goto nextEvent;
  1921. }
  1922.     }
  1923. }
  1924. goto nextSequence;
  1925.     }
  1926.     flags = flagArray[eventPtr->type];
  1927.     if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
  1928. state = eventPtr->xkey.state;
  1929.     } else if (flags & CROSSING) {
  1930. state = eventPtr->xcrossing.state;
  1931.     } else {
  1932. state = 0;
  1933.     }
  1934.     if (patPtr->needMods != 0) {
  1935. modMask = patPtr->needMods;
  1936. if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
  1937.     modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
  1938. }
  1939. if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
  1940.     modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
  1941. }
  1942. if ((state & META_MASK) && (dispPtr->metaModMask != 0)) {
  1943.     state = (state & ~META_MASK) | dispPtr->metaModMask;
  1944. }
  1945. if ((state & ALT_MASK) && (dispPtr->altModMask != 0)) {
  1946.     state = (state & ~ALT_MASK) | dispPtr->altModMask;
  1947. }
  1948. if ((state & modMask) != modMask) {
  1949.     goto nextSequence;
  1950. }
  1951.     }
  1952.     if (psPtr->flags & PAT_NEARBY) {
  1953. XEvent *firstPtr;
  1954. int timeDiff;
  1955. firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1956. timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
  1957. if ((firstPtr->xkey.x_root
  1958.     < (eventPtr->xkey.x_root - NEARBY_PIXELS))
  1959. || (firstPtr->xkey.x_root
  1960.     > (eventPtr->xkey.x_root + NEARBY_PIXELS))
  1961. || (firstPtr->xkey.y_root
  1962.     < (eventPtr->xkey.y_root - NEARBY_PIXELS))
  1963. || (firstPtr->xkey.y_root
  1964.     > (eventPtr->xkey.y_root + NEARBY_PIXELS))
  1965. || (timeDiff > NEARBY_MS)) {
  1966.     goto nextSequence;
  1967. }
  1968.     }
  1969.     patPtr++;
  1970.     patCount--;
  1971.     nextEvent:
  1972.     if (eventPtr == bindPtr->eventRing) {
  1973. eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
  1974. detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
  1975.     } else {
  1976. eventPtr--;
  1977. detailPtr--;
  1978.     }
  1979.     ringCount--;
  1980. }
  1981. matchPtr = psPtr;
  1982. sourcePtr = psPtr;
  1983. if (objectPtr != NULL) {
  1984.     int iVirt;
  1985.     VirtualOwners *voPtr;
  1986.     PatternTableKey key;
  1987.     /*
  1988.      * The sequence matches the physical constraints.
  1989.      * Is this object interested in any of the virtual events
  1990.      * that correspond to this sequence?  
  1991.      */
  1992.     voPtr = psPtr->voPtr;
  1993.     memset(&key, 0, sizeof(key));
  1994.     key.object = *objectPtr;
  1995.     key.type = VirtualEvent;
  1996.     key.detail.clientData = 0;
  1997.     for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
  1998.         Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
  1999.         key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
  2000. hPtr);
  2001. hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
  2002. (char *) &key);
  2003. if (hPtr != NULL) {
  2004.     /*
  2005.      * This tag is interested in this virtual event and its
  2006.      * corresponding physical event is a good match with the
  2007.      * virtual event's definition.
  2008.      */
  2009.     PatSeq *virtMatchPtr;
  2010.     virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  2011.     if ((virtMatchPtr->numPats != 1)
  2012.     || (virtMatchPtr->nextSeqPtr != NULL)) {
  2013. panic("MatchPattern: badly constructed virtual event");
  2014.     }
  2015.     sourcePtr = virtMatchPtr;
  2016.     goto match;
  2017. }
  2018.     }
  2019.     /*
  2020.      * The physical event matches a virtual event's definition, but
  2021.      * the tag isn't interested in it.
  2022.      */
  2023.     goto nextSequence;
  2024. }
  2025. match:
  2026. /*
  2027.  * This sequence matches.  If we've already got another match,
  2028.  * pick whichever is most specific.  Detail is most important,
  2029.  * then needMods.
  2030.  */
  2031. if (bestPtr != NULL) {
  2032.     Pattern *patPtr2;
  2033.     int i;
  2034.     if (matchPtr->numPats != bestPtr->numPats) {
  2035. if (bestPtr->numPats > matchPtr->numPats) {
  2036.     goto nextSequence;
  2037. } else {
  2038.     goto newBest;
  2039. }
  2040.     }
  2041.     for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
  2042.     i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
  2043. if (patPtr->detail.clientData != patPtr2->detail.clientData) {
  2044.     if (patPtr->detail.clientData == 0) {
  2045. goto nextSequence;
  2046.     } else {
  2047. goto newBest;
  2048.     }
  2049. }
  2050. if (patPtr->needMods != patPtr2->needMods) {
  2051.     if ((patPtr->needMods & patPtr2->needMods)
  2052.     == patPtr->needMods) {
  2053. goto nextSequence;
  2054.     } else if ((patPtr->needMods & patPtr2->needMods)
  2055.     == patPtr2->needMods) {
  2056. goto newBest;
  2057.     }
  2058. }
  2059.     }
  2060.     /*
  2061.      * Tie goes to current best pattern.
  2062.      *
  2063.      * (1) For virtual vs. virtual, the least recently defined
  2064.      * virtual wins, because virtuals are examined in order of
  2065.      * definition.  This order is _not_ guaranteed in the
  2066.      * documentation.
  2067.      *
  2068.      * (2) For virtual vs. physical, the physical wins because all
  2069.      * the physicals are examined before the virtuals.  This order
  2070.      * is guaranteed in the documentation.
  2071.      *
  2072.      * (3) For physical vs. physical pattern, the most recently
  2073.      * defined physical wins, because physicals are examined in
  2074.      * reverse order of definition.  This order is guaranteed in
  2075.      * the documentation.
  2076.      */
  2077.     goto nextSequence;
  2078. }
  2079. newBest:
  2080. bestPtr = matchPtr;
  2081. bestSourcePtr = sourcePtr;
  2082. nextSequence:
  2083. continue;
  2084.     }
  2085.     *sourcePtrPtr = bestSourcePtr;
  2086.     return bestPtr;
  2087. }
  2088. /*
  2089.  *--------------------------------------------------------------
  2090.  *
  2091.  * ExpandPercents --
  2092.  *
  2093.  * Given a command and an event, produce a new command
  2094.  * by replacing % constructs in the original command
  2095.  * with information from the X event.
  2096.  *
  2097.  * Results:
  2098.  * The new expanded command is appended to the dynamic string
  2099.  * given by dsPtr.
  2100.  *
  2101.  * Side effects:
  2102.  * None.
  2103.  *
  2104.  *--------------------------------------------------------------
  2105.  */
  2106. static void
  2107. ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
  2108.     TkWindow *winPtr; /* Window where event occurred:  needed to
  2109.  * get input context. */
  2110.     CONST char *before; /* Command containing percent expressions
  2111.  * to be replaced. */
  2112.     XEvent *eventPtr; /* X event containing information to be
  2113.  * used in % replacements. */
  2114.     KeySym keySym; /* KeySym: only relevant for KeyPress and
  2115.  * KeyRelease events). */
  2116.     Tcl_DString *dsPtr; /* Dynamic string in which to append new
  2117.  * command. */
  2118. {
  2119.     int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl
  2120.  * list element. */
  2121.     int number, flags, length;
  2122. #define NUM_SIZE 40
  2123.     CONST char *string;
  2124.     Tcl_DString buf;
  2125.     char numStorage[NUM_SIZE+1];
  2126.     Tcl_DStringInit(&buf);
  2127.     if (eventPtr->type < TK_LASTEVENT) {
  2128. flags = flagArray[eventPtr->type];
  2129.     } else {
  2130. flags = 0;
  2131.     }
  2132.     while (1) {
  2133. /*
  2134.  * Find everything up to the next % character and append it
  2135.  * to the result string.
  2136.  */
  2137. for (string = before; (*string != 0) && (*string != '%'); string++) {
  2138.     /* Empty loop body. */
  2139. }
  2140. if (string != before) {
  2141.     Tcl_DStringAppend(dsPtr, before, (int) (string-before));
  2142.     before = string;
  2143. }
  2144. if (*before == 0) {
  2145.     break;
  2146. }