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.
5 This file is part of XEmacs.
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
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
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. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
30 #include "console-tty.h" /* for stuff in character_to_event */
32 #include "console-x.h" /* for x_event_name prototype */
33 #include "extents.h" /* Just for the EXTENTP abort check... */
37 #include "keymap.h" /* for key_desc_list_to_event() */
38 #include "redisplay.h"
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!
51 #include "events-mod.h"
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
57 static Lisp_Object Vevent_resource;
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;
66 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
67 Lisp_Object Qascii_character;
69 EXFUN (Fevent_x_pixel, 1);
70 EXFUN (Fevent_y_pixel, 1);
72 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
74 clear_event_resource (void)
76 Vevent_resource = Qnil;
79 /* Make sure we lose quickly if we try to use this event */
81 deinitialize_event (Lisp_Object ev)
84 struct Lisp_Event *event = XEVENT (ev);
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);
94 /* Set everything to zero or nil so that it's predictable. */
96 zero_event (struct Lisp_Event *e)
99 set_lheader_implementation (&(e->lheader), lrecord_event);
100 e->event_type = empty_event;
106 mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object))
108 struct Lisp_Event *event = XEVENT (obj);
110 switch (event->event_type)
112 case key_press_event:
113 ((markobj) (event->event.key.keysym));
116 ((markobj) (event->event.process.process));
119 ((markobj) (event->event.timeout.function));
120 ((markobj) (event->event.timeout.object));
123 case misc_user_event:
124 ((markobj) (event->event.eval.function));
125 ((markobj) (event->event.eval.object));
127 case magic_eval_event:
128 ((markobj) (event->event.magic_eval.object));
130 case button_press_event:
131 case button_release_event:
132 case pointer_motion_event:
140 ((markobj) (event->channel));
145 print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun)
148 write_c_string (str, printcharfun);
149 format_event_object (buf, XEVENT (obj), 0);
150 write_c_string (buf, printcharfun);
154 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
157 error ("printing unreadable object #<event>");
159 switch (XEVENT (obj)->event_type)
161 case key_press_event:
162 print_event_1 ("#<keypress-event ", obj, printcharfun);
164 case button_press_event:
165 print_event_1 ("#<buttondown-event ", obj, printcharfun);
167 case button_release_event:
168 print_event_1 ("#<buttonup-event ", obj, printcharfun);
171 case magic_eval_event:
172 print_event_1 ("#<magic-event ", obj, printcharfun);
174 case pointer_motion_event:
178 Vx = Fevent_x_pixel (obj);
180 Vy = Fevent_y_pixel (obj);
182 sprintf (buf, "#<motion-event %ld, %ld", (long)(XINT (Vx)), (long)(XINT (Vy)));
183 write_c_string (buf, printcharfun);
187 write_c_string ("#<process-event ", printcharfun);
188 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
191 write_c_string ("#<timeout-event ", printcharfun);
192 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
195 write_c_string ("#<empty-event", printcharfun);
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);
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);
212 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
215 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
218 write_c_string (">", printcharfun);
222 event_equal (Lisp_Object o1, Lisp_Object o2, int depth)
224 struct Lisp_Event *e1 = XEVENT (o1);
225 struct Lisp_Event *e2 = XEVENT (o2);
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)
233 return EQ (e1->event.process.process, e2->event.process.process);
236 return (internal_equal (e1->event.timeout.function,
237 e2->event.timeout.function, 0) &&
238 internal_equal (e1->event.timeout.object,
239 e2->event.timeout.object, 0));
241 case key_press_event:
242 return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
243 (e1->event.key.modifiers == e2->event.key.modifiers));
245 case button_press_event:
246 case button_release_event:
247 return (e1->event.button.button == e2->event.button.button &&
248 e1->event.button.modifiers == e2->event.button.modifiers);
250 case pointer_motion_event:
251 return (e1->event.motion.x == e2->event.motion.x &&
252 e1->event.motion.y == e2->event.motion.y);
254 case misc_user_event:
255 return (internal_equal (e1->event.eval.function,
256 e2->event.eval.function, 0) &&
257 internal_equal (e1->event.eval.object,
258 e2->event.eval.object, 0) &&
259 /* is this really needed for equality
260 or is x and y also important? */
261 e1->event.misc.button == e2->event.misc.button &&
262 e1->event.misc.modifiers == e2->event.misc.modifiers);
265 return (internal_equal (e1->event.eval.function,
266 e2->event.eval.function, 0) &&
267 internal_equal (e1->event.eval.object,
268 e2->event.eval.object, 0));
270 case magic_eval_event:
271 return (e1->event.magic_eval.internal_function ==
272 e2->event.magic_eval.internal_function &&
273 internal_equal (e1->event.magic_eval.object,
274 e2->event.magic_eval.object, 0));
278 struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
280 #ifdef HAVE_X_WINDOWS
281 if (CONSOLE_X_P (con))
282 return (e1->event.magic.underlying_x_event.xany.serial ==
283 e2->event.magic.underlying_x_event.xany.serial);
286 if (CONSOLE_TTY_P (con))
287 return (e1->event.magic.underlying_tty_event ==
288 e2->event.magic.underlying_tty_event);
290 #ifdef HAVE_MS_WINDOWS
291 if (CONSOLE_MSWINDOWS_P (con))
292 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
293 &e2->event.magic.underlying_mswindows_event,
294 sizeof(union magic_data)));
296 return 1; /* not reached */
299 case empty_event: /* Empty and deallocated events are equal. */
305 return 0; /* not reached; warning suppression */
310 event_hash (Lisp_Object obj, int depth)
312 struct Lisp_Event *e = XEVENT (obj);
315 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
316 switch (e->event_type)
319 return HASH2 (hash, LISP_HASH (e->event.process.process));
322 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
323 internal_hash (e->event.timeout.object, depth + 1));
325 case key_press_event:
326 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
327 e->event.key.modifiers);
329 case button_press_event:
330 case button_release_event:
331 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
333 case pointer_motion_event:
334 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
336 case misc_user_event:
337 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
338 internal_hash (e->event.misc.object, depth + 1),
339 e->event.misc.button, e->event.misc.modifiers);
342 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
343 internal_hash (e->event.eval.object, depth + 1));
345 case magic_eval_event:
347 (unsigned long) e->event.magic_eval.internal_function,
348 internal_hash (e->event.magic_eval.object, depth + 1));
352 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
353 #ifdef HAVE_X_WINDOWS
354 if (CONSOLE_X_P (con))
355 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
358 if (CONSOLE_TTY_P (con))
359 return HASH2 (hash, e->event.magic.underlying_tty_event);
361 #ifdef HAVE_MS_WINDOWS
362 if (CONSOLE_MSWINDOWS_P (con))
363 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
375 return 0; /* unreached */
378 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
379 mark_event, print_event, 0, event_equal,
380 event_hash, struct Lisp_Event);
383 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
384 Return a new event of type TYPE, with properties described by PLIST.
386 TYPE is a symbol, either `empty', `key-press', `button-press',
387 `button-release', `misc-user' or `motion'. If TYPE is nil, it
390 PLIST is a property list, the properties being compatible to those
391 returned by `event-properties'. The following properties are
394 channel -- The event channel, a frame or a console. For
395 button-press, button-release, misc-user and motion events,
396 this must be a frame. For key-press events, it must be
397 a console. If channel is unspecified, it will be set to
398 the selected frame or selected console, as appropriate.
399 key -- The event key, a symbol or character. Allowed only for
401 button -- The event button, integer 1, 2 or 3. Allowed for
402 button-press, button-release and misc-user events.
403 modifiers -- The event modifiers, a list of modifier symbols. Allowed
404 for key-press, button-press, button-release, motion and
406 function -- Function. Allowed for misc-user events only.
407 object -- An object, function's parameter. Allowed for misc-user
409 x -- The event X coordinate, an integer. This is relative
410 to the left of CHANNEL's root window. Allowed for
411 motion, button-press, button-release and misc-user events.
412 y -- The event Y coordinate, an integer. This is relative
413 to the top of CHANNEL's root window. Allowed for
414 motion, button-press, button-release and misc-user events.
415 timestamp -- The event timestamp, a non-negative integer. Allowed for
416 all types of events. If unspecified, it will be set to 0
419 For event type `empty', PLIST must be nil.
420 `button-release', or `motion'. If TYPE is left out, it defaults to
422 PLIST is a list of properties, as returned by `event-properties'. Not
423 all properties are allowed for all kinds of events, and some are
426 WARNING: the event object returned may be a reused one; see the function
431 Lisp_Object tail, keyword, value;
432 Lisp_Object event = Qnil;
433 struct Lisp_Event *e;
434 EMACS_INT coord_x = 0, coord_y = 0;
442 if (!NILP (Vevent_resource))
444 event = Vevent_resource;
445 Vevent_resource = XEVENT_NEXT (event);
449 event = allocate_event ();
454 if (EQ (type, Qempty))
456 /* For empty event, we return immediately, without processing
457 PLIST. In fact, processing PLIST would be wrong, because the
458 sanitizing process would fill in the properties
459 (e.g. CHANNEL), which we don't want in empty events. */
460 e->event_type = empty_event;
462 error ("Cannot set properties of empty event");
466 else if (EQ (type, Qkey_press))
468 e->event_type = key_press_event;
469 e->event.key.keysym = Qunbound;
471 else if (EQ (type, Qbutton_press))
472 e->event_type = button_press_event;
473 else if (EQ (type, Qbutton_release))
474 e->event_type = button_release_event;
475 else if (EQ (type, Qmotion))
476 e->event_type = pointer_motion_event;
477 else if (EQ (type, Qmisc_user))
479 e->event_type = misc_user_event;
480 e->event.eval.function = e->event.eval.object = Qnil;
484 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
485 signal_simple_error ("Invalid event type", type);
488 EVENT_CHANNEL (e) = Qnil;
490 plist = Fcopy_sequence (plist);
491 Fcanonicalize_plist (plist, Qnil);
493 #define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \
494 error_with_frob (prop, "Invalid property for %s event", \
495 string_data (symbol_name (XSYMBOL (type))))
497 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist)
499 if (EQ (keyword, Qchannel))
501 if (e->event_type == key_press_event)
503 if (!CONSOLEP (value))
504 value = wrong_type_argument (Qconsolep, value);
509 value = wrong_type_argument (Qframep, value);
511 EVENT_CHANNEL (e) = value;
513 else if (EQ (keyword, Qkey))
515 if (e->event_type != key_press_event)
516 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
517 if (!SYMBOLP (value) && !CHARP (value))
518 signal_simple_error ("Invalid event key", value);
519 e->event.key.keysym = value;
521 else if (EQ (keyword, Qbutton))
523 if (e->event_type != button_press_event
524 && e->event_type != button_release_event
525 && e->event_type != misc_user_event)
527 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
529 CHECK_NATNUM (value);
530 check_int_range (XINT (value), 0, 7);
531 if (e->event_type == misc_user_event)
532 e->event.misc.button = XINT (value);
534 e->event.button.button = XINT (value);
536 else if (EQ (keyword, Qmodifiers))
541 if (e->event_type != key_press_event
542 && e->event_type != button_press_event
543 && e->event_type != button_release_event
544 && e->event_type != pointer_motion_event
545 && e->event_type != misc_user_event)
547 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
550 EXTERNAL_LIST_LOOP (modtail, value)
552 Lisp_Object sym = XCAR (modtail);
553 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL;
554 else if (EQ (sym, Qmeta)) modifiers |= MOD_META;
555 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER;
556 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER;
557 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT;
558 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT;
559 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT;
561 signal_simple_error ("Invalid key modifier", sym);
563 if (e->event_type == key_press_event)
564 e->event.key.modifiers = modifiers;
565 else if (e->event_type == button_press_event
566 || e->event_type == button_release_event)
567 e->event.button.modifiers = modifiers;
568 else if (e->event_type == pointer_motion_event)
569 e->event.motion.modifiers = modifiers;
570 else /* misc_user_event */
571 e->event.misc.modifiers = modifiers;
573 else if (EQ (keyword, Qx))
575 if (e->event_type != pointer_motion_event
576 && e->event_type != button_press_event
577 && e->event_type != button_release_event
578 && e->event_type != misc_user_event)
580 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
582 /* Allow negative values, so we can specify toolbar
585 coord_x = XINT (value);
587 else if (EQ (keyword, Qy))
589 if (e->event_type != pointer_motion_event
590 && e->event_type != button_press_event
591 && e->event_type != button_release_event
592 && e->event_type != misc_user_event)
594 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
596 /* Allow negative values; see above. */
598 coord_y = XINT (value);
600 else if (EQ (keyword, Qtimestamp))
602 CHECK_NATNUM (value);
603 e->timestamp = XINT (value);
605 else if (EQ (keyword, Qfunction))
607 if (e->event_type != misc_user_event)
608 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
609 e->event.eval.function = value;
611 else if (EQ (keyword, Qobject))
613 if (e->event_type != misc_user_event)
614 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
615 e->event.eval.object = value;
618 signal_simple_error_2 ("Invalid property", keyword, value);
621 /* Insert the channel, if missing. */
622 if (NILP (EVENT_CHANNEL (e)))
624 if (e->event_type == key_press_event)
625 EVENT_CHANNEL (e) = Vselected_console;
627 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
630 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
631 to the frame, so we must adjust accordingly. */
632 if (e->event_type == pointer_motion_event
633 || e->event_type == button_press_event
634 || e->event_type == button_release_event
635 || e->event_type == misc_user_event)
637 struct frame *f = XFRAME (EVENT_CHANNEL (e));
639 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (f);
640 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (f);
642 if (e->event_type == pointer_motion_event)
644 e->event.motion.x = coord_x;
645 e->event.motion.y = coord_y;
647 else if (e->event_type == button_press_event
648 || e->event_type == button_release_event)
650 e->event.button.x = coord_x;
651 e->event.button.y = coord_y;
653 else if (e->event_type == misc_user_event)
655 e->event.misc.x = coord_x;
656 e->event.misc.y = coord_y;
660 /* Finally, do some more validation. */
661 switch (e->event_type)
663 case key_press_event:
664 if (UNBOUNDP (e->event.key.keysym)
665 || !(SYMBOLP (e->event.key.keysym) || CHARP (e->event.key.keysym)))
666 error ("Undefined key for keypress event");
668 case button_press_event:
669 case button_release_event:
670 if (!e->event.button.button)
671 error ("Undefined button for %s event",
672 e->event_type == button_press_event
673 ? "buton-press" : "button-release");
675 case misc_user_event:
676 if (NILP (e->event.misc.function))
677 error ("Undefined function for misc-user event");
687 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
688 Allow the given event structure to be reused.
689 You MUST NOT use this event object after calling this function with it.
690 You will lose. It is not necessary to call this function, as event
691 objects are garbage-collected like all other objects; however, it may
692 be more efficient to explicitly deallocate events when you are sure
693 that it is safe to do so.
699 if (XEVENT_TYPE (event) == dead_event)
700 error ("this event is already deallocated!");
702 assert (XEVENT_TYPE (event) <= last_event_type);
708 if (EQ (event, Vlast_command_event) ||
709 EQ (event, Vlast_input_event) ||
710 EQ (event, Vunread_command_event))
713 len = XVECTOR_LENGTH (Vthis_command_keys);
714 for (i = 0; i < len; i++)
715 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
717 if (!NILP (Vrecent_keys_ring))
719 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
720 for (i = 0; i < recent_ring_len; i++)
721 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
727 assert (!EQ (event, Vevent_resource));
728 deinitialize_event (event);
729 #ifndef ALLOC_NO_POOLS
730 XSET_EVENT_NEXT (event, Vevent_resource);
731 Vevent_resource = event;
736 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
737 Make a copy of the given event object.
738 If a second argument is given, the first event is copied into the second
739 and the second is returned. If the second argument is not supplied (or
740 is nil) then a new event will be made as with `allocate-event.' See also
741 the function `deallocate-event'.
745 CHECK_LIVE_EVENT (event1);
747 event2 = Fmake_event (Qnil, Qnil);
748 else CHECK_LIVE_EVENT (event2);
749 if (EQ (event1, event2))
750 return signal_simple_continuable_error_2
751 ("copy-event called with `eq' events", event1, event2);
753 assert (XEVENT_TYPE (event1) <= last_event_type);
754 assert (XEVENT_TYPE (event2) <= last_event_type);
757 Lisp_Object save_next = XEVENT_NEXT (event2);
759 *XEVENT (event2) = *XEVENT (event1);
760 XSET_EVENT_NEXT (event2, save_next);
767 /* Given a chain of events (or possibly nil), deallocate them all. */
770 deallocate_event_chain (Lisp_Object event_chain)
772 while (!NILP (event_chain))
774 Lisp_Object next = XEVENT_NEXT (event_chain);
775 Fdeallocate_event (event_chain);
780 /* Return the last event in a chain.
781 NOTE: You cannot pass nil as a value here! The routine will
785 event_chain_tail (Lisp_Object event_chain)
789 Lisp_Object next = XEVENT_NEXT (event_chain);
796 /* Enqueue a single event onto the end of a chain of events.
797 HEAD points to the first event in the chain, TAIL to the last event.
798 If the chain is empty, both values should be nil. */
801 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
803 assert (NILP (XEVENT_NEXT (event)));
804 assert (!EQ (*tail, event));
807 XSET_EVENT_NEXT (*tail, event);
812 assert (!EQ (event, XEVENT_NEXT (event)));
815 /* Remove an event off the head of a chain of events and return it.
816 HEAD points to the first event in the chain, TAIL to the last event. */
819 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
824 *head = XEVENT_NEXT (event);
825 XSET_EVENT_NEXT (event, Qnil);
831 /* Enqueue a chain of events (or possibly nil) onto the end of another
832 chain of events. HEAD points to the first event in the chain being
833 queued onto, TAIL to the last event. If the chain is empty, both values
837 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
840 if (NILP (event_chain))
850 XSET_EVENT_NEXT (*tail, event_chain);
851 *tail = event_chain_tail (event_chain);
855 /* Return the number of events (possibly 0) on an event chain. */
858 event_chain_count (Lisp_Object event_chain)
863 EVENT_CHAIN_LOOP (event, event_chain)
869 /* Find the event before EVENT in an event chain. This aborts
870 if the event is not in the chain. */
873 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
875 Lisp_Object previous = Qnil;
877 while (!NILP (event_chain))
879 if (EQ (event_chain, event))
881 previous = event_chain;
882 event_chain = XEVENT_NEXT (event_chain);
890 event_chain_nth (Lisp_Object event_chain, int n)
893 EVENT_CHAIN_LOOP (event, event_chain)
903 copy_event_chain (Lisp_Object event_chain)
905 Lisp_Object new_chain = Qnil;
906 Lisp_Object new_chain_tail = Qnil;
909 EVENT_CHAIN_LOOP (event, event_chain)
911 Lisp_Object copy = Fcopy_event (event, Qnil);
912 enqueue_event (copy, &new_chain, &new_chain_tail);
920 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
924 command_event_p (Lisp_Object event)
926 switch (XEVENT_TYPE (event))
928 case key_press_event:
929 case button_press_event:
930 case button_release_event:
931 case misc_user_event:
940 character_to_event (Emchar c, struct Lisp_Event *event, struct console *con,
941 int use_console_meta_flag, int do_backspace_mapping)
943 Lisp_Object k = Qnil;
945 if (event->event_type == dead_event)
946 error ("character-to-event called with a deallocated event!");
951 if (c > 127 && c <= 255)
954 if (use_console_meta_flag && CONSOLE_TTY_P (con))
955 meta_flag = TTY_FLAGS (con).meta_key;
958 case 0: /* ignore top bit; it's parity */
961 case 1: /* top bit is meta */
965 default: /* this is a real character */
969 if (c < ' ') c += '@', m |= MOD_CONTROL;
974 case 'I': k = QKtab; m &= ~MOD_CONTROL; break;
975 case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break;
976 case 'M': k = QKreturn; m &= ~MOD_CONTROL; break;
977 case '[': k = QKescape; m &= ~MOD_CONTROL; break;
979 #if defined(HAVE_TTY)
980 if (do_backspace_mapping &&
981 CHARP (con->tty_erase_char) &&
982 c - '@' == XCHAR (con->tty_erase_char))
987 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
990 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
992 #if defined(HAVE_TTY)
993 else if (do_backspace_mapping &&
994 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
996 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1002 event->event_type = key_press_event;
1003 event->timestamp = 0; /* #### */
1004 event->channel = make_console (con);
1005 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1006 event->event.key.modifiers = m;
1010 /* This variable controls what character name -> character code mapping
1011 we are using. Window-system-specific code sets this to some symbol,
1012 and we use that symbol as the plist key to convert keysyms into 8-bit
1013 codes. In this way one can have several character sets predefined and
1014 switch them by changing this.
1016 Lisp_Object Vcharacter_set_property;
1019 event_to_character (struct Lisp_Event *event,
1020 int allow_extra_modifiers,
1022 int allow_non_ascii)
1027 if (event->event_type != key_press_event)
1029 if (event->event_type == dead_event) abort ();
1032 if (!allow_extra_modifiers &&
1033 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
1035 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1036 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1037 else if (!SYMBOLP (event->event.key.keysym))
1039 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1040 /* Allow window-system-specific extensibility of
1041 keysym->code mapping */
1042 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1043 Vcharacter_set_property,
1045 c = XCHAR_OR_CHAR_INT (code);
1046 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1047 Qascii_character, Qnil)))
1048 c = XCHAR_OR_CHAR_INT (code);
1052 if (event->event.key.modifiers & MOD_CONTROL)
1054 if (c >= 'a' && c <= 'z')
1057 /* reject Control-Shift- keys */
1058 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1061 if (c >= '@' && c <= '_')
1063 else if (c == ' ') /* C-space and C-@ are the same. */
1066 /* reject keys that can't take Control- modifiers */
1067 if (! allow_extra_modifiers) return -1;
1070 if (event->event.key.modifiers & MOD_META)
1072 if (! allow_meta) return -1;
1073 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1075 if (c >= 256) return -1;
1082 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1083 Return the closest ASCII approximation to the given event object.
1084 If the event isn't a keypress, this returns nil.
1085 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1086 its translation; it will ignore modifier keys other than control and meta,
1087 and will ignore the shift modifier on those characters which have no
1088 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1089 the same ASCII code as Control-A).
1090 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1091 represented by turning on the high bit of the byte returned; otherwise, nil
1092 will be returned for events containing the Meta modifier.
1093 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1094 present in the prevailing character set (see the `character-set-property'
1095 variable) will be returned as their code in that character set, instead of
1096 the return value being restricted to ASCII.
1097 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1098 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1100 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1103 CHECK_LIVE_EVENT (event);
1104 c = event_to_character (XEVENT (event),
1105 !NILP (allow_extra_modifiers),
1107 !NILP (allow_non_ascii));
1108 return c < 0 ? Qnil : make_char (c);
1111 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1112 Convert keystroke CH into an event structure ,replete with bucky bits.
1113 The keystroke is the first argument, and the event to fill
1114 in is the second. This function contains knowledge about what the codes
1115 ``mean'' -- for example, the number 9 is converted to the character ``Tab'',
1116 not the distinct character ``Control-I''.
1118 Note that CH (the keystroke specifier) can be an integer, a character,
1119 a symbol such as 'clear, or a list such as '(control backspace).
1121 If the optional second argument is an event, it is modified;
1122 otherwise, a new event object is created.
1124 Optional third arg CONSOLE is the console to store in the event, and
1125 defaults to the selected console.
1127 If CH is an integer or character, the high bit may be interpreted as the
1128 meta key. (This is done for backward compatibility in lots of places.)
1129 If USE-CONSOLE-META-FLAG is nil, this will always be the case. If
1130 USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects
1131 whether the high bit is interpreted as a meta key. (See `set-input-mode'.)
1132 If you don't want this silly meta interpretation done, you should pass
1133 in a list containing the character.
1135 Beware that character-to-event and event-to-character are not strictly
1136 inverse functions, since events contain much more information than the
1137 ASCII character set can encode.
1139 (ch, event, console, use_console_meta_flag))
1141 struct console *con = decode_console (console);
1143 event = Fmake_event (Qnil, Qnil);
1145 CHECK_LIVE_EVENT (event);
1146 if (CONSP (ch) || SYMBOLP (ch))
1147 key_desc_list_to_event (ch, event, 1);
1150 CHECK_CHAR_COERCE_INT (ch);
1151 character_to_event (XCHAR (ch), XEVENT (event), con,
1152 !NILP (use_console_meta_flag), 1);
1158 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1160 assert (STRINGP (seq) || VECTORP (seq));
1161 assert (n < XINT (Flength (seq)));
1165 Emchar ch = string_char (XSTRING (seq), n);
1166 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1170 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1171 if (EVENTP (keystroke))
1172 Fcopy_event (keystroke, event);
1174 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1179 key_sequence_to_event_chain (Lisp_Object seq)
1181 int len = XINT (Flength (seq));
1183 Lisp_Object head = Qnil, tail = Qnil;
1185 for (i = 0; i < len; i++)
1187 Lisp_Object event = Fmake_event (Qnil, Qnil);
1188 nth_of_key_sequence_as_event (seq, i, event);
1189 enqueue_event (event, &head, &tail);
1196 format_event_object (char *buf, struct Lisp_Event *event, int brief)
1202 switch (event->event_type)
1204 case key_press_event:
1206 mod = event->event.key.modifiers;
1207 key = event->event.key.keysym;
1209 if (! brief && CHARP (key) &&
1210 mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER))
1212 int k = XCHAR (key);
1213 if (k >= 'a' && k <= 'z')
1214 key = make_char (k - ('a' - 'A'));
1215 else if (k >= 'A' && k <= 'Z')
1220 case button_release_event:
1223 case button_press_event:
1226 mod = event->event.button.modifiers;
1227 key = make_char (event->event.button.button + '0');
1232 CONST char *name = NULL;
1234 #ifdef HAVE_X_WINDOWS
1236 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1237 if (CONSOLE_X_P (XCONSOLE (console)))
1238 name = x_event_name (event->event.magic.underlying_x_event.type);
1240 #endif /* HAVE_X_WINDOWS */
1241 if (name) strcpy (buf, name);
1242 else strcpy (buf, "???");
1245 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1246 case pointer_motion_event: strcpy (buf, "motion"); return;
1247 case misc_user_event: strcpy (buf, "misc-user"); return;
1248 case eval_event: strcpy (buf, "eval"); return;
1249 case process_event: strcpy (buf, "process"); return;
1250 case timeout_event: strcpy (buf, "timeout"); return;
1251 case empty_event: strcpy (buf, "empty"); return;
1252 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1256 #define modprint1(x) { strcpy (buf, (x)); buf += sizeof (x)-1; }
1257 #define modprint(x,y) { if (brief) modprint1 (y) else modprint1 (x) }
1258 if (mod & MOD_CONTROL) modprint ("control-", "C-");
1259 if (mod & MOD_META) modprint ("meta-", "M-");
1260 if (mod & MOD_SUPER) modprint ("super-", "S-");
1261 if (mod & MOD_HYPER) modprint ("hyper-", "H-");
1262 if (mod & MOD_ALT) modprint ("alt-", "A-");
1263 if (mod & MOD_SHIFT) modprint ("shift-", "Sh-");
1266 modprint1 ("button");
1275 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1278 else if (SYMBOLP (key))
1280 CONST char *str = 0;
1283 if (EQ (key, QKlinefeed)) str = "LFD";
1284 else if (EQ (key, QKtab)) str = "TAB";
1285 else if (EQ (key, QKreturn)) str = "RET";
1286 else if (EQ (key, QKescape)) str = "ESC";
1287 else if (EQ (key, QKdelete)) str = "DEL";
1288 else if (EQ (key, QKspace)) str = "SPC";
1289 else if (EQ (key, QKbackspace)) str = "BS";
1293 int i = strlen (str);
1294 memcpy (buf, str, i+1);
1299 struct Lisp_String *name = XSYMBOL (key)->name;
1300 memcpy (buf, string_data (name), string_length (name) + 1);
1301 str += string_length (name);
1307 strncpy (buf, "up", 4);
1310 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1311 True if OBJECT is an event object.
1315 return EVENTP (object) ? Qt : Qnil;
1318 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1319 True if OBJECT is an event object that has not been deallocated.
1323 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1327 #if 0 /* debugging functions */
1329 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1330 Return the event object's `next' event, or nil if it has none.
1331 The `next-event' field is changed by calling `set-next-event'.
1335 struct Lisp_Event *e;
1336 CHECK_LIVE_EVENT (event);
1338 return XEVENT_NEXT (event);
1341 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1342 Set the `next event' of EVENT to NEXT-EVENT.
1343 NEXT-EVENT must be an event object or nil.
1345 (event, next_event))
1349 CHECK_LIVE_EVENT (event);
1350 if (NILP (next_event))
1352 XSET_EVENT_NEXT (event, Qnil);
1356 CHECK_LIVE_EVENT (next_event);
1358 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1362 signal_error (Qerror,
1363 list3 (build_string ("Cyclic event-next"),
1367 XSET_EVENT_NEXT (event, next_event);
1373 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1374 Return the type of EVENT.
1375 This will be a symbol; one of
1377 key-press A key was pressed.
1378 button-press A mouse button was pressed.
1379 button-release A mouse button was released.
1380 misc-user Some other user action happened; typically, this is
1381 a menu selection or scrollbar action.
1382 motion The mouse moved.
1383 process Input is available from a subprocess.
1384 timeout A timeout has expired.
1385 eval This causes a specified action to occur when dispatched.
1386 magic Some window-system-specific event has occurred.
1387 empty The event has been allocated but not assigned.
1392 CHECK_LIVE_EVENT (event);
1393 switch (XEVENT (event)->event_type)
1395 case key_press_event: return Qkey_press;
1396 case button_press_event: return Qbutton_press;
1397 case button_release_event: return Qbutton_release;
1398 case misc_user_event: return Qmisc_user;
1399 case pointer_motion_event: return Qmotion;
1400 case process_event: return Qprocess;
1401 case timeout_event: return Qtimeout;
1402 case eval_event: return Qeval;
1404 case magic_eval_event:
1416 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1417 Return the timestamp of the event object EVENT.
1421 CHECK_LIVE_EVENT (event);
1422 /* This junk is so that timestamps don't get to be negative, but contain
1423 as many bits as this particular emacs will allow.
1425 return make_int (((1L << (VALBITS - 1)) - 1) &
1426 XEVENT (event)->timestamp);
1429 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1430 CHECK_LIVE_EVENT (e); \
1431 if (XEVENT(e)->event_type != (t1)) \
1432 e = wrong_type_argument ((sym),(e)); \
1435 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1436 CHECK_LIVE_EVENT (e); \
1437 if (XEVENT(e)->event_type != (t1) && \
1438 XEVENT(e)->event_type != (t2)) \
1439 e = wrong_type_argument ((sym),(e)); \
1442 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1443 CHECK_LIVE_EVENT (e); \
1444 if (XEVENT(e)->event_type != (t1) && \
1445 XEVENT(e)->event_type != (t2) && \
1446 XEVENT(e)->event_type != (t3)) \
1447 e = wrong_type_argument ((sym),(e)); \
1450 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1451 Return the Keysym of the key-press event EVENT.
1452 This will be a character if the event is associated with one, else a symbol.
1456 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1457 return XEVENT (event)->event.key.keysym;
1460 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1461 Return the button-number of the given button-press or button-release event.
1466 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1467 misc_user_event, Qbutton_event_p);
1468 #ifdef HAVE_WINDOW_SYSTEM
1469 if ( XEVENT (event)->event_type == misc_user_event)
1470 return make_int (XEVENT (event)->event.misc.button);
1472 return make_int (XEVENT (event)->event.button.button);
1473 #else /* !HAVE_WINDOW_SYSTEM */
1475 #endif /* !HAVE_WINDOW_SYSTEM */
1479 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1480 Return a number representing the modifier keys which were down
1481 when the given mouse or keyboard event was produced.
1482 See also the function event-modifiers.
1487 CHECK_LIVE_EVENT (event);
1488 switch (XEVENT (event)->event_type)
1490 case key_press_event:
1491 return make_int (XEVENT (event)->event.key.modifiers);
1492 case button_press_event:
1493 case button_release_event:
1494 return make_int (XEVENT (event)->event.button.modifiers);
1495 case pointer_motion_event:
1496 return make_int (XEVENT (event)->event.motion.modifiers);
1497 case misc_user_event:
1498 return make_int (XEVENT (event)->event.misc.modifiers);
1500 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1505 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1506 Return a list of symbols, the names of the modifier keys
1507 which were down when the given mouse or keyboard event was produced.
1508 See also the function event-modifier-bits.
1512 int mod = XINT (Fevent_modifier_bits (event));
1513 Lisp_Object result = Qnil;
1514 if (mod & MOD_SHIFT) result = Fcons (Qshift, result);
1515 if (mod & MOD_ALT) result = Fcons (Qalt, result);
1516 if (mod & MOD_HYPER) result = Fcons (Qhyper, result);
1517 if (mod & MOD_SUPER) result = Fcons (Qsuper, result);
1518 if (mod & MOD_META) result = Fcons (Qmeta, result);
1519 if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result);
1524 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1529 if (XEVENT (event)->event_type == pointer_motion_event)
1531 *x = XEVENT (event)->event.motion.x;
1532 *y = XEVENT (event)->event.motion.y;
1534 else if (XEVENT (event)->event_type == button_press_event ||
1535 XEVENT (event)->event_type == button_release_event)
1537 *x = XEVENT (event)->event.button.x;
1538 *y = XEVENT (event)->event.button.y;
1540 else if (XEVENT (event)->event_type == misc_user_event)
1542 *x = XEVENT (event)->event.misc.x;
1543 *y = XEVENT (event)->event.misc.y;
1548 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1552 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1555 return 1; /* #### What should really happen here. */
1557 *x -= w->pixel_left;
1562 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1563 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1564 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1565 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1571 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1572 Return the X position in pixels of mouse event EVENT.
1573 The value returned is relative to the window the event occurred in.
1574 This will signal an error if the event is not a mouse event.
1575 See also `mouse-event-p' and `event-x-pixel'.
1581 CHECK_LIVE_EVENT (event);
1583 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1584 return wrong_type_argument (Qmouse_event_p, event);
1586 return make_int (x);
1589 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1590 Return the Y position in pixels of mouse event EVENT.
1591 The value returned is relative to the window the event occurred in.
1592 This will signal an error if the event is not a mouse event.
1593 See also `mouse-event-p' and `event-y-pixel'.
1599 CHECK_LIVE_EVENT (event);
1601 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1602 return wrong_type_argument (Qmouse_event_p, event);
1604 return make_int (y);
1607 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1608 Return the X position in pixels of mouse event EVENT.
1609 The value returned is relative to the frame the event occurred in.
1610 This will signal an error if the event is not a mouse event.
1611 See also `mouse-event-p' and `event-window-x-pixel'.
1617 CHECK_LIVE_EVENT (event);
1619 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1620 return wrong_type_argument (Qmouse_event_p, event);
1622 return make_int (x);
1625 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1626 Return the Y position in pixels of mouse event EVENT.
1627 The value returned is relative to the frame the event occurred in.
1628 This will signal an error if the event is not a mouse event.
1629 See also `mouse-event-p' `event-window-y-pixel'.
1635 CHECK_LIVE_EVENT (event);
1637 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1638 return wrong_type_argument (Qmouse_event_p, event);
1640 return make_int (y);
1643 /* Given an event, return a value:
1645 OVER_TOOLBAR: over one of the 4 frame toolbars
1646 OVER_MODELINE: over a modeline
1647 OVER_BORDER: over an internal border
1648 OVER_NOTHING: over the text area, but not over text
1649 OVER_OUTSIDE: outside of the frame border
1650 OVER_TEXT: over text in the text area
1651 OVER_V_DIVIDER: over windows vertical divider
1655 The X char position in CHAR_X, if not a null pointer.
1656 The Y char position in CHAR_Y, if not a null pointer.
1657 (These last two values are relative to the window the event is over.)
1658 The window it's over in W, if not a null pointer.
1659 The buffer position it's over in BUFP, if not a null pointer.
1660 The closest buffer position in CLOSEST, if not a null pointer.
1662 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1666 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1667 int *obj_x, int *obj_y,
1668 struct window **w, Bufpos *bufp, Bufpos *closest,
1669 Charcount *modeline_closest,
1670 Lisp_Object *obj1, Lisp_Object *obj2)
1677 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1678 struct window *ret_w;
1679 Bufpos ret_bufp, ret_closest;
1680 Charcount ret_modeline_closest;
1681 Lisp_Object ret_obj1, ret_obj2;
1683 CHECK_LIVE_EVENT (event);
1684 frame = XEVENT (event)->channel;
1685 switch (XEVENT (event)->event_type)
1687 case pointer_motion_event :
1688 pix_x = XEVENT (event)->event.motion.x;
1689 pix_y = XEVENT (event)->event.motion.y;
1691 case button_press_event :
1692 case button_release_event :
1693 pix_x = XEVENT (event)->event.button.x;
1694 pix_y = XEVENT (event)->event.button.y;
1696 case misc_user_event :
1697 pix_x = XEVENT (event)->event.misc.x;
1698 pix_y = XEVENT (event)->event.misc.y;
1701 dead_wrong_type_argument (Qmouse_event_p, event);
1704 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1705 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1706 &ret_w, &ret_bufp, &ret_closest,
1707 &ret_modeline_closest,
1708 &ret_obj1, &ret_obj2);
1710 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1712 else if (ret_w && NILP (ret_w->buffer))
1713 /* Why does this happen? (Does it still happen?)
1714 I guess the window has gotten reused as a non-leaf... */
1717 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1718 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1719 pointer points to random memory, often filled with 0, sometimes not.
1721 /* #### Chuck, do we still need this crap? */
1722 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1723 #ifdef HAVE_TOOLBARS
1724 || TOOLBAR_BUTTONP (ret_obj1)
1728 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1744 *closest = ret_closest;
1745 if (modeline_closest)
1746 *modeline_closest = ret_modeline_closest;
1755 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1756 Return t if the mouse event EVENT occurred over the text area of a window.
1757 The modeline is not considered to be part of the text area.
1761 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1763 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1766 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1767 Return t if the mouse event EVENT occurred over the modeline of a window.
1771 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1773 return result == OVER_MODELINE ? Qt : Qnil;
1776 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1777 Return t if the mouse event EVENT occurred over an internal border.
1781 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1783 return result == OVER_BORDER ? Qt : Qnil;
1786 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1787 Return t if the mouse event EVENT occurred over a toolbar.
1791 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1793 return result == OVER_TOOLBAR ? Qt : Qnil;
1796 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1797 Return t if the mouse event EVENT occurred over a window divider.
1801 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1803 return result == OVER_V_DIVIDER ? Qt : Qnil;
1807 event_console_or_selected (Lisp_Object event)
1809 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1810 Lisp_Object console = CDFW_CONSOLE (channel);
1813 console = Vselected_console;
1815 return XCONSOLE (console);
1818 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1819 Return the channel that the event EVENT occurred on.
1820 This will be a frame, device, console, or nil for some types
1821 of events (e.g. eval events).
1825 CHECK_LIVE_EVENT (event);
1826 return EVENT_CHANNEL (XEVENT (event));
1829 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1830 Return the window over which mouse event EVENT occurred.
1831 This may be nil if the event occurred in the border or over a toolbar.
1832 The modeline is considered to be within the window it describes.
1838 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1846 XSETWINDOW (window, w);
1851 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1852 Return the character position of the mouse event EVENT.
1853 If the event did not occur over a window, or did not occur over text,
1854 then this returns nil. Otherwise, it returns a position in the buffer
1855 visible in the event's window.
1862 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1864 return w && bufp ? make_int (bufp) : Qnil;
1867 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1868 Return the character position closest to the mouse event EVENT.
1869 If the event did not occur over a window or over text, return the
1870 closest point to the location of the event. If the Y pixel position
1871 overlaps a window and the X pixel position is to the left of that
1872 window, the closest point is the beginning of the line containing the
1873 Y position. If the Y pixel position overlaps a window and the X pixel
1874 position is to the right of that window, the closest point is the end
1875 of the line containing the Y position. If the Y pixel position is
1876 above a window, return 0. If it is below the last character in a window,
1877 return the value of (window-end).
1883 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
1885 return bufp ? make_int (bufp) : Qnil;
1888 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
1889 Return the X position of the mouse event EVENT in characters.
1890 This is relative to the window the event occurred over.
1896 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1898 return make_int (char_x);
1901 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
1902 Return the Y position of the mouse event EVENT in characters.
1903 This is relative to the window the event occurred over.
1909 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
1911 return make_int (char_y);
1914 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
1915 Return the character position in the modeline that EVENT occurred over.
1916 EVENT should be a mouse event. If EVENT did not occur over a modeline,
1917 nil is returned. You can determine the actual character that the
1918 event occurred over by looking in `generated-modeline-string' at the
1919 returned character position. Note that `generated-modeline-string'
1920 is buffer-local, and you must use EVENT's buffer when retrieving
1921 `generated-modeline-string' in order to get accurate results.
1928 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
1930 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
1933 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
1934 Return the glyph that the mouse event EVENT occurred over, or nil.
1941 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
1943 return w && GLYPHP (glyph) ? glyph : Qnil;
1946 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
1947 Return the extent of the glyph that the mouse event EVENT occurred over.
1948 If the event did not occur over a glyph, nil is returned.
1955 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
1957 return w && EXTENTP (extent) ? extent : Qnil;
1960 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
1961 Return the X pixel position of EVENT relative to the glyph it occurred over.
1962 EVENT should be a mouse event. If the event did not occur over a glyph,
1971 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
1973 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
1976 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
1977 Return the Y pixel position of EVENT relative to the glyph it occurred over.
1978 EVENT should be a mouse event. If the event did not occur over a glyph,
1987 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
1989 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
1992 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
1993 Return the toolbar button that the mouse event EVENT occurred over.
1994 If the event did not occur over a toolbar button, nil is returned.
1998 #ifdef HAVE_TOOLBARS
2001 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2003 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2009 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2010 Return the process of the given process-output event.
2014 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2015 return XEVENT (event)->event.process.process;
2018 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2019 Return the callback function of EVENT.
2020 EVENT should be a timeout, misc-user, or eval event.
2025 CHECK_LIVE_EVENT (event);
2026 switch (XEVENT (event)->event_type)
2029 return XEVENT (event)->event.timeout.function;
2030 case misc_user_event:
2031 return XEVENT (event)->event.misc.function;
2033 return XEVENT (event)->event.eval.function;
2035 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2040 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2041 Return the callback function argument of EVENT.
2042 EVENT should be a timeout, misc-user, or eval event.
2047 CHECK_LIVE_EVENT (event);
2048 switch (XEVENT (event)->event_type)
2051 return XEVENT (event)->event.timeout.object;
2052 case misc_user_event:
2053 return XEVENT (event)->event.misc.object;
2055 return XEVENT (event)->event.eval.object;
2057 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2062 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2063 Return a list of all of the properties of EVENT.
2064 This is in the form of a property list (alternating keyword/value pairs).
2068 Lisp_Object props = Qnil;
2069 struct Lisp_Event *e;
2070 struct gcpro gcpro1;
2072 CHECK_LIVE_EVENT (event);
2076 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2078 switch (e->event_type)
2081 props = cons3 (Qprocess, e->event.process.process, props);
2085 props = cons3 (Qobject, Fevent_object (event), props);
2086 props = cons3 (Qfunction, Fevent_function (event), props);
2087 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2090 case key_press_event:
2091 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2092 props = cons3 (Qkey, Fevent_key (event), props);
2095 case button_press_event:
2096 case button_release_event:
2097 props = cons3 (Qy, Fevent_y_pixel (event), props);
2098 props = cons3 (Qx, Fevent_x_pixel (event), props);
2099 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2100 props = cons3 (Qbutton, Fevent_button (event), props);
2103 case pointer_motion_event:
2104 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2105 props = cons3 (Qy, Fevent_y_pixel (event), props);
2106 props = cons3 (Qx, Fevent_x_pixel (event), props);
2109 case misc_user_event:
2110 props = cons3 (Qobject, Fevent_object (event), props);
2111 props = cons3 (Qfunction, Fevent_function (event), props);
2112 props = cons3 (Qy, Fevent_y_pixel (event), props);
2113 props = cons3 (Qx, Fevent_x_pixel (event), props);
2114 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2115 props = cons3 (Qbutton, Fevent_button (event), props);
2119 props = cons3 (Qobject, Fevent_object (event), props);
2120 props = cons3 (Qfunction, Fevent_function (event), props);
2123 case magic_eval_event:
2128 RETURN_UNGCPRO (Qnil);
2133 break; /* not reached; warning suppression */
2136 props = cons3 (Qchannel, Fevent_channel (event), props);
2143 /************************************************************************/
2144 /* initialization */
2145 /************************************************************************/
2148 syms_of_events (void)
2150 DEFSUBR (Fcharacter_to_event);
2151 DEFSUBR (Fevent_to_character);
2153 DEFSUBR (Fmake_event);
2154 DEFSUBR (Fdeallocate_event);
2155 DEFSUBR (Fcopy_event);
2157 DEFSUBR (Fevent_live_p);
2158 DEFSUBR (Fevent_type);
2159 DEFSUBR (Fevent_properties);
2161 DEFSUBR (Fevent_timestamp);
2162 DEFSUBR (Fevent_key);
2163 DEFSUBR (Fevent_button);
2164 DEFSUBR (Fevent_modifier_bits);
2165 DEFSUBR (Fevent_modifiers);
2166 DEFSUBR (Fevent_x_pixel);
2167 DEFSUBR (Fevent_y_pixel);
2168 DEFSUBR (Fevent_window_x_pixel);
2169 DEFSUBR (Fevent_window_y_pixel);
2170 DEFSUBR (Fevent_over_text_area_p);
2171 DEFSUBR (Fevent_over_modeline_p);
2172 DEFSUBR (Fevent_over_border_p);
2173 DEFSUBR (Fevent_over_toolbar_p);
2174 DEFSUBR (Fevent_over_vertical_divider_p);
2175 DEFSUBR (Fevent_channel);
2176 DEFSUBR (Fevent_window);
2177 DEFSUBR (Fevent_point);
2178 DEFSUBR (Fevent_closest_point);
2181 DEFSUBR (Fevent_modeline_position);
2182 DEFSUBR (Fevent_glyph);
2183 DEFSUBR (Fevent_glyph_extent);
2184 DEFSUBR (Fevent_glyph_x_pixel);
2185 DEFSUBR (Fevent_glyph_y_pixel);
2186 DEFSUBR (Fevent_toolbar_button);
2187 DEFSUBR (Fevent_process);
2188 DEFSUBR (Fevent_function);
2189 DEFSUBR (Fevent_object);
2191 defsymbol (&Qeventp, "eventp");
2192 defsymbol (&Qevent_live_p, "event-live-p");
2193 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2194 defsymbol (&Qbutton_event_p, "button-event-p");
2195 defsymbol (&Qmouse_event_p, "mouse-event-p");
2196 defsymbol (&Qprocess_event_p, "process-event-p");
2197 defsymbol (&Qkey_press, "key-press");
2198 defsymbol (&Qbutton_press, "button-press");
2199 defsymbol (&Qbutton_release, "button-release");
2200 defsymbol (&Qmisc_user, "misc-user");
2201 defsymbol (&Qascii_character, "ascii-character");
2205 vars_of_events (void)
2207 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2208 A symbol used to look up the 8-bit character of a keysym.
2209 To convert a keysym symbol to an 8-bit code, as when that key is
2210 bound to self-insert-command, we will look up the property that this
2211 variable names on the property list of the keysym-symbol. The window-
2212 system-specific code will set up appropriate properties and set this
2215 Vcharacter_set_property = Qnil;
2217 Vevent_resource = Qnil;
2219 QKbackspace = KEYSYM ("backspace");
2220 QKtab = KEYSYM ("tab");
2221 QKlinefeed = KEYSYM ("linefeed");
2222 QKreturn = KEYSYM ("return");
2223 QKescape = KEYSYM ("escape");
2224 QKspace = KEYSYM ("space");
2225 QKdelete = KEYSYM ("delete");
2227 staticpro (&QKbackspace);
2229 staticpro (&QKlinefeed);
2230 staticpro (&QKreturn);
2231 staticpro (&QKescape);
2232 staticpro (&QKspace);
2233 staticpro (&QKdelete);