Mercurial > hg > xemacs-beta

comparison src/events.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children a5df635868b2
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Events: printing them, converting them to and from characters.
2 Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* Synched up with: Not in FSF. */
23
24 /* This file has been Mule-ized. */
25
26 #include <config.h>
27 #include "lisp.h"
28 #include "buffer.h"
29 #include "console.h"
30 #include "console-tty.h" /* for stuff in character_to_event */
31 #include "device.h"
32 #include "console-x.h" /* for x_event_name prototype */
33 #include "extents.h" /* Just for the EXTENTP abort check... */
34 #include "events.h"
35 #include "frame.h"
36 #include "glyphs.h"
37 #include "keymap.h" /* for key_desc_list_to_event() */
38 #include "redisplay.h"
39 #include "window.h"
40
41 #ifdef WINDOWSNT
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
45 */
46 #undef MOD_ALT
47 #undef MOD_CONTROL
48 #undef MOD_SHIFT
49 #endif
50
51 #include "events-mod.h"
52
53 /* Where old events go when they are explicitly deallocated.
54 The event chain here is cut loose before GC, so these will be freed
55 eventually.
56 */
57 static Lisp_Object Vevent_resource;
58
59 Lisp_Object Qeventp;
60 Lisp_Object Qevent_live_p;
61 Lisp_Object Qkey_press_event_p;
62 Lisp_Object Qbutton_event_p;
63 Lisp_Object Qmouse_event_p;
64 Lisp_Object Qprocess_event_p;
65
66 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
67 Lisp_Object Qascii_character;
68
69 EXFUN (Fevent_x_pixel, 1);
70 EXFUN (Fevent_y_pixel, 1);
71
72 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
73 void
74 clear_event_resource (void)
75 {
76 Vevent_resource = Qnil;
77 }
78
79 /* Make sure we lose quickly if we try to use this event */
80 static void
81 deinitialize_event (Lisp_Object ev)
82 {
83 int i;
84 struct Lisp_Event *event = XEVENT (ev);
85
86 for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++)
87 ((int *) event) [i] = 0xdeadbeef;
88 event->event_type = dead_event;
89 event->channel = Qnil;
90 set_lheader_implementation (&(event->lheader), &lrecord_event);
91 XSET_EVENT_NEXT (ev, Qnil);
92 }
93
94 /* Set everything to zero or nil so that it's predictable. */
95 void
96 zero_event (struct Lisp_Event *e)
97 {
98 xzero (*e);
99 set_lheader_implementation (&(e->lheader), &lrecord_event);
100 e->event_type = empty_event;
101 e->next = Qnil;
102 e->channel = Qnil;
103 }
104
105 static Lisp_Object
106 mark_event (Lisp_Object obj)
107 {
108 struct Lisp_Event *event = XEVENT (obj);
109
110 switch (event->event_type)
111 {
112 case key_press_event:
113 mark_object (event->event.key.keysym);
114 break;
115 case process_event:
116 mark_object (event->event.process.process);
117 break;
118 case timeout_event:
119 mark_object (event->event.timeout.function);
120 mark_object (event->event.timeout.object);
121 break;
122 case eval_event:
123 case misc_user_event:
124 mark_object (event->event.eval.function);
125 mark_object (event->event.eval.object);
126 break;
127 case magic_eval_event:
128 mark_object (event->event.magic_eval.object);
129 break;
130 case button_press_event:
131 case button_release_event:
132 case pointer_motion_event:
133 case magic_event:
134 case empty_event:
135 case dead_event:
136 break;
137 default:
138 abort ();
139 }
140 mark_object (event->channel);
141 return event->next;
142 }
143
144 static void
145 print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun)
146 {
147 char buf[255];
148 write_c_string (str, printcharfun);
149 format_event_object (buf, XEVENT (obj), 0);
150 write_c_string (buf, printcharfun);
151 }
152
153 static void
154 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
155 {
156 if (print_readably)
157 error ("Printing unreadable object #<event>");
158
159 switch (XEVENT (obj)->event_type)
160 {
161 case key_press_event:
162 print_event_1 ("#<keypress-event ", obj, printcharfun);
163 break;
164 case button_press_event:
165 print_event_1 ("#<buttondown-event ", obj, printcharfun);
166 break;
167 case button_release_event:
168 print_event_1 ("#<buttonup-event ", obj, printcharfun);
169 break;
170 case magic_event:
171 case magic_eval_event:
172 print_event_1 ("#<magic-event ", obj, printcharfun);
173 break;
174 case pointer_motion_event:
175 {
176 char buf[64];
177 Lisp_Object Vx, Vy;
178 Vx = Fevent_x_pixel (obj);
179 assert (INTP (Vx));
180 Vy = Fevent_y_pixel (obj);
181 assert (INTP (Vy));
182 sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
183 write_c_string (buf, printcharfun);
184 break;
185 }
186 case process_event:
187 write_c_string ("#<process-event ", printcharfun);
188 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
189 break;
190 case timeout_event:
191 write_c_string ("#<timeout-event ", printcharfun);
192 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
193 break;
194 case empty_event:
195 write_c_string ("#<empty-event", printcharfun);
196 break;
197 case misc_user_event:
198 write_c_string ("#<misc-user-event (", printcharfun);
199 print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
200 write_c_string (" ", printcharfun);
201 print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
202 write_c_string (")", printcharfun);
203 break;
204 case eval_event:
205 write_c_string ("#<eval-event (", printcharfun);
206 print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
207 write_c_string (" ", printcharfun);
208 print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
209 write_c_string (")", printcharfun);
210 break;
211 case dead_event:
212 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
213 break;
214 default:
215 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
216 break;
217 }
218 write_c_string (">", printcharfun);
219 }
220
221 static int
222 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
223 {
224 struct Lisp_Event *e1 = XEVENT (obj1);
225 struct Lisp_Event *e2 = XEVENT (obj2);
226
227 if (e1->event_type != e2->event_type) return 0;
228 if (!EQ (e1->channel, e2->channel)) return 0;
229 /* if (e1->timestamp != e2->timestamp) return 0; */
230 switch (e1->event_type)
231 {
232 default: abort ();
233
234 case process_event:
235 return EQ (e1->event.process.process, e2->event.process.process);
236
237 case timeout_event:
238 return (internal_equal (e1->event.timeout.function,
239 e2->event.timeout.function, 0) &&
240 internal_equal (e1->event.timeout.object,
241 e2->event.timeout.object, 0));
242
243 case key_press_event:
244 return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
245 (e1->event.key.modifiers == e2->event.key.modifiers));
246
247 case button_press_event:
248 case button_release_event:
249 return (e1->event.button.button == e2->event.button.button &&
250 e1->event.button.modifiers == e2->event.button.modifiers);
251
252 case pointer_motion_event:
253 return (e1->event.motion.x == e2->event.motion.x &&
254 e1->event.motion.y == e2->event.motion.y);
255
256 case misc_user_event:
257 return (internal_equal (e1->event.eval.function,
258 e2->event.eval.function, 0) &&
259 internal_equal (e1->event.eval.object,
260 e2->event.eval.object, 0) &&
261 /* is this really needed for equality
262 or is x and y also important? */
263 e1->event.misc.button == e2->event.misc.button &&
264 e1->event.misc.modifiers == e2->event.misc.modifiers);
265
266 case eval_event:
267 return (internal_equal (e1->event.eval.function,
268 e2->event.eval.function, 0) &&
269 internal_equal (e1->event.eval.object,
270 e2->event.eval.object, 0));
271
272 case magic_eval_event:
273 return (e1->event.magic_eval.internal_function ==
274 e2->event.magic_eval.internal_function &&
275 internal_equal (e1->event.magic_eval.object,
276 e2->event.magic_eval.object, 0));
277
278 case magic_event:
279 {
280 struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
281
282 #ifdef HAVE_X_WINDOWS
283 if (CONSOLE_X_P (con))
284 return (e1->event.magic.underlying_x_event.xany.serial ==
285 e2->event.magic.underlying_x_event.xany.serial);
286 #endif
287 #ifdef HAVE_TTY
288 if (CONSOLE_TTY_P (con))
289 return (e1->event.magic.underlying_tty_event ==
290 e2->event.magic.underlying_tty_event);
291 #endif
292 #ifdef HAVE_MS_WINDOWS
293 if (CONSOLE_MSWINDOWS_P (con))
294 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
295 &e2->event.magic.underlying_mswindows_event,
296 sizeof(union magic_data)));
297 #endif
298 return 1; /* not reached */
299 }
300
301 case empty_event: /* Empty and deallocated events are equal. */
302 case dead_event:
303 return 1;
304 }
305 }
306
307 static unsigned long
308 event_hash (Lisp_Object obj, int depth)
309 {
310 struct Lisp_Event *e = XEVENT (obj);
311 unsigned long hash;
312
313 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
314 switch (e->event_type)
315 {
316 case process_event:
317 return HASH2 (hash, LISP_HASH (e->event.process.process));
318
319 case timeout_event:
320 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
321 internal_hash (e->event.timeout.object, depth + 1));
322
323 case key_press_event:
324 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
325 e->event.key.modifiers);
326
327 case button_press_event:
328 case button_release_event:
329 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
330
331 case pointer_motion_event:
332 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
333
334 case misc_user_event:
335 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
336 internal_hash (e->event.misc.object, depth + 1),
337 e->event.misc.button, e->event.misc.modifiers);
338
339 case eval_event:
340 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
341 internal_hash (e->event.eval.object, depth + 1));
342
343 case magic_eval_event:
344 return HASH3 (hash,
345 (unsigned long) e->event.magic_eval.internal_function,
346 internal_hash (e->event.magic_eval.object, depth + 1));
347
348 case magic_event:
349 {
350 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
351 #ifdef HAVE_X_WINDOWS
352 if (CONSOLE_X_P (con))
353 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
354 #endif
355 #ifdef HAVE_TTY
356 if (CONSOLE_TTY_P (con))
357 return HASH2 (hash, e->event.magic.underlying_tty_event);
358 #endif
359 #ifdef HAVE_MS_WINDOWS
360 if (CONSOLE_MSWINDOWS_P (con))
361 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
362 #endif
363 }
364
365 case empty_event:
366 case dead_event:
367 return hash;
368
369 default:
370 abort ();
371 }
372
373 return 0; /* unreached */
374 }
375
376 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
377 mark_event, print_event, 0, event_equal,
378 event_hash, 0, struct Lisp_Event);
379
380
381 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
382 Return a new event of type TYPE, with properties described by PLIST.
383
384 TYPE is a symbol, either `empty', `key-press', `button-press',
385 `button-release', `misc-user' or `motion'. If TYPE is nil, it
386 defaults to `empty'.
387
388 PLIST is a property list, the properties being compatible to those
389 returned by `event-properties'. The following properties are
390 allowed:
391
392 channel -- The event channel, a frame or a console. For
393 button-press, button-release, misc-user and motion events,
394 this must be a frame. For key-press events, it must be
395 a console. If channel is unspecified, it will be set to
396 the selected frame or selected console, as appropriate.
397 key -- The event key, a symbol or character. Allowed only for
398 keypress events.
399 button -- The event button, integer 1, 2 or 3. Allowed for
400 button-press, button-release and misc-user events.
401 modifiers -- The event modifiers, a list of modifier symbols. Allowed
402 for key-press, button-press, button-release, motion and
403 misc-user events.
404 function -- Function. Allowed for misc-user events only.
405 object -- An object, function's parameter. Allowed for misc-user
406 events only.
407 x -- The event X coordinate, an integer. This is relative
408 to the left of CHANNEL's root window. Allowed for
409 motion, button-press, button-release and misc-user events.
410 y -- The event Y coordinate, an integer. This is relative
411 to the top of CHANNEL's root window. Allowed for
412 motion, button-press, button-release and misc-user events.
413 timestamp -- The event timestamp, a non-negative integer. Allowed for
414 all types of events. If unspecified, it will be set to 0
415 by default.
416
417 For event type `empty', PLIST must be nil.
418 `button-release', or `motion'. If TYPE is left out, it defaults to
419 `empty'.
420 PLIST is a list of properties, as returned by `event-properties'. Not
421 all properties are allowed for all kinds of events, and some are
422 required.
423
424 WARNING: the event object returned may be a reused one; see the function
425 `deallocate-event'.
426 */
427 (type, plist))
428 {
429 Lisp_Object tail, keyword, value;
430 Lisp_Object event = Qnil;
431 struct Lisp_Event *e;
432 EMACS_INT coord_x = 0, coord_y = 0;
433 struct gcpro gcpro1;
434
435 GCPRO1 (event);
436
437 if (NILP (type))
438 type = Qempty;
439
440 if (!NILP (Vevent_resource))
441 {
442 event = Vevent_resource;
443 Vevent_resource = XEVENT_NEXT (event);
444 }
445 else
446 {
447 event = allocate_event ();
448 }
449 e = XEVENT (event);
450 zero_event (e);
451
452 if (EQ (type, Qempty))
453 {
454 /* For empty event, we return immediately, without processing
455 PLIST. In fact, processing PLIST would be wrong, because the
456 sanitizing process would fill in the properties
457 (e.g. CHANNEL), which we don't want in empty events. */
458 e->event_type = empty_event;
459 if (!NILP (plist))
460 error ("Cannot set properties of empty event");
461 UNGCPRO;
462 return event;
463 }
464 else if (EQ (type, Qkey_press))
465 {
466 e->event_type = key_press_event;
467 e->event.key.keysym = Qunbound;
468 }
469 else if (EQ (type, Qbutton_press))
470 e->event_type = button_press_event;
471 else if (EQ (type, Qbutton_release))
472 e->event_type = button_release_event;
473 else if (EQ (type, Qmotion))
474 e->event_type = pointer_motion_event;
475 else if (EQ (type, Qmisc_user))
476 {
477 e->event_type = misc_user_event;
478 e->event.eval.function = e->event.eval.object = Qnil;
479 }
480 else
481 {
482 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
483 signal_simple_error ("Invalid event type", type);
484 }
485
486 EVENT_CHANNEL (e) = Qnil;
487
488 plist = Fcopy_sequence (plist);
489 Fcanonicalize_plist (plist, Qnil);
490
491 #define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \
492 error_with_frob (prop, "Invalid property for %s event", \
493 string_data (symbol_name (XSYMBOL (type))))
494
495 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist)
496 {
497 if (EQ (keyword, Qchannel))
498 {
499 if (e->event_type == key_press_event)
500 {
501 if (!CONSOLEP (value))
502 value = wrong_type_argument (Qconsolep, value);
503 }
504 else
505 {
506 if (!FRAMEP (value))
507 value = wrong_type_argument (Qframep, value);
508 }
509 EVENT_CHANNEL (e) = value;
510 }
511 else if (EQ (keyword, Qkey))
512 {
513 switch (e->event_type)
514 {
515 case key_press_event:
516 if (!SYMBOLP (value) && !CHARP (value))
517 signal_simple_error ("Invalid event key", value);
518 e->event.key.keysym = value;
519 break;
520 default:
521 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
522 break;
523 }
524 }
525 else if (EQ (keyword, Qbutton))
526 {
527 CHECK_NATNUM (value);
528 check_int_range (XINT (value), 0, 7);
529
530 switch (e->event_type)
531 {
532 case button_press_event:
533 case button_release_event:
534 e->event.button.button = XINT (value);
535 break;
536 case misc_user_event:
537 e->event.misc.button = XINT (value);
538 break;
539 default:
540 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
541 break;
542 }
543 }
544 else if (EQ (keyword, Qmodifiers))
545 {
546 int modifiers = 0;
547 Lisp_Object sym;
548
549 EXTERNAL_LIST_LOOP_2 (sym, value)
550 {
551 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL;
552 else if (EQ (sym, Qmeta)) modifiers |= MOD_META;
553 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER;
554 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER;
555 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT;
556 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT;
557 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT;
558 else
559 signal_simple_error ("Invalid key modifier", sym);
560 }
561
562 switch (e->event_type)
563 {
564 case key_press_event:
565 e->event.key.modifiers = modifiers;
566 break;
567 case button_press_event:
568 case button_release_event:
569 e->event.button.modifiers = modifiers;
570 break;
571 case pointer_motion_event:
572 e->event.motion.modifiers = modifiers;
573 break;
574 case misc_user_event:
575 e->event.misc.modifiers = modifiers;
576 break;
577 default:
578 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
579 break;
580 }
581 }
582 else if (EQ (keyword, Qx))
583 {
584 switch (e->event_type)
585 {
586 case pointer_motion_event:
587 case button_press_event:
588 case button_release_event:
589 case misc_user_event:
590 /* Allow negative values, so we can specify toolbar
591 positions. */
592 CHECK_INT (value);
593 coord_x = XINT (value);
594 break;
595 default:
596 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
597 break;
598 }
599 }
600 else if (EQ (keyword, Qy))
601 {
602 switch (e->event_type)
603 {
604 case pointer_motion_event:
605 case button_press_event:
606 case button_release_event:
607 case misc_user_event:
608 /* Allow negative values; see above. */
609 CHECK_INT (value);
610 coord_y = XINT (value);
611 break;
612 default:
613 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
614 break;
615 }
616 }
617 else if (EQ (keyword, Qtimestamp))
618 {
619 CHECK_NATNUM (value);
620 e->timestamp = XINT (value);
621 }
622 else if (EQ (keyword, Qfunction))
623 {
624 switch (e->event_type)
625 {
626 case misc_user_event:
627 e->event.eval.function = value;
628 break;
629 default:
630 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
631 break;
632 }
633 }
634 else if (EQ (keyword, Qobject))
635 {
636 switch (e->event_type)
637 {
638 case misc_user_event:
639 e->event.eval.object = value;
640 break;
641 default:
642 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
643 break;
644 }
645 }
646 else
647 signal_simple_error_2 ("Invalid property", keyword, value);
648 }
649
650 /* Insert the channel, if missing. */
651 if (NILP (EVENT_CHANNEL (e)))
652 {
653 if (e->event_type == key_press_event)
654 EVENT_CHANNEL (e) = Vselected_console;
655 else
656 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
657 }
658
659 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
660 to the frame, so we must adjust accordingly. */
661 if (FRAMEP (EVENT_CHANNEL (e)))
662 {
663 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
664 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
665
666 switch (e->event_type)
667 {
668 case pointer_motion_event:
669 e->event.motion.x = coord_x;
670 e->event.motion.y = coord_y;
671 break;
672 case button_press_event:
673 case button_release_event:
674 e->event.button.x = coord_x;
675 e->event.button.y = coord_y;
676 break;
677 case misc_user_event:
678 e->event.misc.x = coord_x;
679 e->event.misc.y = coord_y;
680 break;
681 default:
682 abort();
683 }
684 }
685
686 /* Finally, do some more validation. */
687 switch (e->event_type)
688 {
689 case key_press_event:
690 if (UNBOUNDP (e->event.key.keysym))
691 error ("A key must be specified to make a keypress event");
692 break;
693 case button_press_event:
694 if (!e->event.button.button)
695 error ("A button must be specified to make a button-press event");
696 break;
697 case button_release_event:
698 if (!e->event.button.button)
699 error ("A button must be specified to make a button-release event");
700 break;
701 case misc_user_event:
702 if (NILP (e->event.misc.function))
703 error ("A function must be specified to make a misc-user event");
704 break;
705 default:
706 break;
707 }
708
709 UNGCPRO;
710 return event;
711 }
712
713 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
714 Allow the given event structure to be reused.
715 You MUST NOT use this event object after calling this function with it.
716 You will lose. It is not necessary to call this function, as event
717 objects are garbage-collected like all other objects; however, it may
718 be more efficient to explicitly deallocate events when you are sure
719 that it is safe to do so.
720 */
721 (event))
722 {
723 CHECK_EVENT (event);
724
725 if (XEVENT_TYPE (event) == dead_event)
726 error ("this event is already deallocated!");
727
728 assert (XEVENT_TYPE (event) <= last_event_type);
729
730 #if 0
731 {
732 int i, len;
733
734 if (EQ (event, Vlast_command_event) ||
735 EQ (event, Vlast_input_event) ||
736 EQ (event, Vunread_command_event))
737 abort ();
738
739 len = XVECTOR_LENGTH (Vthis_command_keys);
740 for (i = 0; i < len; i++)
741 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
742 abort ();
743 if (!NILP (Vrecent_keys_ring))
744 {
745 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
746 for (i = 0; i < recent_ring_len; i++)
747 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
748 abort ();
749 }
750 }
751 #endif /* 0 */
752
753 assert (!EQ (event, Vevent_resource));
754 deinitialize_event (event);
755 #ifndef ALLOC_NO_POOLS
756 XSET_EVENT_NEXT (event, Vevent_resource);
757 Vevent_resource = event;
758 #endif
759 return Qnil;
760 }
761
762 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
763 Make a copy of the given event object.
764 If a second argument is given, the first event is copied into the second
765 and the second is returned. If the second argument is not supplied (or
766 is nil) then a new event will be made as with `allocate-event.' See also
767 the function `deallocate-event'.
768 */
769 (event1, event2))
770 {
771 CHECK_LIVE_EVENT (event1);
772 if (NILP (event2))
773 event2 = Fmake_event (Qnil, Qnil);
774 else CHECK_LIVE_EVENT (event2);
775 if (EQ (event1, event2))
776 return signal_simple_continuable_error_2
777 ("copy-event called with `eq' events", event1, event2);
778
779 assert (XEVENT_TYPE (event1) <= last_event_type);
780 assert (XEVENT_TYPE (event2) <= last_event_type);
781
782 {
783 Lisp_Object save_next = XEVENT_NEXT (event2);
784
785 *XEVENT (event2) = *XEVENT (event1);
786 XSET_EVENT_NEXT (event2, save_next);
787 return event2;
788 }
789 }
790
791
792
793 /* Given a chain of events (or possibly nil), deallocate them all. */
794
795 void
796 deallocate_event_chain (Lisp_Object event_chain)
797 {
798 while (!NILP (event_chain))
799 {
800 Lisp_Object next = XEVENT_NEXT (event_chain);
801 Fdeallocate_event (event_chain);
802 event_chain = next;
803 }
804 }
805
806 /* Return the last event in a chain.
807 NOTE: You cannot pass nil as a value here! The routine will
808 abort if you do. */
809
810 Lisp_Object
811 event_chain_tail (Lisp_Object event_chain)
812 {
813 while (1)
814 {
815 Lisp_Object next = XEVENT_NEXT (event_chain);
816 if (NILP (next))
817 return event_chain;
818 event_chain = next;
819 }
820 }
821
822 /* Enqueue a single event onto the end of a chain of events.
823 HEAD points to the first event in the chain, TAIL to the last event.
824 If the chain is empty, both values should be nil. */
825
826 void
827 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
828 {
829 assert (NILP (XEVENT_NEXT (event)));
830 assert (!EQ (*tail, event));
831
832 if (!NILP (*tail))
833 XSET_EVENT_NEXT (*tail, event);
834 else
835 *head = event;
836 *tail = event;
837
838 assert (!EQ (event, XEVENT_NEXT (event)));
839 }
840
841 /* Remove an event off the head of a chain of events and return it.
842 HEAD points to the first event in the chain, TAIL to the last event. */
843
844 Lisp_Object
845 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
846 {
847 Lisp_Object event;
848
849 event = *head;
850 *head = XEVENT_NEXT (event);
851 XSET_EVENT_NEXT (event, Qnil);
852 if (NILP (*head))
853 *tail = Qnil;
854 return event;
855 }
856
857 /* Enqueue a chain of events (or possibly nil) onto the end of another
858 chain of events. HEAD points to the first event in the chain being
859 queued onto, TAIL to the last event. If the chain is empty, both values
860 should be nil. */
861
862 void
863 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
864 Lisp_Object *tail)
865 {
866 if (NILP (event_chain))
867 return;
868
869 if (NILP (*head))
870 {
871 *head = event_chain;
872 *tail = event_chain;
873 }
874 else
875 {
876 XSET_EVENT_NEXT (*tail, event_chain);
877 *tail = event_chain_tail (event_chain);
878 }
879 }
880
881 /* Return the number of events (possibly 0) on an event chain. */
882
883 int
884 event_chain_count (Lisp_Object event_chain)
885 {
886 Lisp_Object event;
887 int n = 0;
888
889 EVENT_CHAIN_LOOP (event, event_chain)
890 n++;
891
892 return n;
893 }
894
895 /* Find the event before EVENT in an event chain. This aborts
896 if the event is not in the chain. */
897
898 Lisp_Object
899 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
900 {
901 Lisp_Object previous = Qnil;
902
903 while (!NILP (event_chain))
904 {
905 if (EQ (event_chain, event))
906 return previous;
907 previous = event_chain;
908 event_chain = XEVENT_NEXT (event_chain);
909 }
910
911 abort ();
912 return Qnil;
913 }
914
915 Lisp_Object
916 event_chain_nth (Lisp_Object event_chain, int n)
917 {
918 Lisp_Object event;
919 EVENT_CHAIN_LOOP (event, event_chain)
920 {
921 if (!n)
922 return event;
923 n--;
924 }
925 return Qnil;
926 }
927
928 Lisp_Object
929 copy_event_chain (Lisp_Object event_chain)
930 {
931 Lisp_Object new_chain = Qnil;
932 Lisp_Object new_chain_tail = Qnil;
933 Lisp_Object event;
934
935 EVENT_CHAIN_LOOP (event, event_chain)
936 {
937 Lisp_Object copy = Fcopy_event (event, Qnil);
938 enqueue_event (copy, &new_chain, &new_chain_tail);
939 }
940
941 return new_chain;
942 }
943
944
945
946 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
947 QKspace, QKdelete;
948
949 int
950 command_event_p (Lisp_Object event)
951 {
952 switch (XEVENT_TYPE (event))
953 {
954 case key_press_event:
955 case button_press_event:
956 case button_release_event:
957 case misc_user_event:
958 return 1;
959 default:
960 return 0;
961 }
962 }
963
964
965 void
966 character_to_event (Emchar c, struct Lisp_Event *event, struct console *con,
967 int use_console_meta_flag, int do_backspace_mapping)
968 {
969 Lisp_Object k = Qnil;
970 unsigned int m = 0;
971 if (event->event_type == dead_event)
972 error ("character-to-event called with a deallocated event!");
973
974 #ifndef MULE
975 c &= 255;
976 #endif
977 if (c > 127 && c <= 255)
978 {
979 int meta_flag = 1;
980 if (use_console_meta_flag && CONSOLE_TTY_P (con))
981 meta_flag = TTY_FLAGS (con).meta_key;
982 switch (meta_flag)
983 {
984 case 0: /* ignore top bit; it's parity */
985 c -= 128;
986 break;
987 case 1: /* top bit is meta */
988 c -= 128;
989 m = MOD_META;
990 break;
991 default: /* this is a real character */
992 break;
993 }
994 }
995 if (c < ' ') c += '@', m |= MOD_CONTROL;
996 if (m & MOD_CONTROL)
997 {
998 switch (c)
999 {
1000 case 'I': k = QKtab; m &= ~MOD_CONTROL; break;
1001 case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break;
1002 case 'M': k = QKreturn; m &= ~MOD_CONTROL; break;
1003 case '[': k = QKescape; m &= ~MOD_CONTROL; break;
1004 default:
1005 #if defined(HAVE_TTY)
1006 if (do_backspace_mapping &&
1007 CHARP (con->tty_erase_char) &&
1008 c - '@' == XCHAR (con->tty_erase_char))
1009 {
1010 k = QKbackspace;
1011 m &= ~MOD_CONTROL;
1012 }
1013 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1014 break;
1015 }
1016 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1017 }
1018 #if defined(HAVE_TTY)
1019 else if (do_backspace_mapping &&
1020 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1021 k = QKbackspace;
1022 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1023 else if (c == 127)
1024 k = QKdelete;
1025 else if (c == ' ')
1026 k = QKspace;
1027
1028 event->event_type = key_press_event;
1029 event->timestamp = 0; /* #### */
1030 event->channel = make_console (con);
1031 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1032 event->event.key.modifiers = m;
1033 }
1034
1035
1036 /* This variable controls what character name -> character code mapping
1037 we are using. Window-system-specific code sets this to some symbol,
1038 and we use that symbol as the plist key to convert keysyms into 8-bit
1039 codes. In this way one can have several character sets predefined and
1040 switch them by changing this.
1041 */
1042 Lisp_Object Vcharacter_set_property;
1043
1044 Emchar
1045 event_to_character (struct Lisp_Event *event,
1046 int allow_extra_modifiers,
1047 int allow_meta,
1048 int allow_non_ascii)
1049 {
1050 Emchar c = 0;
1051 Lisp_Object code;
1052
1053 if (event->event_type != key_press_event)
1054 {
1055 if (event->event_type == dead_event) abort ();
1056 return -1;
1057 }
1058 if (!allow_extra_modifiers &&
1059 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
1060 return -1;
1061 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1062 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1063 else if (!SYMBOLP (event->event.key.keysym))
1064 abort ();
1065 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1066 /* Allow window-system-specific extensibility of
1067 keysym->code mapping */
1068 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1069 Vcharacter_set_property,
1070 Qnil)))
1071 c = XCHAR_OR_CHAR_INT (code);
1072 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1073 Qascii_character, Qnil)))
1074 c = XCHAR_OR_CHAR_INT (code);
1075 else
1076 return -1;
1077
1078 if (event->event.key.modifiers & MOD_CONTROL)
1079 {
1080 if (c >= 'a' && c <= 'z')
1081 c -= ('a' - 'A');
1082 else
1083 /* reject Control-Shift- keys */
1084 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1085 return -1;
1086
1087 if (c >= '@' && c <= '_')
1088 c -= '@';
1089 else if (c == ' ') /* C-space and C-@ are the same. */
1090 c = 0;
1091 else
1092 /* reject keys that can't take Control- modifiers */
1093 if (! allow_extra_modifiers) return -1;
1094 }
1095
1096 if (event->event.key.modifiers & MOD_META)
1097 {
1098 if (! allow_meta) return -1;
1099 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1100 #ifdef MULE
1101 if (c >= 256) return -1;
1102 #endif
1103 c |= 0200;
1104 }
1105 return c;
1106 }
1107
1108 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1109 Return the closest ASCII approximation to the given event object.
1110 If the event isn't a keypress, this returns nil.
1111 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1112 its translation; it will ignore modifier keys other than control and meta,
1113 and will ignore the shift modifier on those characters which have no
1114 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1115 the same ASCII code as Control-A).
1116 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1117 represented by turning on the high bit of the byte returned; otherwise, nil
1118 will be returned for events containing the Meta modifier.
1119 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1120 present in the prevailing character set (see the `character-set-property'
1121 variable) will be returned as their code in that character set, instead of
1122 the return value being restricted to ASCII.
1123 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1124 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1125 */
1126 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1127 {
1128 Emchar c;
1129 CHECK_LIVE_EVENT (event);
1130 c = event_to_character (XEVENT (event),
1131 !NILP (allow_extra_modifiers),
1132 !NILP (allow_meta),
1133 !NILP (allow_non_ascii));
1134 return c < 0 ? Qnil : make_char (c);
1135 }
1136
1137 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1138 Convert keystroke CH into an event structure ,replete with bucky bits.
1139 The keystroke is the first argument, and the event to fill
1140 in is the second. This function contains knowledge about what the codes
1141 ``mean'' -- for example, the number 9 is converted to the character ``Tab'',
1142 not the distinct character ``Control-I''.
1143
1144 Note that CH (the keystroke specifier) can be an integer, a character,
1145 a symbol such as 'clear, or a list such as '(control backspace).
1146
1147 If the optional second argument is an event, it is modified;
1148 otherwise, a new event object is created.
1149
1150 Optional third arg CONSOLE is the console to store in the event, and
1151 defaults to the selected console.
1152
1153 If CH is an integer or character, the high bit may be interpreted as the
1154 meta key. (This is done for backward compatibility in lots of places.)
1155 If USE-CONSOLE-META-FLAG is nil, this will always be the case. If
1156 USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects
1157 whether the high bit is interpreted as a meta key. (See `set-input-mode'.)
1158 If you don't want this silly meta interpretation done, you should pass
1159 in a list containing the character.
1160
1161 Beware that character-to-event and event-to-character are not strictly
1162 inverse functions, since events contain much more information than the
1163 ASCII character set can encode.
1164 */
1165 (ch, event, console, use_console_meta_flag))
1166 {
1167 struct console *con = decode_console (console);
1168 if (NILP (event))
1169 event = Fmake_event (Qnil, Qnil);
1170 else
1171 CHECK_LIVE_EVENT (event);
1172 if (CONSP (ch) || SYMBOLP (ch))
1173 key_desc_list_to_event (ch, event, 1);
1174 else
1175 {
1176 CHECK_CHAR_COERCE_INT (ch);
1177 character_to_event (XCHAR (ch), XEVENT (event), con,
1178 !NILP (use_console_meta_flag), 1);
1179 }
1180 return event;
1181 }
1182
1183 void
1184 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1185 {
1186 assert (STRINGP (seq) || VECTORP (seq));
1187 assert (n < XINT (Flength (seq)));
1188
1189 if (STRINGP (seq))
1190 {
1191 Emchar ch = string_char (XSTRING (seq), n);
1192 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1193 }
1194 else
1195 {
1196 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1197 if (EVENTP (keystroke))
1198 Fcopy_event (keystroke, event);
1199 else
1200 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1201 }
1202 }
1203
1204 Lisp_Object
1205 key_sequence_to_event_chain (Lisp_Object seq)
1206 {
1207 int len = XINT (Flength (seq));
1208 int i;
1209 Lisp_Object head = Qnil, tail = Qnil;
1210
1211 for (i = 0; i < len; i++)
1212 {
1213 Lisp_Object event = Fmake_event (Qnil, Qnil);
1214 nth_of_key_sequence_as_event (seq, i, event);
1215 enqueue_event (event, &head, &tail);
1216 }
1217
1218 return head;
1219 }
1220
1221 void
1222 format_event_object (char *buf, struct Lisp_Event *event, int brief)
1223 {
1224 int mouse_p = 0;
1225 int mod = 0;
1226 Lisp_Object key;
1227
1228 switch (event->event_type)
1229 {
1230 case key_press_event:
1231 {
1232 mod = event->event.key.modifiers;
1233 key = event->event.key.keysym;
1234 /* Hack. */
1235 if (! brief && CHARP (key) &&
1236 mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER))
1237 {
1238 int k = XCHAR (key);
1239 if (k >= 'a' && k <= 'z')
1240 key = make_char (k - ('a' - 'A'));
1241 else if (k >= 'A' && k <= 'Z')
1242 mod |= MOD_SHIFT;
1243 }
1244 break;
1245 }
1246 case button_release_event:
1247 mouse_p++;
1248 /* Fall through */
1249 case button_press_event:
1250 {
1251 mouse_p++;
1252 mod = event->event.button.modifiers;
1253 key = make_char (event->event.button.button + '0');
1254 break;
1255 }
1256 case magic_event:
1257 {
1258 CONST char *name = NULL;
1259
1260 #ifdef HAVE_X_WINDOWS
1261 {
1262 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1263 if (CONSOLE_X_P (XCONSOLE (console)))
1264 name = x_event_name (event->event.magic.underlying_x_event.type);
1265 }
1266 #endif /* HAVE_X_WINDOWS */
1267 if (name) strcpy (buf, name);
1268 else strcpy (buf, "???");
1269 return;
1270 }
1271 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1272 case pointer_motion_event: strcpy (buf, "motion"); return;
1273 case misc_user_event: strcpy (buf, "misc-user"); return;
1274 case eval_event: strcpy (buf, "eval"); return;
1275 case process_event: strcpy (buf, "process"); return;
1276 case timeout_event: strcpy (buf, "timeout"); return;
1277 case empty_event: strcpy (buf, "empty"); return;
1278 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1279 default:
1280 abort ();
1281 }
1282 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1283 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1284 if (mod & MOD_CONTROL) modprint ("control-", "C-");
1285 if (mod & MOD_META) modprint ("meta-", "M-");
1286 if (mod & MOD_SUPER) modprint ("super-", "S-");
1287 if (mod & MOD_HYPER) modprint ("hyper-", "H-");
1288 if (mod & MOD_ALT) modprint ("alt-", "A-");
1289 if (mod & MOD_SHIFT) modprint ("shift-", "Sh-");
1290 if (mouse_p)
1291 {
1292 modprint1 ("button");
1293 --mouse_p;
1294 }
1295
1296 #undef modprint
1297 #undef modprint1
1298
1299 if (CHARP (key))
1300 {
1301 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1302 *buf = 0;
1303 }
1304 else if (SYMBOLP (key))
1305 {
1306 CONST char *str = 0;
1307 if (brief)
1308 {
1309 if (EQ (key, QKlinefeed)) str = "LFD";
1310 else if (EQ (key, QKtab)) str = "TAB";
1311 else if (EQ (key, QKreturn)) str = "RET";
1312 else if (EQ (key, QKescape)) str = "ESC";
1313 else if (EQ (key, QKdelete)) str = "DEL";
1314 else if (EQ (key, QKspace)) str = "SPC";
1315 else if (EQ (key, QKbackspace)) str = "BS";
1316 }
1317 if (str)
1318 {
1319 int i = strlen (str);
1320 memcpy (buf, str, i+1);
1321 str += i;
1322 }
1323 else
1324 {
1325 struct Lisp_String *name = XSYMBOL (key)->name;
1326 memcpy (buf, string_data (name), string_length (name) + 1);
1327 str += string_length (name);
1328 }
1329 }
1330 else
1331 abort ();
1332 if (mouse_p)
1333 strncpy (buf, "up", 4);
1334 }
1335
1336 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1337 True if OBJECT is an event object.
1338 */
1339 (object))
1340 {
1341 return EVENTP (object) ? Qt : Qnil;
1342 }
1343
1344 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1345 True if OBJECT is an event object that has not been deallocated.
1346 */
1347 (object))
1348 {
1349 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1350 Qt : Qnil;
1351 }
1352
1353 #if 0 /* debugging functions */
1354
1355 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1356 Return the event object's `next' event, or nil if it has none.
1357 The `next-event' field is changed by calling `set-next-event'.
1358 */
1359 (event))
1360 {
1361 struct Lisp_Event *e;
1362 CHECK_LIVE_EVENT (event);
1363
1364 return XEVENT_NEXT (event);
1365 }
1366
1367 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1368 Set the `next event' of EVENT to NEXT-EVENT.
1369 NEXT-EVENT must be an event object or nil.
1370 */
1371 (event, next_event))
1372 {
1373 Lisp_Object ev;
1374
1375 CHECK_LIVE_EVENT (event);
1376 if (NILP (next_event))
1377 {
1378 XSET_EVENT_NEXT (event, Qnil);
1379 return Qnil;
1380 }
1381
1382 CHECK_LIVE_EVENT (next_event);
1383
1384 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1385 {
1386 QUIT;
1387 if (EQ (ev, event))
1388 signal_error (Qerror,
1389 list3 (build_string ("Cyclic event-next"),
1390 event,
1391 next_event));
1392 }
1393 XSET_EVENT_NEXT (event, next_event);
1394 return next_event;
1395 }
1396
1397 #endif /* 0 */
1398
1399 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1400 Return the type of EVENT.
1401 This will be a symbol; one of
1402
1403 key-press A key was pressed.
1404 button-press A mouse button was pressed.
1405 button-release A mouse button was released.
1406 misc-user Some other user action happened; typically, this is
1407 a menu selection or scrollbar action.
1408 motion The mouse moved.
1409 process Input is available from a subprocess.
1410 timeout A timeout has expired.
1411 eval This causes a specified action to occur when dispatched.
1412 magic Some window-system-specific event has occurred.
1413 empty The event has been allocated but not assigned.
1414
1415 */
1416 (event))
1417 {
1418 CHECK_LIVE_EVENT (event);
1419 switch (XEVENT (event)->event_type)
1420 {
1421 case key_press_event: return Qkey_press;
1422 case button_press_event: return Qbutton_press;
1423 case button_release_event: return Qbutton_release;
1424 case misc_user_event: return Qmisc_user;
1425 case pointer_motion_event: return Qmotion;
1426 case process_event: return Qprocess;
1427 case timeout_event: return Qtimeout;
1428 case eval_event: return Qeval;
1429 case magic_event:
1430 case magic_eval_event:
1431 return Qmagic;
1432
1433 case empty_event:
1434 return Qempty;
1435
1436 default:
1437 abort ();
1438 return Qnil;
1439 }
1440 }
1441
1442 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1443 Return the timestamp of the event object EVENT.
1444 */
1445 (event))
1446 {
1447 CHECK_LIVE_EVENT (event);
1448 /* This junk is so that timestamps don't get to be negative, but contain
1449 as many bits as this particular emacs will allow.
1450 */
1451 return make_int (((1L << (VALBITS - 1)) - 1) &
1452 XEVENT (event)->timestamp);
1453 }
1454
1455 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1456 CHECK_LIVE_EVENT (e); \
1457 if (XEVENT(e)->event_type != (t1)) \
1458 e = wrong_type_argument (sym,e); \
1459 } while (0)
1460
1461 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1462 CHECK_LIVE_EVENT (e); \
1463 { \
1464 emacs_event_type CET_type = XEVENT (e)->event_type; \
1465 if (CET_type != (t1) && \
1466 CET_type != (t2)) \
1467 e = wrong_type_argument (sym,e); \
1468 } \
1469 } while (0)
1470
1471 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1472 CHECK_LIVE_EVENT (e); \
1473 { \
1474 emacs_event_type CET_type = XEVENT (e)->event_type; \
1475 if (CET_type != (t1) && \
1476 CET_type != (t2) && \
1477 CET_type != (t3)) \
1478 e = wrong_type_argument (sym,e); \
1479 } \
1480 } while (0)
1481
1482 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1483 Return the Keysym of the key-press event EVENT.
1484 This will be a character if the event is associated with one, else a symbol.
1485 */
1486 (event))
1487 {
1488 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1489 return XEVENT (event)->event.key.keysym;
1490 }
1491
1492 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1493 Return the button-number of the given button-press or button-release event.
1494 */
1495 (event))
1496 {
1497
1498 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1499 misc_user_event, Qbutton_event_p);
1500 #ifdef HAVE_WINDOW_SYSTEM
1501 if ( XEVENT (event)->event_type == misc_user_event)
1502 return make_int (XEVENT (event)->event.misc.button);
1503 else
1504 return make_int (XEVENT (event)->event.button.button);
1505 #else /* !HAVE_WINDOW_SYSTEM */
1506 return Qzero;
1507 #endif /* !HAVE_WINDOW_SYSTEM */
1508
1509 }
1510
1511 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1512 Return a number representing the modifier keys which were down
1513 when the given mouse or keyboard event was produced.
1514 See also the function event-modifiers.
1515 */
1516 (event))
1517 {
1518 again:
1519 CHECK_LIVE_EVENT (event);
1520 switch (XEVENT (event)->event_type)
1521 {
1522 case key_press_event:
1523 return make_int (XEVENT (event)->event.key.modifiers);
1524 case button_press_event:
1525 case button_release_event:
1526 return make_int (XEVENT (event)->event.button.modifiers);
1527 case pointer_motion_event:
1528 return make_int (XEVENT (event)->event.motion.modifiers);
1529 case misc_user_event:
1530 return make_int (XEVENT (event)->event.misc.modifiers);
1531 default:
1532 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1533 goto again;
1534 }
1535 }
1536
1537 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1538 Return a list of symbols, the names of the modifier keys
1539 which were down when the given mouse or keyboard event was produced.
1540 See also the function event-modifier-bits.
1541 */
1542 (event))
1543 {
1544 int mod = XINT (Fevent_modifier_bits (event));
1545 Lisp_Object result = Qnil;
1546 if (mod & MOD_SHIFT) result = Fcons (Qshift, result);
1547 if (mod & MOD_ALT) result = Fcons (Qalt, result);
1548 if (mod & MOD_HYPER) result = Fcons (Qhyper, result);
1549 if (mod & MOD_SUPER) result = Fcons (Qsuper, result);
1550 if (mod & MOD_META) result = Fcons (Qmeta, result);
1551 if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result);
1552 return result;
1553 }
1554
1555 static int
1556 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1557 {
1558 struct window *w;
1559 struct frame *f;
1560
1561 if (XEVENT (event)->event_type == pointer_motion_event)
1562 {
1563 *x = XEVENT (event)->event.motion.x;
1564 *y = XEVENT (event)->event.motion.y;
1565 }
1566 else if (XEVENT (event)->event_type == button_press_event ||
1567 XEVENT (event)->event_type == button_release_event)
1568 {
1569 *x = XEVENT (event)->event.button.x;
1570 *y = XEVENT (event)->event.button.y;
1571 }
1572 else if (XEVENT (event)->event_type == misc_user_event)
1573 {
1574 *x = XEVENT (event)->event.misc.x;
1575 *y = XEVENT (event)->event.misc.y;
1576 }
1577 else
1578 return 0;
1579
1580 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1581
1582 if (relative)
1583 {
1584 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1585
1586 if (!w)
1587 return 1; /* #### What should really happen here. */
1588
1589 *x -= w->pixel_left;
1590 *y -= w->pixel_top;
1591 }
1592 else
1593 {
1594 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1595 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1596 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1597 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1598 }
1599
1600 return 1;
1601 }
1602
1603 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1604 Return the X position in pixels of mouse event EVENT.
1605 The value returned is relative to the window the event occurred in.
1606 This will signal an error if the event is not a mouse event.
1607 See also `mouse-event-p' and `event-x-pixel'.
1608 */
1609 (event))
1610 {
1611 int x, y;
1612
1613 CHECK_LIVE_EVENT (event);
1614
1615 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1616 return wrong_type_argument (Qmouse_event_p, event);
1617 else
1618 return make_int (x);
1619 }
1620
1621 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1622 Return the Y position in pixels of mouse event EVENT.
1623 The value returned is relative to the window the event occurred in.
1624 This will signal an error if the event is not a mouse event.
1625 See also `mouse-event-p' and `event-y-pixel'.
1626 */
1627 (event))
1628 {
1629 int x, y;
1630
1631 CHECK_LIVE_EVENT (event);
1632
1633 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1634 return wrong_type_argument (Qmouse_event_p, event);
1635 else
1636 return make_int (y);
1637 }
1638
1639 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1640 Return the X position in pixels of mouse event EVENT.
1641 The value returned is relative to the frame the event occurred in.
1642 This will signal an error if the event is not a mouse event.
1643 See also `mouse-event-p' and `event-window-x-pixel'.
1644 */
1645 (event))
1646 {
1647 int x, y;
1648
1649 CHECK_LIVE_EVENT (event);
1650
1651 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1652 return wrong_type_argument (Qmouse_event_p, event);
1653 else
1654 return make_int (x);
1655 }
1656
1657 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1658 Return the Y position in pixels of mouse event EVENT.
1659 The value returned is relative to the frame the event occurred in.
1660 This will signal an error if the event is not a mouse event.
1661 See also `mouse-event-p' `event-window-y-pixel'.
1662 */
1663 (event))
1664 {
1665 int x, y;
1666
1667 CHECK_LIVE_EVENT (event);
1668
1669 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1670 return wrong_type_argument (Qmouse_event_p, event);
1671 else
1672 return make_int (y);
1673 }
1674
1675 /* Given an event, return a value:
1676
1677 OVER_TOOLBAR: over one of the 4 frame toolbars
1678 OVER_MODELINE: over a modeline
1679 OVER_BORDER: over an internal border
1680 OVER_NOTHING: over the text area, but not over text
1681 OVER_OUTSIDE: outside of the frame border
1682 OVER_TEXT: over text in the text area
1683 OVER_V_DIVIDER: over windows vertical divider
1684
1685 and return:
1686
1687 The X char position in CHAR_X, if not a null pointer.
1688 The Y char position in CHAR_Y, if not a null pointer.
1689 (These last two values are relative to the window the event is over.)
1690 The window it's over in W, if not a null pointer.
1691 The buffer position it's over in BUFP, if not a null pointer.
1692 The closest buffer position in CLOSEST, if not a null pointer.
1693
1694 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1695 */
1696
1697 static int
1698 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1699 int *obj_x, int *obj_y,
1700 struct window **w, Bufpos *bufp, Bufpos *closest,
1701 Charcount *modeline_closest,
1702 Lisp_Object *obj1, Lisp_Object *obj2)
1703 {
1704 int pix_x = 0;
1705 int pix_y = 0;
1706 int result;
1707 Lisp_Object frame;
1708
1709 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1710 struct window *ret_w;
1711 Bufpos ret_bufp, ret_closest;
1712 Charcount ret_modeline_closest;
1713 Lisp_Object ret_obj1, ret_obj2;
1714
1715 CHECK_LIVE_EVENT (event);
1716 frame = XEVENT (event)->channel;
1717 switch (XEVENT (event)->event_type)
1718 {
1719 case pointer_motion_event :
1720 pix_x = XEVENT (event)->event.motion.x;
1721 pix_y = XEVENT (event)->event.motion.y;
1722 break;
1723 case button_press_event :
1724 case button_release_event :
1725 pix_x = XEVENT (event)->event.button.x;
1726 pix_y = XEVENT (event)->event.button.y;
1727 break;
1728 case misc_user_event :
1729 pix_x = XEVENT (event)->event.misc.x;
1730 pix_y = XEVENT (event)->event.misc.y;
1731 break;
1732 default:
1733 dead_wrong_type_argument (Qmouse_event_p, event);
1734 }
1735
1736 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1737 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1738 &ret_w, &ret_bufp, &ret_closest,
1739 &ret_modeline_closest,
1740 &ret_obj1, &ret_obj2);
1741
1742 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1743 ret_bufp = 0;
1744 else if (ret_w && NILP (ret_w->buffer))
1745 /* Why does this happen? (Does it still happen?)
1746 I guess the window has gotten reused as a non-leaf... */
1747 ret_w = 0;
1748
1749 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1750 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1751 pointer points to random memory, often filled with 0, sometimes not.
1752 */
1753 /* #### Chuck, do we still need this crap? */
1754 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1755 #ifdef HAVE_TOOLBARS
1756 || TOOLBAR_BUTTONP (ret_obj1)
1757 #endif
1758 ))
1759 abort ();
1760 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1761 abort ();
1762
1763 if (char_x)
1764 *char_x = ret_x;
1765 if (char_y)
1766 *char_y = ret_y;
1767 if (obj_x)
1768 *obj_x = ret_obj_x;
1769 if (obj_y)
1770 *obj_y = ret_obj_y;
1771 if (w)
1772 *w = ret_w;
1773 if (bufp)
1774 *bufp = ret_bufp;
1775 if (closest)
1776 *closest = ret_closest;
1777 if (modeline_closest)
1778 *modeline_closest = ret_modeline_closest;
1779 if (obj1)
1780 *obj1 = ret_obj1;
1781 if (obj2)
1782 *obj2 = ret_obj2;
1783
1784 return result;
1785 }
1786
1787 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1788 Return t if the mouse event EVENT occurred over the text area of a window.
1789 The modeline is not considered to be part of the text area.
1790 */
1791 (event))
1792 {
1793 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1794
1795 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1796 }
1797
1798 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1799 Return t if the mouse event EVENT occurred over the modeline of a window.
1800 */
1801 (event))
1802 {
1803 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1804
1805 return result == OVER_MODELINE ? Qt : Qnil;
1806 }
1807
1808 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1809 Return t if the mouse event EVENT occurred over an internal border.
1810 */
1811 (event))
1812 {
1813 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1814
1815 return result == OVER_BORDER ? Qt : Qnil;
1816 }
1817
1818 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1819 Return t if the mouse event EVENT occurred over a toolbar.
1820 */
1821 (event))
1822 {
1823 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1824
1825 return result == OVER_TOOLBAR ? Qt : Qnil;
1826 }
1827
1828 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1829 Return t if the mouse event EVENT occurred over a window divider.
1830 */
1831 (event))
1832 {
1833 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1834
1835 return result == OVER_V_DIVIDER ? Qt : Qnil;
1836 }
1837
1838 struct console *
1839 event_console_or_selected (Lisp_Object event)
1840 {
1841 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1842 Lisp_Object console = CDFW_CONSOLE (channel);
1843
1844 if (NILP (console))
1845 console = Vselected_console;
1846
1847 return XCONSOLE (console);
1848 }
1849
1850 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1851 Return the channel that the event EVENT occurred on.
1852 This will be a frame, device, console, or nil for some types
1853 of events (e.g. eval events).
1854 */
1855 (event))
1856 {
1857 CHECK_LIVE_EVENT (event);
1858 return EVENT_CHANNEL (XEVENT (event));
1859 }
1860
1861 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1862 Return the window over which mouse event EVENT occurred.
1863 This may be nil if the event occurred in the border or over a toolbar.
1864 The modeline is considered to be within the window it describes.
1865 */
1866 (event))
1867 {
1868 struct window *w;
1869
1870 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1871
1872 if (!w)
1873 return Qnil;
1874 else
1875 {
1876 Lisp_Object window;
1877
1878 XSETWINDOW (window, w);
1879 return window;
1880 }
1881 }
1882
1883 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1884 Return the character position of the mouse event EVENT.
1885 If the event did not occur over a window, or did not occur over text,
1886 then this returns nil. Otherwise, it returns a position in the buffer
1887 visible in the event's window.
1888 */
1889 (event))
1890 {
1891 Bufpos bufp;
1892 struct window *w;
1893
1894 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1895
1896 return w && bufp ? make_int (bufp) : Qnil;
1897 }
1898
1899 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1900 Return the character position closest to the mouse event EVENT.
1901 If the event did not occur over a window or over text, return the
1902 closest point to the location of the event. If the Y pixel position
1903 overlaps a window and the X pixel position is to the left of that
1904 window, the closest point is the beginning of the line containing the
1905 Y position. If the Y pixel position overlaps a window and the X pixel
1906 position is to the right of that window, the closest point is the end
1907 of the line containing the Y position. If the Y pixel position is
1908 above a window, return 0. If it is below the last character in a window,
1909 return the value of (window-end).
1910 */
1911 (event))
1912 {
1913 Bufpos bufp;
1914
1915 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
1916
1917 return bufp ? make_int (bufp) : Qnil;
1918 }
1919
1920 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
1921 Return the X position of the mouse event EVENT in characters.
1922 This is relative to the window the event occurred over.
1923 */
1924 (event))
1925 {
1926 int char_x;
1927
1928 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1929
1930 return make_int (char_x);
1931 }
1932
1933 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
1934 Return the Y position of the mouse event EVENT in characters.
1935 This is relative to the window the event occurred over.
1936 */
1937 (event))
1938 {
1939 int char_y;
1940
1941 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
1942
1943 return make_int (char_y);
1944 }
1945
1946 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
1947 Return the character position in the modeline that EVENT occurred over.
1948 EVENT should be a mouse event. If EVENT did not occur over a modeline,
1949 nil is returned. You can determine the actual character that the
1950 event occurred over by looking in `generated-modeline-string' at the
1951 returned character position. Note that `generated-modeline-string'
1952 is buffer-local, and you must use EVENT's buffer when retrieving
1953 `generated-modeline-string' in order to get accurate results.
1954 */
1955 (event))
1956 {
1957 Charcount mbufp;
1958 int where;
1959
1960 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
1961
1962 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
1963 }
1964
1965 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
1966 Return the glyph that the mouse event EVENT occurred over, or nil.
1967 */
1968 (event))
1969 {
1970 Lisp_Object glyph;
1971 struct window *w;
1972
1973 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
1974
1975 return w && GLYPHP (glyph) ? glyph : Qnil;
1976 }
1977
1978 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
1979 Return the extent of the glyph that the mouse event EVENT occurred over.
1980 If the event did not occur over a glyph, nil is returned.
1981 */
1982 (event))
1983 {
1984 Lisp_Object extent;
1985 struct window *w;
1986
1987 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
1988
1989 return w && EXTENTP (extent) ? extent : Qnil;
1990 }
1991
1992 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
1993 Return the X pixel position of EVENT relative to the glyph it occurred over.
1994 EVENT should be a mouse event. If the event did not occur over a glyph,
1995 nil is returned.
1996 */
1997 (event))
1998 {
1999 Lisp_Object extent;
2000 struct window *w;
2001 int obj_x;
2002
2003 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2004
2005 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2006 }
2007
2008 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2009 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2010 EVENT should be a mouse event. If the event did not occur over a glyph,
2011 nil is returned.
2012 */
2013 (event))
2014 {
2015 Lisp_Object extent;
2016 struct window *w;
2017 int obj_y;
2018
2019 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2020
2021 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2022 }
2023
2024 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2025 Return the toolbar button that the mouse event EVENT occurred over.
2026 If the event did not occur over a toolbar button, nil is returned.
2027 */
2028 (event))
2029 {
2030 #ifdef HAVE_TOOLBARS
2031 Lisp_Object button;
2032
2033 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2034
2035 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2036 #else
2037 return Qnil;
2038 #endif
2039 }
2040
2041 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2042 Return the process of the given process-output event.
2043 */
2044 (event))
2045 {
2046 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2047 return XEVENT (event)->event.process.process;
2048 }
2049
2050 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2051 Return the callback function of EVENT.
2052 EVENT should be a timeout, misc-user, or eval event.
2053 */
2054 (event))
2055 {
2056 again:
2057 CHECK_LIVE_EVENT (event);
2058 switch (XEVENT (event)->event_type)
2059 {
2060 case timeout_event:
2061 return XEVENT (event)->event.timeout.function;
2062 case misc_user_event:
2063 return XEVENT (event)->event.misc.function;
2064 case eval_event:
2065 return XEVENT (event)->event.eval.function;
2066 default:
2067 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2068 goto again;
2069 }
2070 }
2071
2072 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2073 Return the callback function argument of EVENT.
2074 EVENT should be a timeout, misc-user, or eval event.
2075 */
2076 (event))
2077 {
2078 again:
2079 CHECK_LIVE_EVENT (event);
2080 switch (XEVENT (event)->event_type)
2081 {
2082 case timeout_event:
2083 return XEVENT (event)->event.timeout.object;
2084 case misc_user_event:
2085 return XEVENT (event)->event.misc.object;
2086 case eval_event:
2087 return XEVENT (event)->event.eval.object;
2088 default:
2089 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2090 goto again;
2091 }
2092 }
2093
2094 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2095 Return a list of all of the properties of EVENT.
2096 This is in the form of a property list (alternating keyword/value pairs).
2097 */
2098 (event))
2099 {
2100 Lisp_Object props = Qnil;
2101 struct Lisp_Event *e;
2102 struct gcpro gcpro1;
2103
2104 CHECK_LIVE_EVENT (event);
2105 e = XEVENT (event);
2106 GCPRO1 (props);
2107
2108 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2109
2110 switch (e->event_type)
2111 {
2112 default: abort ();
2113
2114 case process_event:
2115 props = cons3 (Qprocess, e->event.process.process, props);
2116 break;
2117
2118 case timeout_event:
2119 props = cons3 (Qobject, Fevent_object (event), props);
2120 props = cons3 (Qfunction, Fevent_function (event), props);
2121 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2122 break;
2123
2124 case key_press_event:
2125 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2126 props = cons3 (Qkey, Fevent_key (event), props);
2127 break;
2128
2129 case button_press_event:
2130 case button_release_event:
2131 props = cons3 (Qy, Fevent_y_pixel (event), props);
2132 props = cons3 (Qx, Fevent_x_pixel (event), props);
2133 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2134 props = cons3 (Qbutton, Fevent_button (event), props);
2135 break;
2136
2137 case pointer_motion_event:
2138 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2139 props = cons3 (Qy, Fevent_y_pixel (event), props);
2140 props = cons3 (Qx, Fevent_x_pixel (event), props);
2141 break;
2142
2143 case misc_user_event:
2144 props = cons3 (Qobject, Fevent_object (event), props);
2145 props = cons3 (Qfunction, Fevent_function (event), props);
2146 props = cons3 (Qy, Fevent_y_pixel (event), props);
2147 props = cons3 (Qx, Fevent_x_pixel (event), props);
2148 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2149 props = cons3 (Qbutton, Fevent_button (event), props);
2150 break;
2151
2152 case eval_event:
2153 props = cons3 (Qobject, Fevent_object (event), props);
2154 props = cons3 (Qfunction, Fevent_function (event), props);
2155 break;
2156
2157 case magic_eval_event:
2158 case magic_event:
2159 break;
2160
2161 case empty_event:
2162 RETURN_UNGCPRO (Qnil);
2163 break;
2164 }
2165
2166 props = cons3 (Qchannel, Fevent_channel (event), props);
2167 UNGCPRO;
2168
2169 return props;
2170 }
2171
2172
2173 /************************************************************************/
2174 /* initialization */
2175 /************************************************************************/
2176
2177 void
2178 syms_of_events (void)
2179 {
2180 DEFSUBR (Fcharacter_to_event);
2181 DEFSUBR (Fevent_to_character);
2182
2183 DEFSUBR (Fmake_event);
2184 DEFSUBR (Fdeallocate_event);
2185 DEFSUBR (Fcopy_event);
2186 DEFSUBR (Feventp);
2187 DEFSUBR (Fevent_live_p);
2188 DEFSUBR (Fevent_type);
2189 DEFSUBR (Fevent_properties);
2190
2191 DEFSUBR (Fevent_timestamp);
2192 DEFSUBR (Fevent_key);
2193 DEFSUBR (Fevent_button);
2194 DEFSUBR (Fevent_modifier_bits);
2195 DEFSUBR (Fevent_modifiers);
2196 DEFSUBR (Fevent_x_pixel);
2197 DEFSUBR (Fevent_y_pixel);
2198 DEFSUBR (Fevent_window_x_pixel);
2199 DEFSUBR (Fevent_window_y_pixel);
2200 DEFSUBR (Fevent_over_text_area_p);
2201 DEFSUBR (Fevent_over_modeline_p);
2202 DEFSUBR (Fevent_over_border_p);
2203 DEFSUBR (Fevent_over_toolbar_p);
2204 DEFSUBR (Fevent_over_vertical_divider_p);
2205 DEFSUBR (Fevent_channel);
2206 DEFSUBR (Fevent_window);
2207 DEFSUBR (Fevent_point);
2208 DEFSUBR (Fevent_closest_point);
2209 DEFSUBR (Fevent_x);
2210 DEFSUBR (Fevent_y);
2211 DEFSUBR (Fevent_modeline_position);
2212 DEFSUBR (Fevent_glyph);
2213 DEFSUBR (Fevent_glyph_extent);
2214 DEFSUBR (Fevent_glyph_x_pixel);
2215 DEFSUBR (Fevent_glyph_y_pixel);
2216 DEFSUBR (Fevent_toolbar_button);
2217 DEFSUBR (Fevent_process);
2218 DEFSUBR (Fevent_function);
2219 DEFSUBR (Fevent_object);
2220
2221 defsymbol (&Qeventp, "eventp");
2222 defsymbol (&Qevent_live_p, "event-live-p");
2223 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2224 defsymbol (&Qbutton_event_p, "button-event-p");
2225 defsymbol (&Qmouse_event_p, "mouse-event-p");
2226 defsymbol (&Qprocess_event_p, "process-event-p");
2227 defsymbol (&Qkey_press, "key-press");
2228 defsymbol (&Qbutton_press, "button-press");
2229 defsymbol (&Qbutton_release, "button-release");
2230 defsymbol (&Qmisc_user, "misc-user");
2231 defsymbol (&Qascii_character, "ascii-character");
2232
2233 defsymbol (&QKbackspace, "backspace");
2234 defsymbol (&QKtab, "tab");
2235 defsymbol (&QKlinefeed, "linefeed");
2236 defsymbol (&QKreturn, "return");
2237 defsymbol (&QKescape, "escape");
2238 defsymbol (&QKspace, "space");
2239 defsymbol (&QKdelete, "delete");
2240 }
2241
2242
2243 void
2244 reinit_vars_of_events (void)
2245 {
2246 Vevent_resource = Qnil;
2247 }
2248
2249 void
2250 vars_of_events (void)
2251 {
2252 reinit_vars_of_events ();
2253
2254 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2255 A symbol used to look up the 8-bit character of a keysym.
2256 To convert a keysym symbol to an 8-bit code, as when that key is
2257 bound to self-insert-command, we will look up the property that this
2258 variable names on the property list of the keysym-symbol. The window-
2259 system-specific code will set up appropriate properties and set this
2260 variable.
2261 */ );
2262 Vcharacter_set_property = Qnil;
2263 }