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 "console-gtk.h" /* for gtk_event_name prototype */
34 #include "extents.h" /* Just for the EXTENTP ABORT check... */
38 #include "keymap.h" /* for key_desc_list_to_event() */
39 #include "redisplay.h"
41 #include "events-mod.h"
43 /* Where old events go when they are explicitly deallocated.
44 The event chain here is cut loose before GC, so these will be freed
47 static Lisp_Object Vevent_resource;
50 Lisp_Object Qevent_live_p;
51 Lisp_Object Qkey_press_event_p;
52 Lisp_Object Qbutton_event_p;
53 Lisp_Object Qmouse_event_p;
54 Lisp_Object Qprocess_event_p;
56 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
57 Lisp_Object Qascii_character;
59 EXFUN (Fevent_x_pixel, 1);
60 EXFUN (Fevent_y_pixel, 1);
62 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
64 clear_event_resource (void)
66 Vevent_resource = Qnil;
69 /* Make sure we lose quickly if we try to use this event */
71 deinitialize_event (Lisp_Object ev)
74 Lisp_Event *event = XEVENT (ev);
76 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
77 ((int *) event) [i] = 0xdeadbeef;
78 event->event_type = dead_event;
79 event->channel = Qnil;
80 set_lheader_implementation (&event->lheader, &lrecord_event);
81 XSET_EVENT_NEXT (ev, Qnil);
84 /* Set everything to zero or nil so that it's predictable. */
86 zero_event (Lisp_Event *e)
89 set_lheader_implementation (&e->lheader, &lrecord_event);
90 e->event_type = empty_event;
96 mark_event (Lisp_Object obj)
98 Lisp_Event *event = XEVENT (obj);
100 switch (event->event_type)
102 case key_press_event:
103 mark_object (event->event.key.keysym);
106 mark_object (event->event.process.process);
109 mark_object (event->event.timeout.function);
110 mark_object (event->event.timeout.object);
113 case misc_user_event:
114 mark_object (event->event.eval.function);
115 mark_object (event->event.eval.object);
117 case magic_eval_event:
118 mark_object (event->event.magic_eval.object);
120 case button_press_event:
121 case button_release_event:
122 case pointer_motion_event:
130 mark_object (event->channel);
135 print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun)
138 write_c_string (str, printcharfun);
139 format_event_object (buf, XEVENT (obj), 0);
140 write_c_string (buf, printcharfun);
144 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
147 error ("Printing unreadable object #<event>");
149 switch (XEVENT (obj)->event_type)
151 case key_press_event:
152 print_event_1 ("#<keypress-event ", obj, printcharfun);
154 case button_press_event:
155 print_event_1 ("#<buttondown-event ", obj, printcharfun);
157 case button_release_event:
158 print_event_1 ("#<buttonup-event ", obj, printcharfun);
161 case magic_eval_event:
162 print_event_1 ("#<magic-event ", obj, printcharfun);
164 case pointer_motion_event:
168 Vx = Fevent_x_pixel (obj);
170 Vy = Fevent_y_pixel (obj);
172 sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
173 write_c_string (buf, printcharfun);
177 write_c_string ("#<process-event ", printcharfun);
178 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
181 write_c_string ("#<timeout-event ", printcharfun);
182 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
185 write_c_string ("#<empty-event", printcharfun);
187 case misc_user_event:
188 write_c_string ("#<misc-user-event (", printcharfun);
189 print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
190 write_c_string (" ", printcharfun);
191 print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
192 write_c_string (")", printcharfun);
195 write_c_string ("#<eval-event (", printcharfun);
196 print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
197 write_c_string (" ", printcharfun);
198 print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
199 write_c_string (")", printcharfun);
202 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
205 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
208 write_c_string (">", printcharfun);
212 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
214 Lisp_Event *e1 = XEVENT (obj1);
215 Lisp_Event *e2 = XEVENT (obj2);
217 if (e1->event_type != e2->event_type) return 0;
218 if (!EQ (e1->channel, e2->channel)) return 0;
219 /* if (e1->timestamp != e2->timestamp) return 0; */
220 switch (e1->event_type)
225 return EQ (e1->event.process.process, e2->event.process.process);
228 return (internal_equal (e1->event.timeout.function,
229 e2->event.timeout.function, 0) &&
230 internal_equal (e1->event.timeout.object,
231 e2->event.timeout.object, 0));
233 case key_press_event:
234 return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
235 (e1->event.key.modifiers == e2->event.key.modifiers));
237 case button_press_event:
238 case button_release_event:
239 return (e1->event.button.button == e2->event.button.button &&
240 e1->event.button.modifiers == e2->event.button.modifiers);
242 case pointer_motion_event:
243 return (e1->event.motion.x == e2->event.motion.x &&
244 e1->event.motion.y == e2->event.motion.y);
246 case misc_user_event:
247 return (internal_equal (e1->event.eval.function,
248 e2->event.eval.function, 0) &&
249 internal_equal (e1->event.eval.object,
250 e2->event.eval.object, 0) &&
251 /* is this really needed for equality
252 or is x and y also important? */
253 e1->event.misc.button == e2->event.misc.button &&
254 e1->event.misc.modifiers == e2->event.misc.modifiers);
257 return (internal_equal (e1->event.eval.function,
258 e2->event.eval.function, 0) &&
259 internal_equal (e1->event.eval.object,
260 e2->event.eval.object, 0));
262 case magic_eval_event:
263 return (e1->event.magic_eval.internal_function ==
264 e2->event.magic_eval.internal_function &&
265 internal_equal (e1->event.magic_eval.object,
266 e2->event.magic_eval.object, 0));
270 struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
273 if (CONSOLE_GTK_P (con))
274 return (!memcmp (&e1->event.magic.underlying_gdk_event,
275 &e2->event.magic.underlying_gdk_event,
278 #ifdef HAVE_X_WINDOWS
279 if (CONSOLE_X_P (con))
280 return (e1->event.magic.underlying_x_event.xany.serial ==
281 e2->event.magic.underlying_x_event.xany.serial);
284 if (CONSOLE_TTY_P (con))
285 return (e1->event.magic.underlying_tty_event ==
286 e2->event.magic.underlying_tty_event);
288 #ifdef HAVE_MS_WINDOWS
289 if (CONSOLE_MSWINDOWS_P (con))
290 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
291 &e2->event.magic.underlying_mswindows_event,
292 sizeof (union magic_data)));
295 return 1; /* not reached */
298 case empty_event: /* Empty and deallocated events are equal. */
305 event_hash (Lisp_Object obj, int depth)
307 Lisp_Event *e = XEVENT (obj);
310 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
311 switch (e->event_type)
314 return HASH2 (hash, LISP_HASH (e->event.process.process));
317 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
318 internal_hash (e->event.timeout.object, depth + 1));
320 case key_press_event:
321 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
322 e->event.key.modifiers);
324 case button_press_event:
325 case button_release_event:
326 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
328 case pointer_motion_event:
329 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
331 case misc_user_event:
332 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
333 internal_hash (e->event.misc.object, depth + 1),
334 e->event.misc.button, e->event.misc.modifiers);
337 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
338 internal_hash (e->event.eval.object, depth + 1));
340 case magic_eval_event:
342 (unsigned long) e->event.magic_eval.internal_function,
343 internal_hash (e->event.magic_eval.object, depth + 1));
347 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
349 if (CONSOLE_GTK_P (con))
350 return HASH2 (hash, e->event.magic.underlying_gdk_event.type);
352 #ifdef HAVE_X_WINDOWS
353 if (CONSOLE_X_P (con))
354 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
357 if (CONSOLE_TTY_P (con))
358 return HASH2 (hash, e->event.magic.underlying_tty_event);
360 #ifdef HAVE_MS_WINDOWS
361 if (CONSOLE_MSWINDOWS_P (con))
362 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
376 return 0; /* unreached */
379 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
380 mark_event, print_event, 0, event_equal,
381 event_hash, 0, Lisp_Event);
384 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
385 Return a new event of type TYPE, with properties described by PLIST.
387 TYPE is a symbol, either `empty', `key-press', `button-press',
388 `button-release', `misc-user' or `motion'. If TYPE is nil, it
391 PLIST is a property list, the properties being compatible to those
392 returned by `event-properties'. The following properties are
395 channel -- The event channel, a frame or a console. For
396 button-press, button-release, misc-user and motion events,
397 this must be a frame. For key-press events, it must be
398 a console. If channel is unspecified, it will be set to
399 the selected frame or selected console, as appropriate.
400 key -- The event key, a symbol or character. Allowed only for
402 button -- The event button, integer 1, 2 or 3. Allowed for
403 button-press, button-release and misc-user events.
404 modifiers -- The event modifiers, a list of modifier symbols. Allowed
405 for key-press, button-press, button-release, motion and
407 function -- Function. Allowed for misc-user events only.
408 object -- An object, function's parameter. Allowed for misc-user
410 x -- The event X coordinate, an integer. This is relative
411 to the left of CHANNEL's root window. Allowed for
412 motion, button-press, button-release and misc-user events.
413 y -- The event Y coordinate, an integer. This is relative
414 to the top of CHANNEL's root window. Allowed for
415 motion, button-press, button-release and misc-user events.
416 timestamp -- The event timestamp, a non-negative integer. Allowed for
417 all types of events. If unspecified, it will be set to 0
420 For event type `empty', PLIST must be nil.
421 `button-release', or `motion'. If TYPE is left out, it defaults to
423 PLIST is a list of properties, as returned by `event-properties'. Not
424 all properties are allowed for all kinds of events, and some are
427 WARNING: the event object returned may be a reused one; see the function
432 Lisp_Object event = Qnil;
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 syntax_error ("Cannot set properties of empty event", plist);
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 invalid_argument ("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(event_type, prop) \
494 syntax_error_2 ("Invalid property for event type", prop, event_type)
497 EXTERNAL_PROPERTY_LIST_LOOP_3 (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 switch (e->event_type)
517 case key_press_event:
518 if (!SYMBOLP (value) && !CHARP (value))
519 syntax_error ("Invalid event key", value);
520 e->event.key.keysym = value;
523 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
527 else if (EQ (keyword, Qbutton))
529 CHECK_NATNUM (value);
530 check_int_range (XINT (value), 0, 7);
532 switch (e->event_type)
534 case button_press_event:
535 case button_release_event:
536 e->event.button.button = XINT (value);
538 case misc_user_event:
539 e->event.misc.button = XINT (value);
542 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
546 else if (EQ (keyword, Qmodifiers))
550 EXTERNAL_LIST_LOOP_2 (sym, value)
552 if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL;
553 else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META;
554 else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER;
555 else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER;
556 else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT;
557 else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT;
558 else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT;
559 else if (EQ (sym, Qbutton1)) modifiers |= XEMACS_MOD_BUTTON1;
560 else if (EQ (sym, Qbutton2)) modifiers |= XEMACS_MOD_BUTTON2;
561 else if (EQ (sym, Qbutton3)) modifiers |= XEMACS_MOD_BUTTON3;
562 else if (EQ (sym, Qbutton4)) modifiers |= XEMACS_MOD_BUTTON4;
563 else if (EQ (sym, Qbutton5)) modifiers |= XEMACS_MOD_BUTTON5;
565 syntax_error ("Invalid key modifier", sym);
568 switch (e->event_type)
570 case key_press_event:
571 e->event.key.modifiers = modifiers;
573 case button_press_event:
574 case button_release_event:
575 e->event.button.modifiers = modifiers;
577 case pointer_motion_event:
578 e->event.motion.modifiers = modifiers;
580 case misc_user_event:
581 e->event.misc.modifiers = modifiers;
584 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
588 else if (EQ (keyword, Qx))
590 switch (e->event_type)
592 case pointer_motion_event:
593 case button_press_event:
594 case button_release_event:
595 case misc_user_event:
596 /* Allow negative values, so we can specify toolbar
599 coord_x = XINT (value);
602 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
606 else if (EQ (keyword, Qy))
608 switch (e->event_type)
610 case pointer_motion_event:
611 case button_press_event:
612 case button_release_event:
613 case misc_user_event:
614 /* Allow negative values; see above. */
616 coord_y = XINT (value);
619 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
623 else if (EQ (keyword, Qtimestamp))
625 CHECK_NATNUM (value);
626 e->timestamp = XINT (value);
628 else if (EQ (keyword, Qfunction))
630 switch (e->event_type)
632 case misc_user_event:
633 e->event.eval.function = value;
636 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
640 else if (EQ (keyword, Qobject))
642 switch (e->event_type)
644 case misc_user_event:
645 e->event.eval.object = value;
648 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
653 syntax_error_2 ("Invalid property", keyword, value);
657 /* Insert the channel, if missing. */
658 if (NILP (EVENT_CHANNEL (e)))
660 if (e->event_type == key_press_event)
661 EVENT_CHANNEL (e) = Vselected_console;
663 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
666 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
667 to the frame, so we must adjust accordingly. */
668 if (FRAMEP (EVENT_CHANNEL (e)))
670 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
671 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
673 switch (e->event_type)
675 case pointer_motion_event:
676 e->event.motion.x = coord_x;
677 e->event.motion.y = coord_y;
679 case button_press_event:
680 case button_release_event:
681 e->event.button.x = coord_x;
682 e->event.button.y = coord_y;
684 case misc_user_event:
685 e->event.misc.x = coord_x;
686 e->event.misc.y = coord_y;
693 /* Finally, do some more validation. */
694 switch (e->event_type)
696 case key_press_event:
697 if (UNBOUNDP (e->event.key.keysym))
698 syntax_error ("A key must be specified to make a keypress event",
701 case button_press_event:
702 if (!e->event.button.button)
704 ("A button must be specified to make a button-press event",
707 case button_release_event:
708 if (!e->event.button.button)
710 ("A button must be specified to make a button-release event",
713 case misc_user_event:
714 if (NILP (e->event.misc.function))
715 syntax_error ("A function must be specified to make a misc-user event",
726 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
727 Allow the given event structure to be reused.
728 You MUST NOT use this event object after calling this function with it.
729 You will lose. It is not necessary to call this function, as event
730 objects are garbage-collected like all other objects; however, it may
731 be more efficient to explicitly deallocate events when you are sure
732 that it is safe to do so.
738 if (XEVENT_TYPE (event) == dead_event)
739 error ("this event is already deallocated!");
741 assert (XEVENT_TYPE (event) <= last_event_type);
747 if (EQ (event, Vlast_command_event) ||
748 EQ (event, Vlast_input_event) ||
749 EQ (event, Vunread_command_event))
752 len = XVECTOR_LENGTH (Vthis_command_keys);
753 for (i = 0; i < len; i++)
754 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
756 if (!NILP (Vrecent_keys_ring))
758 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
759 for (i = 0; i < recent_ring_len; i++)
760 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
766 assert (!EQ (event, Vevent_resource));
767 deinitialize_event (event);
768 #ifndef ALLOC_NO_POOLS
769 XSET_EVENT_NEXT (event, Vevent_resource);
770 Vevent_resource = event;
775 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
776 Make a copy of the event object EVENT1.
777 If a second event argument EVENT2 is given, EVENT1 is copied into
778 EVENT2 and EVENT2 is returned. If EVENT2 is not supplied (or is nil)
779 then a new event will be made as with `make-event'. See also the
780 function `deallocate-event'.
784 CHECK_LIVE_EVENT (event1);
786 event2 = Fmake_event (Qnil, Qnil);
789 CHECK_LIVE_EVENT (event2);
790 if (EQ (event1, event2))
791 return signal_simple_continuable_error_2
792 ("copy-event called with `eq' events", event1, event2);
795 assert (XEVENT_TYPE (event1) <= last_event_type);
796 assert (XEVENT_TYPE (event2) <= last_event_type);
799 Lisp_Event *ev2 = XEVENT (event2);
800 Lisp_Event *ev1 = XEVENT (event1);
802 ev2->event_type = ev1->event_type;
803 ev2->channel = ev1->channel;
804 ev2->timestamp = ev1->timestamp;
805 ev2->event = ev1->event;
813 /* Given a chain of events (or possibly nil), deallocate them all. */
816 deallocate_event_chain (Lisp_Object event_chain)
818 while (!NILP (event_chain))
820 Lisp_Object next = XEVENT_NEXT (event_chain);
821 Fdeallocate_event (event_chain);
826 /* Return the last event in a chain.
827 NOTE: You cannot pass nil as a value here! The routine will
831 event_chain_tail (Lisp_Object event_chain)
835 Lisp_Object next = XEVENT_NEXT (event_chain);
842 /* Enqueue a single event onto the end of a chain of events.
843 HEAD points to the first event in the chain, TAIL to the last event.
844 If the chain is empty, both values should be nil. */
847 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
849 assert (NILP (XEVENT_NEXT (event)));
850 assert (!EQ (*tail, event));
853 XSET_EVENT_NEXT (*tail, event);
858 assert (!EQ (event, XEVENT_NEXT (event)));
861 /* Remove an event off the head of a chain of events and return it.
862 HEAD points to the first event in the chain, TAIL to the last event. */
865 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
870 *head = XEVENT_NEXT (event);
871 XSET_EVENT_NEXT (event, Qnil);
877 /* Enqueue a chain of events (or possibly nil) onto the end of another
878 chain of events. HEAD points to the first event in the chain being
879 queued onto, TAIL to the last event. If the chain is empty, both values
883 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
886 if (NILP (event_chain))
896 XSET_EVENT_NEXT (*tail, event_chain);
897 *tail = event_chain_tail (event_chain);
901 /* Return the number of events (possibly 0) on an event chain. */
904 event_chain_count (Lisp_Object event_chain)
909 EVENT_CHAIN_LOOP (event, event_chain)
915 /* Find the event before EVENT in an event chain. This ABORTs
916 if the event is not in the chain. */
919 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
921 Lisp_Object previous = Qnil;
923 while (!NILP (event_chain))
925 if (EQ (event_chain, event))
927 previous = event_chain;
928 event_chain = XEVENT_NEXT (event_chain);
936 event_chain_nth (Lisp_Object event_chain, int n)
939 EVENT_CHAIN_LOOP (event, event_chain)
949 copy_event_chain (Lisp_Object event_chain)
951 Lisp_Object new_chain = Qnil;
952 Lisp_Object new_chain_tail = Qnil;
955 EVENT_CHAIN_LOOP (event, event_chain)
957 Lisp_Object copy = Fcopy_event (event, Qnil);
958 enqueue_event (copy, &new_chain, &new_chain_tail);
966 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
970 command_event_p (Lisp_Object event)
972 switch (XEVENT_TYPE (event))
974 case key_press_event:
975 case button_press_event:
976 case button_release_event:
977 case misc_user_event:
986 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
987 int use_console_meta_flag, int do_backspace_mapping)
989 Lisp_Object k = Qnil;
991 if (event->event_type == dead_event)
992 error ("character-to-event called with a deallocated event!");
997 if (c > 127 && c <= 255)
1000 if (use_console_meta_flag && CONSOLE_TTY_P (con))
1001 meta_flag = TTY_FLAGS (con).meta_key;
1004 case 0: /* ignore top bit; it's parity */
1007 case 1: /* top bit is meta */
1009 m = XEMACS_MOD_META;
1011 default: /* this is a real character */
1015 if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL;
1016 if (m & XEMACS_MOD_CONTROL)
1020 case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break;
1021 case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break;
1022 case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break;
1023 case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break;
1025 #if defined(HAVE_TTY)
1026 if (do_backspace_mapping &&
1027 CHARP (con->tty_erase_char) &&
1028 c - '@' == XCHAR (con->tty_erase_char))
1031 m &= ~XEMACS_MOD_CONTROL;
1033 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1036 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1038 #if defined(HAVE_TTY)
1039 else if (do_backspace_mapping &&
1040 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1042 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1048 event->event_type = key_press_event;
1049 event->timestamp = 0; /* #### */
1050 event->channel = make_console (con);
1051 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1052 event->event.key.modifiers = m;
1055 /* This variable controls what character name -> character code mapping
1056 we are using. Window-system-specific code sets this to some symbol,
1057 and we use that symbol as the plist key to convert keysyms into 8-bit
1058 codes. In this way one can have several character sets predefined and
1059 switch them by changing this.
1061 #### This is utterly bogus and should be removed.
1063 Lisp_Object Vcharacter_set_property;
1066 event_to_character (Lisp_Event *event,
1067 int allow_extra_modifiers,
1069 int allow_non_ascii)
1074 if (event->event_type != key_press_event)
1076 assert (event->event_type != dead_event);
1079 if (!allow_extra_modifiers &&
1080 event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT))
1082 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1083 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1084 else if (!SYMBOLP (event->event.key.keysym))
1086 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1087 /* Allow window-system-specific extensibility of
1088 keysym->code mapping */
1089 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1090 Vcharacter_set_property,
1092 c = XCHAR_OR_CHAR_INT (code);
1093 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1094 Qascii_character, Qnil)))
1095 c = XCHAR_OR_CHAR_INT (code);
1099 if (event->event.key.modifiers & XEMACS_MOD_CONTROL)
1101 if (c >= 'a' && c <= 'z')
1104 /* reject Control-Shift- keys */
1105 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1108 if (c >= '@' && c <= '_')
1110 else if (c == ' ') /* C-space and C-@ are the same. */
1113 /* reject keys that can't take Control- modifiers */
1114 if (! allow_extra_modifiers) return -1;
1117 if (event->event.key.modifiers & XEMACS_MOD_META)
1119 if (! allow_meta) return -1;
1120 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1122 if (c >= 256) return -1;
1129 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1130 Return the closest ASCII approximation to the given event object.
1131 If the event isn't a keypress, this returns nil.
1132 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1133 its translation; it will ignore modifier keys other than control and meta,
1134 and will ignore the shift modifier on those characters which have no
1135 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1136 the same ASCII code as Control-A).
1137 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1138 represented by turning on the high bit of the byte returned; otherwise, nil
1139 will be returned for events containing the Meta modifier.
1140 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1141 present in the prevailing character set (see the `character-set-property'
1142 variable) will be returned as their code in that character set, instead of
1143 the return value being restricted to ASCII.
1144 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1145 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1147 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1150 CHECK_LIVE_EVENT (event);
1151 c = event_to_character (XEVENT (event),
1152 !NILP (allow_extra_modifiers),
1154 !NILP (allow_non_ascii));
1155 return c < 0 ? Qnil : make_char (c);
1158 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1159 Convert KEY-DESCRIPTION into an event structure, replete with bucky bits.
1161 KEY-DESCRIPTION is the first argument, and the event to fill in is the
1162 second. This function contains knowledge about what various kinds of
1163 arguments ``mean'' -- for example, the number 9 is converted to the
1164 character ``Tab'', not the distinct character ``Control-I''.
1166 KEY-DESCRIPTION can be an integer, a character, a symbol such as 'clear,
1167 or a list such as '(control backspace).
1169 If the optional second argument EVENT is an event, it is modified and
1170 returned; otherwise, a new event object is created and returned.
1172 Optional third arg CONSOLE is the console to store in the event, and
1173 defaults to the selected console.
1175 If KEY-DESCRIPTION is an integer or character, the high bit may be
1176 interpreted as the meta key. (This is done for backward compatibility
1177 in lots of places.) If USE-CONSOLE-META-FLAG is nil, this will always
1178 be the case. If USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for
1179 CONSOLE affects whether the high bit is interpreted as a meta
1180 key. (See `set-input-mode'.) If you don't want this silly meta
1181 interpretation done, you should pass in a list containing the
1184 Beware that character-to-event and event-to-character are not strictly
1185 inverse functions, since events contain much more information than the
1186 Lisp character object type can encode.
1188 (keystroke, event, console, use_console_meta_flag))
1190 struct console *con = decode_console (console);
1192 event = Fmake_event (Qnil, Qnil);
1194 CHECK_LIVE_EVENT (event);
1195 if (CONSP (keystroke) || SYMBOLP (keystroke))
1196 key_desc_list_to_event (keystroke, event, 1);
1199 CHECK_CHAR_COERCE_INT (keystroke);
1200 character_to_event (XCHAR (keystroke), XEVENT (event), con,
1201 !NILP (use_console_meta_flag), 1);
1207 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1209 assert (STRINGP (seq) || VECTORP (seq));
1210 assert (n < XINT (Flength (seq)));
1214 Emchar ch = string_char (XSTRING (seq), n);
1215 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1219 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1220 if (EVENTP (keystroke))
1221 Fcopy_event (keystroke, event);
1223 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1228 key_sequence_to_event_chain (Lisp_Object seq)
1230 int len = XINT (Flength (seq));
1232 Lisp_Object head = Qnil, tail = Qnil;
1234 for (i = 0; i < len; i++)
1236 Lisp_Object event = Fmake_event (Qnil, Qnil);
1237 nth_of_key_sequence_as_event (seq, i, event);
1238 enqueue_event (event, &head, &tail);
1245 format_event_object (char *buf, Lisp_Event *event, int brief)
1251 switch (event->event_type)
1253 case key_press_event:
1255 mod = event->event.key.modifiers;
1256 key = event->event.key.keysym;
1258 if (! brief && CHARP (key) &&
1259 mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER))
1261 int k = XCHAR (key);
1262 if (k >= 'a' && k <= 'z')
1263 key = make_char (k - ('a' - 'A'));
1264 else if (k >= 'A' && k <= 'Z')
1265 mod |= XEMACS_MOD_SHIFT;
1269 case button_release_event:
1272 case button_press_event:
1275 mod = event->event.button.modifiers;
1276 key = make_char (event->event.button.button + '0');
1281 const char *name = NULL;
1285 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1286 if (CONSOLE_GTK_P (XCONSOLE (console)))
1287 name = gtk_event_name (event->event.magic.underlying_gdk_event.type);
1290 #ifdef HAVE_X_WINDOWS
1292 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1293 if (CONSOLE_X_P (XCONSOLE (console)))
1294 name = x_event_name (event->event.magic.underlying_x_event.type);
1296 #endif /* HAVE_X_WINDOWS */
1297 if (name) strcpy (buf, name);
1298 else strcpy (buf, "???");
1301 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1302 case pointer_motion_event: strcpy (buf, "motion"); return;
1303 case misc_user_event: strcpy (buf, "misc-user"); return;
1304 case eval_event: strcpy (buf, "eval"); return;
1305 case process_event: strcpy (buf, "process"); return;
1306 case timeout_event: strcpy (buf, "timeout"); return;
1307 case empty_event: strcpy (buf, "empty"); return;
1308 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1313 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1314 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1315 if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-");
1316 if (mod & XEMACS_MOD_META) modprint ("meta-", "M-");
1317 if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-");
1318 if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-");
1319 if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-");
1320 if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-");
1323 modprint1 ("button");
1332 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1335 else if (SYMBOLP (key))
1337 const char *str = 0;
1340 if (EQ (key, QKlinefeed)) str = "LFD";
1341 else if (EQ (key, QKtab)) str = "TAB";
1342 else if (EQ (key, QKreturn)) str = "RET";
1343 else if (EQ (key, QKescape)) str = "ESC";
1344 else if (EQ (key, QKdelete)) str = "DEL";
1345 else if (EQ (key, QKspace)) str = "SPC";
1346 else if (EQ (key, QKbackspace)) str = "BS";
1350 int i = strlen (str);
1351 memcpy (buf, str, i+1);
1356 Lisp_String *name = XSYMBOL (key)->name;
1357 memcpy (buf, string_data (name), string_length (name) + 1);
1358 str += string_length (name);
1364 strncpy (buf, "up", 4);
1367 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1368 True if OBJECT is an event object.
1372 return EVENTP (object) ? Qt : Qnil;
1375 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1376 True if OBJECT is an event object that has not been deallocated.
1380 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1384 #if 0 /* debugging functions */
1386 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1387 Return the event object's `next' event, or nil if it has none.
1388 The `next-event' field is changed by calling `set-next-event'.
1393 CHECK_LIVE_EVENT (event);
1395 return XEVENT_NEXT (event);
1398 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1399 Set the `next event' of EVENT to NEXT-EVENT.
1400 NEXT-EVENT must be an event object or nil.
1402 (event, next_event))
1406 CHECK_LIVE_EVENT (event);
1407 if (NILP (next_event))
1409 XSET_EVENT_NEXT (event, Qnil);
1413 CHECK_LIVE_EVENT (next_event);
1415 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1419 signal_error (Qerror,
1420 list3 (build_string ("Cyclic event-next"),
1424 XSET_EVENT_NEXT (event, next_event);
1430 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1431 Return the type of EVENT.
1432 This will be a symbol; one of
1434 key-press A key was pressed.
1435 button-press A mouse button was pressed.
1436 button-release A mouse button was released.
1437 misc-user Some other user action happened; typically, this is
1438 a menu selection or scrollbar action.
1439 motion The mouse moved.
1440 process Input is available from a subprocess.
1441 timeout A timeout has expired.
1442 eval This causes a specified action to occur when dispatched.
1443 magic Some window-system-specific event has occurred.
1444 empty The event has been allocated but not assigned.
1449 CHECK_LIVE_EVENT (event);
1450 switch (XEVENT (event)->event_type)
1452 case key_press_event: return Qkey_press;
1453 case button_press_event: return Qbutton_press;
1454 case button_release_event: return Qbutton_release;
1455 case misc_user_event: return Qmisc_user;
1456 case pointer_motion_event: return Qmotion;
1457 case process_event: return Qprocess;
1458 case timeout_event: return Qtimeout;
1459 case eval_event: return Qeval;
1461 case magic_eval_event:
1473 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1474 Return the timestamp of the event object EVENT.
1475 Timestamps are measured in milliseconds since the start of the window system.
1476 They are NOT related to any current time measurement.
1477 They should be compared with `event-timestamp<'.
1478 See also `current-event-timestamp'.
1482 CHECK_LIVE_EVENT (event);
1483 /* This junk is so that timestamps don't get to be negative, but contain
1484 as many bits as this particular emacs will allow.
1486 return make_int (EMACS_INT_MAX & XEVENT (event)->timestamp);
1489 #define TIMESTAMP_HALFSPACE (1L << (INT_VALBITS - 2))
1491 DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /*
1492 Return true if timestamp TIME1 is earlier than timestamp TIME2.
1493 This correctly handles timestamp wrap.
1494 See also `event-timestamp' and `current-event-timestamp'.
1500 CHECK_NATNUM (time1);
1501 CHECK_NATNUM (time2);
1506 return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil;
1508 return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt;
1511 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1512 CHECK_LIVE_EVENT (e); \
1513 if (XEVENT(e)->event_type != (t1)) \
1514 e = wrong_type_argument (sym,e); \
1517 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1518 CHECK_LIVE_EVENT (e); \
1520 emacs_event_type CET_type = XEVENT (e)->event_type; \
1521 if (CET_type != (t1) && \
1523 e = wrong_type_argument (sym,e); \
1527 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1528 CHECK_LIVE_EVENT (e); \
1530 emacs_event_type CET_type = XEVENT (e)->event_type; \
1531 if (CET_type != (t1) && \
1532 CET_type != (t2) && \
1534 e = wrong_type_argument (sym,e); \
1538 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1539 Return the Keysym of the key-press event EVENT.
1540 This will be a character if the event is associated with one, else a symbol.
1544 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1545 return XEVENT (event)->event.key.keysym;
1548 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1549 Return the button-number of the button-press or button-release event EVENT.
1554 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1555 misc_user_event, Qbutton_event_p);
1556 #ifdef HAVE_WINDOW_SYSTEM
1557 if ( XEVENT (event)->event_type == misc_user_event)
1558 return make_int (XEVENT (event)->event.misc.button);
1560 return make_int (XEVENT (event)->event.button.button);
1561 #else /* !HAVE_WINDOW_SYSTEM */
1563 #endif /* !HAVE_WINDOW_SYSTEM */
1567 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1568 Return a number representing the modifier keys and buttons which were down
1569 when the given mouse or keyboard event was produced.
1570 See also the function `event-modifiers'.
1575 CHECK_LIVE_EVENT (event);
1576 switch (XEVENT (event)->event_type)
1578 case key_press_event:
1579 return make_int (XEVENT (event)->event.key.modifiers);
1580 case button_press_event:
1581 case button_release_event:
1582 return make_int (XEVENT (event)->event.button.modifiers);
1583 case pointer_motion_event:
1584 return make_int (XEVENT (event)->event.motion.modifiers);
1585 case misc_user_event:
1586 return make_int (XEVENT (event)->event.misc.modifiers);
1588 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1593 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1594 Return a list of symbols, the names of the modifier keys and buttons
1595 which were down when the given mouse or keyboard event was produced.
1596 See also the function `event-modifier-bits'.
1598 The possible symbols in the list are
1600 `shift': The Shift key. Will not appear, in general, on key events
1601 where the keysym is an ASCII character, because using Shift
1602 on such a character converts it into another character rather
1603 than actually just adding a Shift modifier.
1605 `control': The Control key.
1607 `meta': The Meta key. On PC's and PC-style keyboards, this is generally
1608 labelled \"Alt\"; Meta is a holdover from early Lisp Machines and
1609 such, propagated through the X Window System. On Sun keyboards,
1610 this key is labelled with a diamond.
1612 `alt': The \"Alt\" key. Alt is in quotes because this does not refer
1613 to what it obviously should refer to, namely the Alt key on PC
1614 keyboards. Instead, it refers to the key labelled Alt on Sun
1615 keyboards, and to no key at all on PC keyboards.
1617 `super': The Super key. Most keyboards don't have any such key, but
1618 under X Windows using `xmodmap' you can assign any key (such as
1619 an underused right-shift, right-control, or right-alt key) to
1620 this key modifier. No support currently exists under MS Windows
1621 for generating these modifiers.
1623 `hyper': The Hyper key. Works just like the Super key.
1625 `button1': The mouse buttons. This means that the specified button was held
1626 `button2': down at the time the event occurred. NOTE: For button-press
1627 `button3': events, the button that was just pressed down does NOT appear in
1628 `button4': the modifiers.
1631 Button modifiers are currently ignored when defining and looking up key and
1632 mouse strokes in keymaps. This could be changed, which would allow a user to
1633 create button-chord actions, use a button as a key modifier and do other
1638 int mod = XINT (Fevent_modifier_bits (event));
1639 Lisp_Object result = Qnil;
1640 struct gcpro gcpro1;
1643 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result);
1644 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result);
1645 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result);
1646 if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result);
1647 if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result);
1648 if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result);
1649 if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result);
1650 if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result);
1651 if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result);
1652 if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result);
1653 if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result);
1654 RETURN_UNGCPRO (Fnreverse (result));
1658 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1663 if (XEVENT (event)->event_type == pointer_motion_event)
1665 *x = XEVENT (event)->event.motion.x;
1666 *y = XEVENT (event)->event.motion.y;
1668 else if (XEVENT (event)->event_type == button_press_event ||
1669 XEVENT (event)->event_type == button_release_event)
1671 *x = XEVENT (event)->event.button.x;
1672 *y = XEVENT (event)->event.button.y;
1674 else if (XEVENT (event)->event_type == misc_user_event)
1676 *x = XEVENT (event)->event.misc.x;
1677 *y = XEVENT (event)->event.misc.y;
1682 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1686 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1689 return 1; /* #### What should really happen here? */
1691 *x -= w->pixel_left;
1696 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1697 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1698 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1699 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1705 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1706 Return the X position in pixels of mouse event EVENT.
1707 The value returned is relative to the window the event occurred in.
1708 This will signal an error if the event is not a mouse event.
1709 See also `mouse-event-p' and `event-x-pixel'.
1715 CHECK_LIVE_EVENT (event);
1717 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1718 return wrong_type_argument (Qmouse_event_p, event);
1720 return make_int (x);
1723 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1724 Return the Y position in pixels of mouse event EVENT.
1725 The value returned is relative to the window the event occurred in.
1726 This will signal an error if the event is not a mouse event.
1727 See also `mouse-event-p' and `event-y-pixel'.
1733 CHECK_LIVE_EVENT (event);
1735 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1736 return wrong_type_argument (Qmouse_event_p, event);
1738 return make_int (y);
1741 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1742 Return the X position in pixels of mouse event EVENT.
1743 The value returned is relative to the frame the event occurred in.
1744 This will signal an error if the event is not a mouse event.
1745 See also `mouse-event-p' and `event-window-x-pixel'.
1751 CHECK_LIVE_EVENT (event);
1753 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1754 return wrong_type_argument (Qmouse_event_p, event);
1756 return make_int (x);
1759 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1760 Return the Y position in pixels of mouse event EVENT.
1761 The value returned is relative to the frame the event occurred in.
1762 This will signal an error if the event is not a mouse event.
1763 See also `mouse-event-p' `event-window-y-pixel'.
1769 CHECK_LIVE_EVENT (event);
1771 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1772 return wrong_type_argument (Qmouse_event_p, event);
1774 return make_int (y);
1777 /* Given an event, return a value:
1779 OVER_TOOLBAR: over one of the 4 frame toolbars
1780 OVER_MODELINE: over a modeline
1781 OVER_BORDER: over an internal border
1782 OVER_NOTHING: over the text area, but not over text
1783 OVER_OUTSIDE: outside of the frame border
1784 OVER_TEXT: over text in the text area
1785 OVER_V_DIVIDER: over windows vertical divider
1789 The X char position in CHAR_X, if not a null pointer.
1790 The Y char position in CHAR_Y, if not a null pointer.
1791 (These last two values are relative to the window the event is over.)
1792 The window it's over in W, if not a null pointer.
1793 The buffer position it's over in BUFP, if not a null pointer.
1794 The closest buffer position in CLOSEST, if not a null pointer.
1796 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1800 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1801 int *obj_x, int *obj_y,
1802 struct window **w, Bufpos *bufp, Bufpos *closest,
1803 Charcount *modeline_closest,
1804 Lisp_Object *obj1, Lisp_Object *obj2)
1811 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1812 struct window *ret_w;
1813 Bufpos ret_bufp, ret_closest;
1814 Charcount ret_modeline_closest;
1815 Lisp_Object ret_obj1, ret_obj2;
1817 CHECK_LIVE_EVENT (event);
1818 frame = XEVENT (event)->channel;
1819 switch (XEVENT (event)->event_type)
1821 case pointer_motion_event :
1822 pix_x = XEVENT (event)->event.motion.x;
1823 pix_y = XEVENT (event)->event.motion.y;
1825 case button_press_event :
1826 case button_release_event :
1827 pix_x = XEVENT (event)->event.button.x;
1828 pix_y = XEVENT (event)->event.button.y;
1830 case misc_user_event :
1831 pix_x = XEVENT (event)->event.misc.x;
1832 pix_y = XEVENT (event)->event.misc.y;
1835 dead_wrong_type_argument (Qmouse_event_p, event);
1838 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1839 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1840 &ret_w, &ret_bufp, &ret_closest,
1841 &ret_modeline_closest,
1842 &ret_obj1, &ret_obj2);
1844 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1846 else if (ret_w && NILP (ret_w->buffer))
1847 /* Why does this happen? (Does it still happen?)
1848 I guess the window has gotten reused as a non-leaf... */
1851 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1852 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1853 pointer points to random memory, often filled with 0, sometimes not.
1855 /* #### Chuck, do we still need this crap? */
1856 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1857 #ifdef HAVE_TOOLBARS
1858 || TOOLBAR_BUTTONP (ret_obj1)
1862 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1878 *closest = ret_closest;
1879 if (modeline_closest)
1880 *modeline_closest = ret_modeline_closest;
1889 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1890 Return t if the mouse event EVENT occurred over the text area of a window.
1891 The modeline is not considered to be part of the text area.
1895 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1897 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1900 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1901 Return t if the mouse event EVENT occurred over the modeline of a window.
1905 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1907 return result == OVER_MODELINE ? Qt : Qnil;
1910 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1911 Return t if the mouse event EVENT occurred over an internal border.
1915 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1917 return result == OVER_BORDER ? Qt : Qnil;
1920 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1921 Return t if the mouse event EVENT occurred over a toolbar.
1925 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1927 return result == OVER_TOOLBAR ? Qt : Qnil;
1930 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1931 Return t if the mouse event EVENT occurred over a window divider.
1935 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1937 return result == OVER_V_DIVIDER ? Qt : Qnil;
1941 event_console_or_selected (Lisp_Object event)
1943 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1944 Lisp_Object console = CDFW_CONSOLE (channel);
1947 console = Vselected_console;
1949 return XCONSOLE (console);
1952 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1953 Return the channel that the event EVENT occurred on.
1954 This will be a frame, device, console, or nil for some types
1955 of events (e.g. eval events).
1959 CHECK_LIVE_EVENT (event);
1960 return EVENT_CHANNEL (XEVENT (event));
1963 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1964 Return the window over which mouse event EVENT occurred.
1965 This may be nil if the event occurred in the border or over a toolbar.
1966 The modeline is considered to be within the window it describes.
1972 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1980 XSETWINDOW (window, w);
1985 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1986 Return the character position of the mouse event EVENT.
1987 If the event did not occur over a window, or did not occur over text,
1988 then this returns nil. Otherwise, it returns a position in the buffer
1989 visible in the event's window.
1996 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1998 return w && bufp ? make_int (bufp) : Qnil;
2001 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
2002 Return the character position closest to the mouse event EVENT.
2003 If the event did not occur over a window or over text, return the
2004 closest point to the location of the event. If the Y pixel position
2005 overlaps a window and the X pixel position is to the left of that
2006 window, the closest point is the beginning of the line containing the
2007 Y position. If the Y pixel position overlaps a window and the X pixel
2008 position is to the right of that window, the closest point is the end
2009 of the line containing the Y position. If the Y pixel position is
2010 above a window, return 0. If it is below the last character in a window,
2011 return the value of (window-end).
2017 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
2019 return bufp ? make_int (bufp) : Qnil;
2022 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
2023 Return the X position of the mouse event EVENT in characters.
2024 This is relative to the window the event occurred over.
2030 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
2032 return make_int (char_x);
2035 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
2036 Return the Y position of the mouse event EVENT in characters.
2037 This is relative to the window the event occurred over.
2043 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
2045 return make_int (char_y);
2048 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
2049 Return the character position in the modeline that EVENT occurred over.
2050 EVENT should be a mouse event. If EVENT did not occur over a modeline,
2051 nil is returned. You can determine the actual character that the
2052 event occurred over by looking in `generated-modeline-string' at the
2053 returned character position. Note that `generated-modeline-string'
2054 is buffer-local, and you must use EVENT's buffer when retrieving
2055 `generated-modeline-string' in order to get accurate results.
2062 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
2064 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
2067 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
2068 Return the glyph that the mouse event EVENT occurred over, or nil.
2075 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
2077 return w && GLYPHP (glyph) ? glyph : Qnil;
2080 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
2081 Return the extent of the glyph that the mouse event EVENT occurred over.
2082 If the event did not occur over a glyph, nil is returned.
2089 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
2091 return w && EXTENTP (extent) ? extent : Qnil;
2094 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
2095 Return the X pixel position of EVENT relative to the glyph it occurred over.
2096 EVENT should be a mouse event. If the event did not occur over a glyph,
2105 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2107 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2110 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2111 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2112 EVENT should be a mouse event. If the event did not occur over a glyph,
2121 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2123 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2126 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2127 Return the toolbar button that the mouse event EVENT occurred over.
2128 If the event did not occur over a toolbar button, nil is returned.
2132 #ifdef HAVE_TOOLBARS
2135 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2137 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2143 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2144 Return the process of the process-output event EVENT.
2148 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2149 return XEVENT (event)->event.process.process;
2152 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2153 Return the callback function of EVENT.
2154 EVENT should be a timeout, misc-user, or eval event.
2159 CHECK_LIVE_EVENT (event);
2160 switch (XEVENT (event)->event_type)
2163 return XEVENT (event)->event.timeout.function;
2164 case misc_user_event:
2165 return XEVENT (event)->event.misc.function;
2167 return XEVENT (event)->event.eval.function;
2169 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2174 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2175 Return the callback function argument of EVENT.
2176 EVENT should be a timeout, misc-user, or eval event.
2181 CHECK_LIVE_EVENT (event);
2182 switch (XEVENT (event)->event_type)
2185 return XEVENT (event)->event.timeout.object;
2186 case misc_user_event:
2187 return XEVENT (event)->event.misc.object;
2189 return XEVENT (event)->event.eval.object;
2191 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2196 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2197 Return a list of all of the properties of EVENT.
2198 This is in the form of a property list (alternating keyword/value pairs).
2202 Lisp_Object props = Qnil;
2204 struct gcpro gcpro1;
2206 CHECK_LIVE_EVENT (event);
2210 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2212 switch (e->event_type)
2217 props = cons3 (Qprocess, e->event.process.process, props);
2221 props = cons3 (Qobject, Fevent_object (event), props);
2222 props = cons3 (Qfunction, Fevent_function (event), props);
2223 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2226 case key_press_event:
2227 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2228 props = cons3 (Qkey, Fevent_key (event), props);
2231 case button_press_event:
2232 case button_release_event:
2233 props = cons3 (Qy, Fevent_y_pixel (event), props);
2234 props = cons3 (Qx, Fevent_x_pixel (event), props);
2235 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2236 props = cons3 (Qbutton, Fevent_button (event), props);
2239 case pointer_motion_event:
2240 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2241 props = cons3 (Qy, Fevent_y_pixel (event), props);
2242 props = cons3 (Qx, Fevent_x_pixel (event), props);
2245 case misc_user_event:
2246 props = cons3 (Qobject, Fevent_object (event), props);
2247 props = cons3 (Qfunction, Fevent_function (event), props);
2248 props = cons3 (Qy, Fevent_y_pixel (event), props);
2249 props = cons3 (Qx, Fevent_x_pixel (event), props);
2250 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2251 props = cons3 (Qbutton, Fevent_button (event), props);
2255 props = cons3 (Qobject, Fevent_object (event), props);
2256 props = cons3 (Qfunction, Fevent_function (event), props);
2259 case magic_eval_event:
2264 RETURN_UNGCPRO (Qnil);
2268 props = cons3 (Qchannel, Fevent_channel (event), props);
2275 /************************************************************************/
2276 /* initialization */
2277 /************************************************************************/
2280 syms_of_events (void)
2282 INIT_LRECORD_IMPLEMENTATION (event);
2284 DEFSUBR (Fcharacter_to_event);
2285 DEFSUBR (Fevent_to_character);
2287 DEFSUBR (Fmake_event);
2288 DEFSUBR (Fdeallocate_event);
2289 DEFSUBR (Fcopy_event);
2291 DEFSUBR (Fevent_live_p);
2292 DEFSUBR (Fevent_type);
2293 DEFSUBR (Fevent_properties);
2295 DEFSUBR (Fevent_timestamp);
2296 DEFSUBR (Fevent_timestamp_lessp);
2297 DEFSUBR (Fevent_key);
2298 DEFSUBR (Fevent_button);
2299 DEFSUBR (Fevent_modifier_bits);
2300 DEFSUBR (Fevent_modifiers);
2301 DEFSUBR (Fevent_x_pixel);
2302 DEFSUBR (Fevent_y_pixel);
2303 DEFSUBR (Fevent_window_x_pixel);
2304 DEFSUBR (Fevent_window_y_pixel);
2305 DEFSUBR (Fevent_over_text_area_p);
2306 DEFSUBR (Fevent_over_modeline_p);
2307 DEFSUBR (Fevent_over_border_p);
2308 DEFSUBR (Fevent_over_toolbar_p);
2309 DEFSUBR (Fevent_over_vertical_divider_p);
2310 DEFSUBR (Fevent_channel);
2311 DEFSUBR (Fevent_window);
2312 DEFSUBR (Fevent_point);
2313 DEFSUBR (Fevent_closest_point);
2316 DEFSUBR (Fevent_modeline_position);
2317 DEFSUBR (Fevent_glyph);
2318 DEFSUBR (Fevent_glyph_extent);
2319 DEFSUBR (Fevent_glyph_x_pixel);
2320 DEFSUBR (Fevent_glyph_y_pixel);
2321 DEFSUBR (Fevent_toolbar_button);
2322 DEFSUBR (Fevent_process);
2323 DEFSUBR (Fevent_function);
2324 DEFSUBR (Fevent_object);
2326 defsymbol (&Qeventp, "eventp");
2327 defsymbol (&Qevent_live_p, "event-live-p");
2328 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2329 defsymbol (&Qbutton_event_p, "button-event-p");
2330 defsymbol (&Qmouse_event_p, "mouse-event-p");
2331 defsymbol (&Qprocess_event_p, "process-event-p");
2332 defsymbol (&Qkey_press, "key-press");
2333 defsymbol (&Qbutton_press, "button-press");
2334 defsymbol (&Qbutton_release, "button-release");
2335 defsymbol (&Qmisc_user, "misc-user");
2336 defsymbol (&Qascii_character, "ascii-character");
2338 defsymbol (&QKbackspace, "backspace");
2339 defsymbol (&QKtab, "tab");
2340 defsymbol (&QKlinefeed, "linefeed");
2341 defsymbol (&QKreturn, "return");
2342 defsymbol (&QKescape, "escape");
2343 defsymbol (&QKspace, "space");
2344 defsymbol (&QKdelete, "delete");
2349 reinit_vars_of_events (void)
2351 Vevent_resource = Qnil;
2355 vars_of_events (void)
2357 reinit_vars_of_events ();
2359 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2360 A symbol used to look up the 8-bit character of a keysym.
2361 To convert a keysym symbol to an 8-bit code, as when that key is
2362 bound to self-insert-command, we will look up the property that this
2363 variable names on the property list of the keysym-symbol. The window-
2364 system-specific code will set up appropriate properties and set this
2367 Vcharacter_set_property = Qnil;