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