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"
40 #include "events-mod.h"
42 /* Where old events go when they are explicitly deallocated.
43 The event chain here is cut loose before GC, so these will be freed
46 static Lisp_Object Vevent_resource;
49 Lisp_Object Qevent_live_p;
50 Lisp_Object Qkey_press_event_p;
51 Lisp_Object Qbutton_event_p;
52 Lisp_Object Qmouse_event_p;
53 Lisp_Object Qprocess_event_p;
55 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
56 Lisp_Object Qascii_character;
58 EXFUN (Fevent_x_pixel, 1);
59 EXFUN (Fevent_y_pixel, 1);
61 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
63 clear_event_resource (void)
65 Vevent_resource = Qnil;
68 /* Make sure we lose quickly if we try to use this event */
70 deinitialize_event (Lisp_Object ev)
73 Lisp_Event *event = XEVENT (ev);
75 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
76 ((int *) event) [i] = 0xdeadbeef;
77 event->event_type = dead_event;
78 event->channel = Qnil;
79 set_lheader_implementation (&event->lheader, &lrecord_event);
80 XSET_EVENT_NEXT (ev, Qnil);
83 /* Set everything to zero or nil so that it's predictable. */
85 zero_event (Lisp_Event *e)
88 set_lheader_implementation (&e->lheader, &lrecord_event);
89 e->event_type = empty_event;
95 mark_event (Lisp_Object obj)
97 Lisp_Event *event = XEVENT (obj);
99 switch (event->event_type)
101 case key_press_event:
102 mark_object (event->event.key.keysym);
105 mark_object (event->event.process.process);
108 mark_object (event->event.timeout.function);
109 mark_object (event->event.timeout.object);
112 case misc_user_event:
113 mark_object (event->event.eval.function);
114 mark_object (event->event.eval.object);
116 case magic_eval_event:
117 mark_object (event->event.magic_eval.object);
119 case button_press_event:
120 case button_release_event:
121 case pointer_motion_event:
129 mark_object (event->channel);
134 print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun)
137 write_c_string (str, printcharfun);
138 format_event_object (buf, XEVENT (obj), 0);
139 write_c_string (buf, printcharfun);
143 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
146 error ("Printing unreadable object #<event>");
148 switch (XEVENT (obj)->event_type)
150 case key_press_event:
151 print_event_1 ("#<keypress-event ", obj, printcharfun);
153 case button_press_event:
154 print_event_1 ("#<buttondown-event ", obj, printcharfun);
156 case button_release_event:
157 print_event_1 ("#<buttonup-event ", obj, printcharfun);
160 case magic_eval_event:
161 print_event_1 ("#<magic-event ", obj, printcharfun);
163 case pointer_motion_event:
167 Vx = Fevent_x_pixel (obj);
169 Vy = Fevent_y_pixel (obj);
171 sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
172 write_c_string (buf, printcharfun);
176 write_c_string ("#<process-event ", printcharfun);
177 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
180 write_c_string ("#<timeout-event ", printcharfun);
181 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
184 write_c_string ("#<empty-event", printcharfun);
186 case misc_user_event:
187 write_c_string ("#<misc-user-event (", printcharfun);
188 print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
189 write_c_string (" ", printcharfun);
190 print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
191 write_c_string (")", printcharfun);
194 write_c_string ("#<eval-event (", printcharfun);
195 print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
196 write_c_string (" ", printcharfun);
197 print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
198 write_c_string (")", printcharfun);
201 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
204 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
207 write_c_string (">", printcharfun);
211 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
213 Lisp_Event *e1 = XEVENT (obj1);
214 Lisp_Event *e2 = XEVENT (obj2);
216 if (e1->event_type != e2->event_type) return 0;
217 if (!EQ (e1->channel, e2->channel)) return 0;
218 /* if (e1->timestamp != e2->timestamp) return 0; */
219 switch (e1->event_type)
224 return EQ (e1->event.process.process, e2->event.process.process);
227 return (internal_equal (e1->event.timeout.function,
228 e2->event.timeout.function, 0) &&
229 internal_equal (e1->event.timeout.object,
230 e2->event.timeout.object, 0));
232 case key_press_event:
233 return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
234 (e1->event.key.modifiers == e2->event.key.modifiers));
236 case button_press_event:
237 case button_release_event:
238 return (e1->event.button.button == e2->event.button.button &&
239 e1->event.button.modifiers == e2->event.button.modifiers);
241 case pointer_motion_event:
242 return (e1->event.motion.x == e2->event.motion.x &&
243 e1->event.motion.y == e2->event.motion.y);
245 case misc_user_event:
246 return (internal_equal (e1->event.eval.function,
247 e2->event.eval.function, 0) &&
248 internal_equal (e1->event.eval.object,
249 e2->event.eval.object, 0) &&
250 /* is this really needed for equality
251 or is x and y also important? */
252 e1->event.misc.button == e2->event.misc.button &&
253 e1->event.misc.modifiers == e2->event.misc.modifiers);
256 return (internal_equal (e1->event.eval.function,
257 e2->event.eval.function, 0) &&
258 internal_equal (e1->event.eval.object,
259 e2->event.eval.object, 0));
261 case magic_eval_event:
262 return (e1->event.magic_eval.internal_function ==
263 e2->event.magic_eval.internal_function &&
264 internal_equal (e1->event.magic_eval.object,
265 e2->event.magic_eval.object, 0));
269 struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
271 #ifdef HAVE_X_WINDOWS
272 if (CONSOLE_X_P (con))
273 return (e1->event.magic.underlying_x_event.xany.serial ==
274 e2->event.magic.underlying_x_event.xany.serial);
277 if (CONSOLE_TTY_P (con))
278 return (e1->event.magic.underlying_tty_event ==
279 e2->event.magic.underlying_tty_event);
281 #ifdef HAVE_MS_WINDOWS
282 if (CONSOLE_MSWINDOWS_P (con))
283 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
284 &e2->event.magic.underlying_mswindows_event,
285 sizeof (union magic_data)));
288 return 1; /* not reached */
291 case empty_event: /* Empty and deallocated events are equal. */
298 event_hash (Lisp_Object obj, int depth)
300 Lisp_Event *e = XEVENT (obj);
303 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
304 switch (e->event_type)
307 return HASH2 (hash, LISP_HASH (e->event.process.process));
310 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
311 internal_hash (e->event.timeout.object, depth + 1));
313 case key_press_event:
314 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
315 e->event.key.modifiers);
317 case button_press_event:
318 case button_release_event:
319 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
321 case pointer_motion_event:
322 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
324 case misc_user_event:
325 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
326 internal_hash (e->event.misc.object, depth + 1),
327 e->event.misc.button, e->event.misc.modifiers);
330 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
331 internal_hash (e->event.eval.object, depth + 1));
333 case magic_eval_event:
335 (unsigned long) e->event.magic_eval.internal_function,
336 internal_hash (e->event.magic_eval.object, depth + 1));
340 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
341 #ifdef HAVE_X_WINDOWS
342 if (CONSOLE_X_P (con))
343 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
346 if (CONSOLE_TTY_P (con))
347 return HASH2 (hash, e->event.magic.underlying_tty_event);
349 #ifdef HAVE_MS_WINDOWS
350 if (CONSOLE_MSWINDOWS_P (con))
351 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
365 return 0; /* unreached */
368 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
369 mark_event, print_event, 0, event_equal,
370 event_hash, 0, Lisp_Event);
373 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
374 Return a new event of type TYPE, with properties described by PLIST.
376 TYPE is a symbol, either `empty', `key-press', `button-press',
377 `button-release', `misc-user' or `motion'. If TYPE is nil, it
380 PLIST is a property list, the properties being compatible to those
381 returned by `event-properties'. The following properties are
384 channel -- The event channel, a frame or a console. For
385 button-press, button-release, misc-user and motion events,
386 this must be a frame. For key-press events, it must be
387 a console. If channel is unspecified, it will be set to
388 the selected frame or selected console, as appropriate.
389 key -- The event key, a symbol or character. Allowed only for
391 button -- The event button, integer 1, 2 or 3. Allowed for
392 button-press, button-release and misc-user events.
393 modifiers -- The event modifiers, a list of modifier symbols. Allowed
394 for key-press, button-press, button-release, motion and
396 function -- Function. Allowed for misc-user events only.
397 object -- An object, function's parameter. Allowed for misc-user
399 x -- The event X coordinate, an integer. This is relative
400 to the left of CHANNEL's root window. Allowed for
401 motion, button-press, button-release and misc-user events.
402 y -- The event Y coordinate, an integer. This is relative
403 to the top of CHANNEL's root window. Allowed for
404 motion, button-press, button-release and misc-user events.
405 timestamp -- The event timestamp, a non-negative integer. Allowed for
406 all types of events. If unspecified, it will be set to 0
409 For event type `empty', PLIST must be nil.
410 `button-release', or `motion'. If TYPE is left out, it defaults to
412 PLIST is a list of properties, as returned by `event-properties'. Not
413 all properties are allowed for all kinds of events, and some are
416 WARNING: the event object returned may be a reused one; see the function
421 Lisp_Object event = Qnil;
423 EMACS_INT coord_x = 0, coord_y = 0;
431 if (!NILP (Vevent_resource))
433 event = Vevent_resource;
434 Vevent_resource = XEVENT_NEXT (event);
438 event = allocate_event ();
443 if (EQ (type, Qempty))
445 /* For empty event, we return immediately, without processing
446 PLIST. In fact, processing PLIST would be wrong, because the
447 sanitizing process would fill in the properties
448 (e.g. CHANNEL), which we don't want in empty events. */
449 e->event_type = empty_event;
451 syntax_error ("Cannot set properties of empty event", plist);
455 else if (EQ (type, Qkey_press))
457 e->event_type = key_press_event;
458 e->event.key.keysym = Qunbound;
460 else if (EQ (type, Qbutton_press))
461 e->event_type = button_press_event;
462 else if (EQ (type, Qbutton_release))
463 e->event_type = button_release_event;
464 else if (EQ (type, Qmotion))
465 e->event_type = pointer_motion_event;
466 else if (EQ (type, Qmisc_user))
468 e->event_type = misc_user_event;
469 e->event.eval.function = e->event.eval.object = Qnil;
473 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
474 invalid_argument ("Invalid event type", type);
477 EVENT_CHANNEL (e) = Qnil;
479 plist = Fcopy_sequence (plist);
480 Fcanonicalize_plist (plist, Qnil);
482 #define WRONG_EVENT_TYPE_FOR_PROPERTY(event_type, prop) \
483 syntax_error_2 ("Invalid property for event type", prop, event_type)
486 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
488 if (EQ (keyword, Qchannel))
490 if (e->event_type == key_press_event)
492 if (!CONSOLEP (value))
493 value = wrong_type_argument (Qconsolep, value);
498 value = wrong_type_argument (Qframep, value);
500 EVENT_CHANNEL (e) = value;
502 else if (EQ (keyword, Qkey))
504 switch (e->event_type)
506 case key_press_event:
507 if (!SYMBOLP (value) && !CHARP (value))
508 syntax_error ("Invalid event key", value);
509 e->event.key.keysym = value;
512 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
516 else if (EQ (keyword, Qbutton))
518 CHECK_NATNUM (value);
519 check_int_range (XINT (value), 0, 7);
521 switch (e->event_type)
523 case button_press_event:
524 case button_release_event:
525 e->event.button.button = XINT (value);
527 case misc_user_event:
528 e->event.misc.button = XINT (value);
531 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
535 else if (EQ (keyword, Qmodifiers))
539 EXTERNAL_LIST_LOOP_2 (sym, value)
541 if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL;
542 else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META;
543 else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER;
544 else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER;
545 else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT;
546 else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT;
547 else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT;
548 else if (EQ (sym, Qbutton1)) modifiers |= XEMACS_MOD_BUTTON1;
549 else if (EQ (sym, Qbutton2)) modifiers |= XEMACS_MOD_BUTTON2;
550 else if (EQ (sym, Qbutton3)) modifiers |= XEMACS_MOD_BUTTON3;
551 else if (EQ (sym, Qbutton4)) modifiers |= XEMACS_MOD_BUTTON4;
552 else if (EQ (sym, Qbutton5)) modifiers |= XEMACS_MOD_BUTTON5;
554 syntax_error ("Invalid key modifier", sym);
557 switch (e->event_type)
559 case key_press_event:
560 e->event.key.modifiers = modifiers;
562 case button_press_event:
563 case button_release_event:
564 e->event.button.modifiers = modifiers;
566 case pointer_motion_event:
567 e->event.motion.modifiers = modifiers;
569 case misc_user_event:
570 e->event.misc.modifiers = modifiers;
573 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
577 else if (EQ (keyword, Qx))
579 switch (e->event_type)
581 case pointer_motion_event:
582 case button_press_event:
583 case button_release_event:
584 case misc_user_event:
585 /* Allow negative values, so we can specify toolbar
588 coord_x = XINT (value);
591 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
595 else if (EQ (keyword, Qy))
597 switch (e->event_type)
599 case pointer_motion_event:
600 case button_press_event:
601 case button_release_event:
602 case misc_user_event:
603 /* Allow negative values; see above. */
605 coord_y = XINT (value);
608 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
612 else if (EQ (keyword, Qtimestamp))
614 CHECK_NATNUM (value);
615 e->timestamp = XINT (value);
617 else if (EQ (keyword, Qfunction))
619 switch (e->event_type)
621 case misc_user_event:
622 e->event.eval.function = value;
625 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
629 else if (EQ (keyword, Qobject))
631 switch (e->event_type)
633 case misc_user_event:
634 e->event.eval.object = value;
637 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
642 syntax_error_2 ("Invalid property", keyword, value);
646 /* Insert the channel, if missing. */
647 if (NILP (EVENT_CHANNEL (e)))
649 if (e->event_type == key_press_event)
650 EVENT_CHANNEL (e) = Vselected_console;
652 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
655 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
656 to the frame, so we must adjust accordingly. */
657 if (FRAMEP (EVENT_CHANNEL (e)))
659 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
660 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
662 switch (e->event_type)
664 case pointer_motion_event:
665 e->event.motion.x = coord_x;
666 e->event.motion.y = coord_y;
668 case button_press_event:
669 case button_release_event:
670 e->event.button.x = coord_x;
671 e->event.button.y = coord_y;
673 case misc_user_event:
674 e->event.misc.x = coord_x;
675 e->event.misc.y = coord_y;
682 /* Finally, do some more validation. */
683 switch (e->event_type)
685 case key_press_event:
686 if (UNBOUNDP (e->event.key.keysym))
687 syntax_error ("A key must be specified to make a keypress event",
690 case button_press_event:
691 if (!e->event.button.button)
693 ("A button must be specified to make a button-press event",
696 case button_release_event:
697 if (!e->event.button.button)
699 ("A button must be specified to make a button-release event",
702 case misc_user_event:
703 if (NILP (e->event.misc.function))
704 syntax_error ("A function must be specified to make a misc-user event",
715 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
716 Allow the given event structure to be reused.
717 You MUST NOT use this event object after calling this function with it.
718 You will lose. It is not necessary to call this function, as event
719 objects are garbage-collected like all other objects; however, it may
720 be more efficient to explicitly deallocate events when you are sure
721 that it is safe to do so.
727 if (XEVENT_TYPE (event) == dead_event)
728 error ("this event is already deallocated!");
730 assert (XEVENT_TYPE (event) <= last_event_type);
736 if (EQ (event, Vlast_command_event) ||
737 EQ (event, Vlast_input_event) ||
738 EQ (event, Vunread_command_event))
741 len = XVECTOR_LENGTH (Vthis_command_keys);
742 for (i = 0; i < len; i++)
743 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
745 if (!NILP (Vrecent_keys_ring))
747 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
748 for (i = 0; i < recent_ring_len; i++)
749 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
755 assert (!EQ (event, Vevent_resource));
756 deinitialize_event (event);
757 #ifndef ALLOC_NO_POOLS
758 XSET_EVENT_NEXT (event, Vevent_resource);
759 Vevent_resource = event;
764 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
765 Make a copy of the event object EVENT1.
766 If a second event argument EVENT2 is given, EVENT1 is copied into
767 EVENT2 and EVENT2 is returned. If EVENT2 is not supplied (or is nil)
768 then a new event will be made as with `make-event'. See also the
769 function `deallocate-event'.
773 CHECK_LIVE_EVENT (event1);
775 event2 = Fmake_event (Qnil, Qnil);
778 CHECK_LIVE_EVENT (event2);
779 if (EQ (event1, event2))
780 return signal_simple_continuable_error_2
781 ("copy-event called with `eq' events", event1, event2);
784 assert (XEVENT_TYPE (event1) <= last_event_type);
785 assert (XEVENT_TYPE (event2) <= last_event_type);
788 Lisp_Event *ev2 = XEVENT (event2);
789 Lisp_Event *ev1 = XEVENT (event1);
791 ev2->event_type = ev1->event_type;
792 ev2->channel = ev1->channel;
793 ev2->timestamp = ev1->timestamp;
794 ev2->event = ev1->event;
802 /* Given a chain of events (or possibly nil), deallocate them all. */
805 deallocate_event_chain (Lisp_Object event_chain)
807 while (!NILP (event_chain))
809 Lisp_Object next = XEVENT_NEXT (event_chain);
810 Fdeallocate_event (event_chain);
815 /* Return the last event in a chain.
816 NOTE: You cannot pass nil as a value here! The routine will
820 event_chain_tail (Lisp_Object event_chain)
824 Lisp_Object next = XEVENT_NEXT (event_chain);
831 /* Enqueue a single event onto the end of a chain of events.
832 HEAD points to the first event in the chain, TAIL to the last event.
833 If the chain is empty, both values should be nil. */
836 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
838 assert (NILP (XEVENT_NEXT (event)));
839 assert (!EQ (*tail, event));
842 XSET_EVENT_NEXT (*tail, event);
847 assert (!EQ (event, XEVENT_NEXT (event)));
850 /* Remove an event off the head of a chain of events and return it.
851 HEAD points to the first event in the chain, TAIL to the last event. */
854 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
859 *head = XEVENT_NEXT (event);
860 XSET_EVENT_NEXT (event, Qnil);
866 /* Enqueue a chain of events (or possibly nil) onto the end of another
867 chain of events. HEAD points to the first event in the chain being
868 queued onto, TAIL to the last event. If the chain is empty, both values
872 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
875 if (NILP (event_chain))
885 XSET_EVENT_NEXT (*tail, event_chain);
886 *tail = event_chain_tail (event_chain);
890 /* Return the number of events (possibly 0) on an event chain. */
893 event_chain_count (Lisp_Object event_chain)
898 EVENT_CHAIN_LOOP (event, event_chain)
904 /* Find the event before EVENT in an event chain. This aborts
905 if the event is not in the chain. */
908 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
910 Lisp_Object previous = Qnil;
912 while (!NILP (event_chain))
914 if (EQ (event_chain, event))
916 previous = event_chain;
917 event_chain = XEVENT_NEXT (event_chain);
925 event_chain_nth (Lisp_Object event_chain, int n)
928 EVENT_CHAIN_LOOP (event, event_chain)
938 copy_event_chain (Lisp_Object event_chain)
940 Lisp_Object new_chain = Qnil;
941 Lisp_Object new_chain_tail = Qnil;
944 EVENT_CHAIN_LOOP (event, event_chain)
946 Lisp_Object copy = Fcopy_event (event, Qnil);
947 enqueue_event (copy, &new_chain, &new_chain_tail);
955 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
959 command_event_p (Lisp_Object event)
961 switch (XEVENT_TYPE (event))
963 case key_press_event:
964 case button_press_event:
965 case button_release_event:
966 case misc_user_event:
975 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
976 int use_console_meta_flag, int do_backspace_mapping)
978 Lisp_Object k = Qnil;
980 if (event->event_type == dead_event)
981 error ("character-to-event called with a deallocated event!");
986 if (c > 127 && c <= 255)
989 if (use_console_meta_flag && CONSOLE_TTY_P (con))
990 meta_flag = TTY_FLAGS (con).meta_key;
993 case 0: /* ignore top bit; it's parity */
996 case 1: /* top bit is meta */
1000 default: /* this is a real character */
1004 if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL;
1005 if (m & XEMACS_MOD_CONTROL)
1009 case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break;
1010 case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break;
1011 case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break;
1012 case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break;
1014 #if defined(HAVE_TTY)
1015 if (do_backspace_mapping &&
1016 CHARP (con->tty_erase_char) &&
1017 c - '@' == XCHAR (con->tty_erase_char))
1020 m &= ~XEMACS_MOD_CONTROL;
1022 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1025 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1027 #if defined(HAVE_TTY)
1028 else if (do_backspace_mapping &&
1029 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1031 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1037 event->event_type = key_press_event;
1038 event->timestamp = 0; /* #### */
1039 event->channel = make_console (con);
1040 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1041 event->event.key.modifiers = m;
1044 /* This variable controls what character name -> character code mapping
1045 we are using. Window-system-specific code sets this to some symbol,
1046 and we use that symbol as the plist key to convert keysyms into 8-bit
1047 codes. In this way one can have several character sets predefined and
1048 switch them by changing this.
1050 #### This is utterly bogus and should be removed.
1052 Lisp_Object Vcharacter_set_property;
1055 event_to_character (Lisp_Event *event,
1056 int allow_extra_modifiers,
1058 int allow_non_ascii)
1063 if (event->event_type != key_press_event)
1065 assert (event->event_type != dead_event);
1068 if (!allow_extra_modifiers &&
1069 event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT))
1071 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1072 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1073 else if (!SYMBOLP (event->event.key.keysym))
1075 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1076 /* Allow window-system-specific extensibility of
1077 keysym->code mapping */
1078 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1079 Vcharacter_set_property,
1081 c = XCHAR_OR_CHAR_INT (code);
1082 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1083 Qascii_character, Qnil)))
1084 c = XCHAR_OR_CHAR_INT (code);
1088 if (event->event.key.modifiers & XEMACS_MOD_CONTROL)
1090 if (c >= 'a' && c <= 'z')
1093 /* reject Control-Shift- keys */
1094 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1097 if (c >= '@' && c <= '_')
1099 else if (c == ' ') /* C-space and C-@ are the same. */
1102 /* reject keys that can't take Control- modifiers */
1103 if (! allow_extra_modifiers) return -1;
1106 if (event->event.key.modifiers & XEMACS_MOD_META)
1108 if (! allow_meta) return -1;
1109 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1111 if (c >= 256) return -1;
1118 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1119 Return the closest ASCII approximation to the given event object.
1120 If the event isn't a keypress, this returns nil.
1121 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1122 its translation; it will ignore modifier keys other than control and meta,
1123 and will ignore the shift modifier on those characters which have no
1124 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1125 the same ASCII code as Control-A).
1126 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1127 represented by turning on the high bit of the byte returned; otherwise, nil
1128 will be returned for events containing the Meta modifier.
1129 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1130 present in the prevailing character set (see the `character-set-property'
1131 variable) will be returned as their code in that character set, instead of
1132 the return value being restricted to ASCII.
1133 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1134 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1136 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1139 CHECK_LIVE_EVENT (event);
1140 c = event_to_character (XEVENT (event),
1141 !NILP (allow_extra_modifiers),
1143 !NILP (allow_non_ascii));
1144 return c < 0 ? Qnil : make_char (c);
1147 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1148 Convert KEY-DESCRIPTION into an event structure, replete with bucky bits.
1150 KEY-DESCRIPTION is the first argument, and the event to fill in is the
1151 second. This function contains knowledge about what various kinds of
1152 arguments ``mean'' -- for example, the number 9 is converted to the
1153 character ``Tab'', not the distinct character ``Control-I''.
1155 KEY-DESCRIPTION can be an integer, a character, a symbol such as 'clear,
1156 or a list such as '(control backspace).
1158 If the optional second argument EVENT is an event, it is modified and
1159 returned; otherwise, a new event object is created and returned.
1161 Optional third arg CONSOLE is the console to store in the event, and
1162 defaults to the selected console.
1164 If KEY-DESCRIPTION is an integer or character, the high bit may be
1165 interpreted as the meta key. (This is done for backward compatibility
1166 in lots of places.) If USE-CONSOLE-META-FLAG is nil, this will always
1167 be the case. If USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for
1168 CONSOLE affects whether the high bit is interpreted as a meta
1169 key. (See `set-input-mode'.) If you don't want this silly meta
1170 interpretation done, you should pass in a list containing the
1173 Beware that character-to-event and event-to-character are not strictly
1174 inverse functions, since events contain much more information than the
1175 Lisp character object type can encode.
1177 (keystroke, event, console, use_console_meta_flag))
1179 struct console *con = decode_console (console);
1181 event = Fmake_event (Qnil, Qnil);
1183 CHECK_LIVE_EVENT (event);
1184 if (CONSP (keystroke) || SYMBOLP (keystroke))
1185 key_desc_list_to_event (keystroke, event, 1);
1188 CHECK_CHAR_COERCE_INT (keystroke);
1189 character_to_event (XCHAR (keystroke), XEVENT (event), con,
1190 !NILP (use_console_meta_flag), 1);
1196 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1198 assert (STRINGP (seq) || VECTORP (seq));
1199 assert (n < XINT (Flength (seq)));
1203 Emchar ch = string_char (XSTRING (seq), n);
1204 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1208 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1209 if (EVENTP (keystroke))
1210 Fcopy_event (keystroke, event);
1212 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1217 key_sequence_to_event_chain (Lisp_Object seq)
1219 int len = XINT (Flength (seq));
1221 Lisp_Object head = Qnil, tail = Qnil;
1223 for (i = 0; i < len; i++)
1225 Lisp_Object event = Fmake_event (Qnil, Qnil);
1226 nth_of_key_sequence_as_event (seq, i, event);
1227 enqueue_event (event, &head, &tail);
1234 format_event_object (char *buf, Lisp_Event *event, int brief)
1240 switch (event->event_type)
1242 case key_press_event:
1244 mod = event->event.key.modifiers;
1245 key = event->event.key.keysym;
1247 if (! brief && CHARP (key) &&
1248 mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER))
1250 int k = XCHAR (key);
1251 if (k >= 'a' && k <= 'z')
1252 key = make_char (k - ('a' - 'A'));
1253 else if (k >= 'A' && k <= 'Z')
1254 mod |= XEMACS_MOD_SHIFT;
1258 case button_release_event:
1261 case button_press_event:
1264 mod = event->event.button.modifiers;
1265 key = make_char (event->event.button.button + '0');
1270 const char *name = NULL;
1272 #ifdef HAVE_X_WINDOWS
1274 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1275 if (CONSOLE_X_P (XCONSOLE (console)))
1276 name = x_event_name (event->event.magic.underlying_x_event.type);
1278 #endif /* HAVE_X_WINDOWS */
1279 if (name) strcpy (buf, name);
1280 else strcpy (buf, "???");
1283 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1284 case pointer_motion_event: strcpy (buf, "motion"); return;
1285 case misc_user_event: strcpy (buf, "misc-user"); return;
1286 case eval_event: strcpy (buf, "eval"); return;
1287 case process_event: strcpy (buf, "process"); return;
1288 case timeout_event: strcpy (buf, "timeout"); return;
1289 case empty_event: strcpy (buf, "empty"); return;
1290 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1295 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1296 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1297 if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-");
1298 if (mod & XEMACS_MOD_META) modprint ("meta-", "M-");
1299 if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-");
1300 if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-");
1301 if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-");
1302 if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-");
1305 modprint1 ("button");
1314 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1317 else if (SYMBOLP (key))
1319 const char *str = 0;
1322 if (EQ (key, QKlinefeed)) str = "LFD";
1323 else if (EQ (key, QKtab)) str = "TAB";
1324 else if (EQ (key, QKreturn)) str = "RET";
1325 else if (EQ (key, QKescape)) str = "ESC";
1326 else if (EQ (key, QKdelete)) str = "DEL";
1327 else if (EQ (key, QKspace)) str = "SPC";
1328 else if (EQ (key, QKbackspace)) str = "BS";
1332 int i = strlen (str);
1333 memcpy (buf, str, i+1);
1338 Lisp_String *name = XSYMBOL (key)->name;
1339 memcpy (buf, string_data (name), string_length (name) + 1);
1340 str += string_length (name);
1346 strncpy (buf, "up", 4);
1349 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1350 True if OBJECT is an event object.
1354 return EVENTP (object) ? Qt : Qnil;
1357 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1358 True if OBJECT is an event object that has not been deallocated.
1362 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1366 #if 0 /* debugging functions */
1368 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1369 Return the event object's `next' event, or nil if it has none.
1370 The `next-event' field is changed by calling `set-next-event'.
1375 CHECK_LIVE_EVENT (event);
1377 return XEVENT_NEXT (event);
1380 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1381 Set the `next event' of EVENT to NEXT-EVENT.
1382 NEXT-EVENT must be an event object or nil.
1384 (event, next_event))
1388 CHECK_LIVE_EVENT (event);
1389 if (NILP (next_event))
1391 XSET_EVENT_NEXT (event, Qnil);
1395 CHECK_LIVE_EVENT (next_event);
1397 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1401 signal_error (Qerror,
1402 list3 (build_string ("Cyclic event-next"),
1406 XSET_EVENT_NEXT (event, next_event);
1412 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1413 Return the type of EVENT.
1414 This will be a symbol; one of
1416 key-press A key was pressed.
1417 button-press A mouse button was pressed.
1418 button-release A mouse button was released.
1419 misc-user Some other user action happened; typically, this is
1420 a menu selection or scrollbar action.
1421 motion The mouse moved.
1422 process Input is available from a subprocess.
1423 timeout A timeout has expired.
1424 eval This causes a specified action to occur when dispatched.
1425 magic Some window-system-specific event has occurred.
1426 empty The event has been allocated but not assigned.
1431 CHECK_LIVE_EVENT (event);
1432 switch (XEVENT (event)->event_type)
1434 case key_press_event: return Qkey_press;
1435 case button_press_event: return Qbutton_press;
1436 case button_release_event: return Qbutton_release;
1437 case misc_user_event: return Qmisc_user;
1438 case pointer_motion_event: return Qmotion;
1439 case process_event: return Qprocess;
1440 case timeout_event: return Qtimeout;
1441 case eval_event: return Qeval;
1443 case magic_eval_event:
1455 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1456 Return the timestamp of the event object EVENT.
1457 Timestamps are measured in milliseconds since the start of the window system.
1458 They are NOT related to any current time measurement.
1459 They should be compared with `event-timestamp<'.
1460 See also `current-event-timestamp'.
1464 CHECK_LIVE_EVENT (event);
1465 /* This junk is so that timestamps don't get to be negative, but contain
1466 as many bits as this particular emacs will allow.
1468 return make_int (((1L << (VALBITS - 1)) - 1) &
1469 XEVENT (event)->timestamp);
1472 #define TIMESTAMP_HALFSPACE (1L << (VALBITS - 2))
1474 DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /*
1475 Return true if timestamp TIME1 is earlier than timestamp TIME2.
1476 This correctly handles timestamp wrap.
1477 See also `event-timestamp' and `current-event-timestamp'.
1483 CHECK_NATNUM (time1);
1484 CHECK_NATNUM (time2);
1489 return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil;
1491 return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt;
1494 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1495 CHECK_LIVE_EVENT (e); \
1496 if (XEVENT(e)->event_type != (t1)) \
1497 e = wrong_type_argument (sym,e); \
1500 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1501 CHECK_LIVE_EVENT (e); \
1503 emacs_event_type CET_type = XEVENT (e)->event_type; \
1504 if (CET_type != (t1) && \
1506 e = wrong_type_argument (sym,e); \
1510 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1511 CHECK_LIVE_EVENT (e); \
1513 emacs_event_type CET_type = XEVENT (e)->event_type; \
1514 if (CET_type != (t1) && \
1515 CET_type != (t2) && \
1517 e = wrong_type_argument (sym,e); \
1521 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1522 Return the Keysym of the key-press event EVENT.
1523 This will be a character if the event is associated with one, else a symbol.
1527 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1528 return XEVENT (event)->event.key.keysym;
1531 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1532 Return the button-number of the button-press or button-release event EVENT.
1537 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1538 misc_user_event, Qbutton_event_p);
1539 #ifdef HAVE_WINDOW_SYSTEM
1540 if ( XEVENT (event)->event_type == misc_user_event)
1541 return make_int (XEVENT (event)->event.misc.button);
1543 return make_int (XEVENT (event)->event.button.button);
1544 #else /* !HAVE_WINDOW_SYSTEM */
1546 #endif /* !HAVE_WINDOW_SYSTEM */
1550 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1551 Return a number representing the modifier keys and buttons which were down
1552 when the given mouse or keyboard event was produced.
1553 See also the function `event-modifiers'.
1558 CHECK_LIVE_EVENT (event);
1559 switch (XEVENT (event)->event_type)
1561 case key_press_event:
1562 return make_int (XEVENT (event)->event.key.modifiers);
1563 case button_press_event:
1564 case button_release_event:
1565 return make_int (XEVENT (event)->event.button.modifiers);
1566 case pointer_motion_event:
1567 return make_int (XEVENT (event)->event.motion.modifiers);
1568 case misc_user_event:
1569 return make_int (XEVENT (event)->event.misc.modifiers);
1571 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1576 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1577 Return a list of symbols, the names of the modifier keys and buttons
1578 which were down when the given mouse or keyboard event was produced.
1579 See also the function `event-modifier-bits'.
1581 The possible symbols in the list are
1583 `shift': The Shift key. Will not appear, in general, on key events
1584 where the keysym is an ASCII character, because using Shift
1585 on such a character converts it into another character rather
1586 than actually just adding a Shift modifier.
1588 `control': The Control key.
1590 `meta': The Meta key. On PC's and PC-style keyboards, this is generally
1591 labelled \"Alt\"; Meta is a holdover from early Lisp Machines and
1592 such, propagated through the X Window System. On Sun keyboards,
1593 this key is labelled with a diamond.
1595 `alt': The \"Alt\" key. Alt is in quotes because this does not refer
1596 to what it obviously should refer to, namely the Alt key on PC
1597 keyboards. Instead, it refers to the key labelled Alt on Sun
1598 keyboards, and to no key at all on PC keyboards.
1600 `super': The Super key. Most keyboards don't have any such key, but
1601 under X Windows using `xmodmap' you can assign any key (such as
1602 an underused right-shift, right-control, or right-alt key) to
1603 this key modifier. No support currently exists under MS Windows
1604 for generating these modifiers.
1606 `hyper': The Hyper key. Works just like the Super key.
1608 `button1': The mouse buttons. This means that the specified button was held
1609 `button2': down at the time the event occurred. NOTE: For button-press
1610 `button3': events, the button that was just pressed down does NOT appear in
1611 `button4': the modifiers.
1614 Button modifiers are currently ignored when defining and looking up key and
1615 mouse strokes in keymaps. This could be changed, which would allow a user to
1616 create button-chord actions, use a button as a key modifier and do other
1621 int mod = XINT (Fevent_modifier_bits (event));
1622 Lisp_Object result = Qnil;
1623 struct gcpro gcpro1;
1626 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result);
1627 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result);
1628 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result);
1629 if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result);
1630 if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result);
1631 if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result);
1632 if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result);
1633 if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result);
1634 if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result);
1635 if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result);
1636 if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result);
1637 RETURN_UNGCPRO (Fnreverse (result));
1641 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1646 if (XEVENT (event)->event_type == pointer_motion_event)
1648 *x = XEVENT (event)->event.motion.x;
1649 *y = XEVENT (event)->event.motion.y;
1651 else if (XEVENT (event)->event_type == button_press_event ||
1652 XEVENT (event)->event_type == button_release_event)
1654 *x = XEVENT (event)->event.button.x;
1655 *y = XEVENT (event)->event.button.y;
1657 else if (XEVENT (event)->event_type == misc_user_event)
1659 *x = XEVENT (event)->event.misc.x;
1660 *y = XEVENT (event)->event.misc.y;
1665 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1669 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1672 return 1; /* #### What should really happen here? */
1674 *x -= w->pixel_left;
1679 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1680 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1681 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1682 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1688 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1689 Return the X position in pixels of mouse event EVENT.
1690 The value returned is relative to the window the event occurred in.
1691 This will signal an error if the event is not a mouse event.
1692 See also `mouse-event-p' and `event-x-pixel'.
1698 CHECK_LIVE_EVENT (event);
1700 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1701 return wrong_type_argument (Qmouse_event_p, event);
1703 return make_int (x);
1706 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1707 Return the Y position in pixels of mouse event EVENT.
1708 The value returned is relative to the window the event occurred in.
1709 This will signal an error if the event is not a mouse event.
1710 See also `mouse-event-p' and `event-y-pixel'.
1716 CHECK_LIVE_EVENT (event);
1718 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1719 return wrong_type_argument (Qmouse_event_p, event);
1721 return make_int (y);
1724 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1725 Return the X position in pixels of mouse event EVENT.
1726 The value returned is relative to the frame the event occurred in.
1727 This will signal an error if the event is not a mouse event.
1728 See also `mouse-event-p' and `event-window-x-pixel'.
1734 CHECK_LIVE_EVENT (event);
1736 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1737 return wrong_type_argument (Qmouse_event_p, event);
1739 return make_int (x);
1742 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1743 Return the Y position in pixels of mouse event EVENT.
1744 The value returned is relative to the frame the event occurred in.
1745 This will signal an error if the event is not a mouse event.
1746 See also `mouse-event-p' `event-window-y-pixel'.
1752 CHECK_LIVE_EVENT (event);
1754 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1755 return wrong_type_argument (Qmouse_event_p, event);
1757 return make_int (y);
1760 /* Given an event, return a value:
1762 OVER_TOOLBAR: over one of the 4 frame toolbars
1763 OVER_MODELINE: over a modeline
1764 OVER_BORDER: over an internal border
1765 OVER_NOTHING: over the text area, but not over text
1766 OVER_OUTSIDE: outside of the frame border
1767 OVER_TEXT: over text in the text area
1768 OVER_V_DIVIDER: over windows vertical divider
1772 The X char position in CHAR_X, if not a null pointer.
1773 The Y char position in CHAR_Y, if not a null pointer.
1774 (These last two values are relative to the window the event is over.)
1775 The window it's over in W, if not a null pointer.
1776 The buffer position it's over in BUFP, if not a null pointer.
1777 The closest buffer position in CLOSEST, if not a null pointer.
1779 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1783 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1784 int *obj_x, int *obj_y,
1785 struct window **w, Bufpos *bufp, Bufpos *closest,
1786 Charcount *modeline_closest,
1787 Lisp_Object *obj1, Lisp_Object *obj2)
1794 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1795 struct window *ret_w;
1796 Bufpos ret_bufp, ret_closest;
1797 Charcount ret_modeline_closest;
1798 Lisp_Object ret_obj1, ret_obj2;
1800 CHECK_LIVE_EVENT (event);
1801 frame = XEVENT (event)->channel;
1802 switch (XEVENT (event)->event_type)
1804 case pointer_motion_event :
1805 pix_x = XEVENT (event)->event.motion.x;
1806 pix_y = XEVENT (event)->event.motion.y;
1808 case button_press_event :
1809 case button_release_event :
1810 pix_x = XEVENT (event)->event.button.x;
1811 pix_y = XEVENT (event)->event.button.y;
1813 case misc_user_event :
1814 pix_x = XEVENT (event)->event.misc.x;
1815 pix_y = XEVENT (event)->event.misc.y;
1818 dead_wrong_type_argument (Qmouse_event_p, event);
1821 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1822 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1823 &ret_w, &ret_bufp, &ret_closest,
1824 &ret_modeline_closest,
1825 &ret_obj1, &ret_obj2);
1827 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1829 else if (ret_w && NILP (ret_w->buffer))
1830 /* Why does this happen? (Does it still happen?)
1831 I guess the window has gotten reused as a non-leaf... */
1834 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1835 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1836 pointer points to random memory, often filled with 0, sometimes not.
1838 /* #### Chuck, do we still need this crap? */
1839 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1840 #ifdef HAVE_TOOLBARS
1841 || TOOLBAR_BUTTONP (ret_obj1)
1845 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1861 *closest = ret_closest;
1862 if (modeline_closest)
1863 *modeline_closest = ret_modeline_closest;
1872 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1873 Return t if the mouse event EVENT occurred over the text area of a window.
1874 The modeline is not considered to be part of the text area.
1878 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1880 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1883 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1884 Return t if the mouse event EVENT occurred over the modeline of a window.
1888 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1890 return result == OVER_MODELINE ? Qt : Qnil;
1893 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1894 Return t if the mouse event EVENT occurred over an internal border.
1898 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1900 return result == OVER_BORDER ? Qt : Qnil;
1903 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1904 Return t if the mouse event EVENT occurred over a toolbar.
1908 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1910 return result == OVER_TOOLBAR ? Qt : Qnil;
1913 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1914 Return t if the mouse event EVENT occurred over a window divider.
1918 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1920 return result == OVER_V_DIVIDER ? Qt : Qnil;
1924 event_console_or_selected (Lisp_Object event)
1926 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1927 Lisp_Object console = CDFW_CONSOLE (channel);
1930 console = Vselected_console;
1932 return XCONSOLE (console);
1935 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1936 Return the channel that the event EVENT occurred on.
1937 This will be a frame, device, console, or nil for some types
1938 of events (e.g. eval events).
1942 CHECK_LIVE_EVENT (event);
1943 return EVENT_CHANNEL (XEVENT (event));
1946 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1947 Return the window over which mouse event EVENT occurred.
1948 This may be nil if the event occurred in the border or over a toolbar.
1949 The modeline is considered to be within the window it describes.
1955 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1963 XSETWINDOW (window, w);
1968 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1969 Return the character position of the mouse event EVENT.
1970 If the event did not occur over a window, or did not occur over text,
1971 then this returns nil. Otherwise, it returns a position in the buffer
1972 visible in the event's window.
1979 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1981 return w && bufp ? make_int (bufp) : Qnil;
1984 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1985 Return the character position closest to the mouse event EVENT.
1986 If the event did not occur over a window or over text, return the
1987 closest point to the location of the event. If the Y pixel position
1988 overlaps a window and the X pixel position is to the left of that
1989 window, the closest point is the beginning of the line containing the
1990 Y position. If the Y pixel position overlaps a window and the X pixel
1991 position is to the right of that window, the closest point is the end
1992 of the line containing the Y position. If the Y pixel position is
1993 above a window, return 0. If it is below the last character in a window,
1994 return the value of (window-end).
2000 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
2002 return bufp ? make_int (bufp) : Qnil;
2005 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
2006 Return the X position of the mouse event EVENT in characters.
2007 This is relative to the window the event occurred over.
2013 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
2015 return make_int (char_x);
2018 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
2019 Return the Y position of the mouse event EVENT in characters.
2020 This is relative to the window the event occurred over.
2026 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
2028 return make_int (char_y);
2031 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
2032 Return the character position in the modeline that EVENT occurred over.
2033 EVENT should be a mouse event. If EVENT did not occur over a modeline,
2034 nil is returned. You can determine the actual character that the
2035 event occurred over by looking in `generated-modeline-string' at the
2036 returned character position. Note that `generated-modeline-string'
2037 is buffer-local, and you must use EVENT's buffer when retrieving
2038 `generated-modeline-string' in order to get accurate results.
2045 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
2047 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
2050 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
2051 Return the glyph that the mouse event EVENT occurred over, or nil.
2058 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
2060 return w && GLYPHP (glyph) ? glyph : Qnil;
2063 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
2064 Return the extent of the glyph that the mouse event EVENT occurred over.
2065 If the event did not occur over a glyph, nil is returned.
2072 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
2074 return w && EXTENTP (extent) ? extent : Qnil;
2077 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
2078 Return the X pixel position of EVENT relative to the glyph it occurred over.
2079 EVENT should be a mouse event. If the event did not occur over a glyph,
2088 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2090 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2093 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2094 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2095 EVENT should be a mouse event. If the event did not occur over a glyph,
2104 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2106 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2109 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2110 Return the toolbar button that the mouse event EVENT occurred over.
2111 If the event did not occur over a toolbar button, nil is returned.
2115 #ifdef HAVE_TOOLBARS
2118 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2120 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2126 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2127 Return the process of the process-output event EVENT.
2131 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2132 return XEVENT (event)->event.process.process;
2135 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2136 Return the callback function of EVENT.
2137 EVENT should be a timeout, misc-user, or eval event.
2142 CHECK_LIVE_EVENT (event);
2143 switch (XEVENT (event)->event_type)
2146 return XEVENT (event)->event.timeout.function;
2147 case misc_user_event:
2148 return XEVENT (event)->event.misc.function;
2150 return XEVENT (event)->event.eval.function;
2152 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2157 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2158 Return the callback function argument of EVENT.
2159 EVENT should be a timeout, misc-user, or eval event.
2164 CHECK_LIVE_EVENT (event);
2165 switch (XEVENT (event)->event_type)
2168 return XEVENT (event)->event.timeout.object;
2169 case misc_user_event:
2170 return XEVENT (event)->event.misc.object;
2172 return XEVENT (event)->event.eval.object;
2174 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2179 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2180 Return a list of all of the properties of EVENT.
2181 This is in the form of a property list (alternating keyword/value pairs).
2185 Lisp_Object props = Qnil;
2187 struct gcpro gcpro1;
2189 CHECK_LIVE_EVENT (event);
2193 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2195 switch (e->event_type)
2200 props = cons3 (Qprocess, e->event.process.process, props);
2204 props = cons3 (Qobject, Fevent_object (event), props);
2205 props = cons3 (Qfunction, Fevent_function (event), props);
2206 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2209 case key_press_event:
2210 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2211 props = cons3 (Qkey, Fevent_key (event), props);
2214 case button_press_event:
2215 case button_release_event:
2216 props = cons3 (Qy, Fevent_y_pixel (event), props);
2217 props = cons3 (Qx, Fevent_x_pixel (event), props);
2218 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2219 props = cons3 (Qbutton, Fevent_button (event), props);
2222 case pointer_motion_event:
2223 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2224 props = cons3 (Qy, Fevent_y_pixel (event), props);
2225 props = cons3 (Qx, Fevent_x_pixel (event), props);
2228 case misc_user_event:
2229 props = cons3 (Qobject, Fevent_object (event), props);
2230 props = cons3 (Qfunction, Fevent_function (event), props);
2231 props = cons3 (Qy, Fevent_y_pixel (event), props);
2232 props = cons3 (Qx, Fevent_x_pixel (event), props);
2233 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2234 props = cons3 (Qbutton, Fevent_button (event), props);
2238 props = cons3 (Qobject, Fevent_object (event), props);
2239 props = cons3 (Qfunction, Fevent_function (event), props);
2242 case magic_eval_event:
2247 RETURN_UNGCPRO (Qnil);
2251 props = cons3 (Qchannel, Fevent_channel (event), props);
2258 /************************************************************************/
2259 /* initialization */
2260 /************************************************************************/
2263 syms_of_events (void)
2265 INIT_LRECORD_IMPLEMENTATION (event);
2267 DEFSUBR (Fcharacter_to_event);
2268 DEFSUBR (Fevent_to_character);
2270 DEFSUBR (Fmake_event);
2271 DEFSUBR (Fdeallocate_event);
2272 DEFSUBR (Fcopy_event);
2274 DEFSUBR (Fevent_live_p);
2275 DEFSUBR (Fevent_type);
2276 DEFSUBR (Fevent_properties);
2278 DEFSUBR (Fevent_timestamp);
2279 DEFSUBR (Fevent_timestamp_lessp);
2280 DEFSUBR (Fevent_key);
2281 DEFSUBR (Fevent_button);
2282 DEFSUBR (Fevent_modifier_bits);
2283 DEFSUBR (Fevent_modifiers);
2284 DEFSUBR (Fevent_x_pixel);
2285 DEFSUBR (Fevent_y_pixel);
2286 DEFSUBR (Fevent_window_x_pixel);
2287 DEFSUBR (Fevent_window_y_pixel);
2288 DEFSUBR (Fevent_over_text_area_p);
2289 DEFSUBR (Fevent_over_modeline_p);
2290 DEFSUBR (Fevent_over_border_p);
2291 DEFSUBR (Fevent_over_toolbar_p);
2292 DEFSUBR (Fevent_over_vertical_divider_p);
2293 DEFSUBR (Fevent_channel);
2294 DEFSUBR (Fevent_window);
2295 DEFSUBR (Fevent_point);
2296 DEFSUBR (Fevent_closest_point);
2299 DEFSUBR (Fevent_modeline_position);
2300 DEFSUBR (Fevent_glyph);
2301 DEFSUBR (Fevent_glyph_extent);
2302 DEFSUBR (Fevent_glyph_x_pixel);
2303 DEFSUBR (Fevent_glyph_y_pixel);
2304 DEFSUBR (Fevent_toolbar_button);
2305 DEFSUBR (Fevent_process);
2306 DEFSUBR (Fevent_function);
2307 DEFSUBR (Fevent_object);
2309 defsymbol (&Qeventp, "eventp");
2310 defsymbol (&Qevent_live_p, "event-live-p");
2311 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2312 defsymbol (&Qbutton_event_p, "button-event-p");
2313 defsymbol (&Qmouse_event_p, "mouse-event-p");
2314 defsymbol (&Qprocess_event_p, "process-event-p");
2315 defsymbol (&Qkey_press, "key-press");
2316 defsymbol (&Qbutton_press, "button-press");
2317 defsymbol (&Qbutton_release, "button-release");
2318 defsymbol (&Qmisc_user, "misc-user");
2319 defsymbol (&Qascii_character, "ascii-character");
2321 defsymbol (&QKbackspace, "backspace");
2322 defsymbol (&QKtab, "tab");
2323 defsymbol (&QKlinefeed, "linefeed");
2324 defsymbol (&QKreturn, "return");
2325 defsymbol (&QKescape, "escape");
2326 defsymbol (&QKspace, "space");
2327 defsymbol (&QKdelete, "delete");
2332 reinit_vars_of_events (void)
2334 Vevent_resource = Qnil;
2338 vars_of_events (void)
2340 reinit_vars_of_events ();
2342 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2343 A symbol used to look up the 8-bit character of a keysym.
2344 To convert a keysym symbol to an 8-bit code, as when that key is
2345 bound to self-insert-command, we will look up the property that this
2346 variable names on the property list of the keysym-symbol. The window-
2347 system-specific code will set up appropriate properties and set this
2350 Vcharacter_set_property = Qnil;