/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkbind.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkbind.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25