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 (((1L << (VALBITS - 1)) - 1) &
1487 XEVENT (event)->timestamp);
1490 #define TIMESTAMP_HALFSPACE (1L << (VALBITS - 2))
1492 DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /*
1493 Return true if timestamp TIME1 is earlier than timestamp TIME2.
1494 This correctly handles timestamp wrap.
1495 See also `event-timestamp' and `current-event-timestamp'.
1501 CHECK_NATNUM (time1);
1502 CHECK_NATNUM (time2);
1507 return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil;
1509 return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt;
1512 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1513 CHECK_LIVE_EVENT (e); \
1514 if (XEVENT(e)->event_type != (t1)) \
1515 e = wrong_type_argument (sym,e); \
1518 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1519 CHECK_LIVE_EVENT (e); \
1521 emacs_event_type CET_type = XEVENT (e)->event_type; \
1522 if (CET_type != (t1) && \
1524 e = wrong_type_argument (sym,e); \
1528 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1529 CHECK_LIVE_EVENT (e); \
1531 emacs_event_type CET_type = XEVENT (e)->event_type; \
1532 if (CET_type != (t1) && \
1533 CET_type != (t2) && \
1535 e = wrong_type_argument (sym,e); \
1539 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1540 Return the Keysym of the key-press event EVENT.
1541 This will be a character if the event is associated with one, else a symbol.
1545 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1546 return XEVENT (event)->event.key.keysym;
1549 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1550 Return the button-number of the button-press or button-release event EVENT.
1555 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1556 misc_user_event, Qbutton_event_p);
1557 #ifdef HAVE_WINDOW_SYSTEM
1558 if ( XEVENT (event)->event_type == misc_user_event)
1559 return make_int (XEVENT (event)->event.misc.button);
1561 return make_int (XEVENT (event)->event.button.button);
1562 #else /* !HAVE_WINDOW_SYSTEM */
1564 #endif /* !HAVE_WINDOW_SYSTEM */
1568 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1569 Return a number representing the modifier keys and buttons which were down
1570 when the given mouse or keyboard event was produced.
1571 See also the function `event-modifiers'.
1576 CHECK_LIVE_EVENT (event);
1577 switch (XEVENT (event)->event_type)
1579 case key_press_event:
1580 return make_int (XEVENT (event)->event.key.modifiers);
1581 case button_press_event:
1582 case button_release_event:
1583 return make_int (XEVENT (event)->event.button.modifiers);
1584 case pointer_motion_event:
1585 return make_int (XEVENT (event)->event.motion.modifiers);
1586 case misc_user_event:
1587 return make_int (XEVENT (event)->event.misc.modifiers);
1589 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1594 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1595 Return a list of symbols, the names of the modifier keys and buttons
1596 which were down when the given mouse or keyboard event was produced.
1597 See also the function `event-modifier-bits'.
1599 The possible symbols in the list are
1601 `shift': The Shift key. Will not appear, in general, on key events
1602 where the keysym is an ASCII character, because using Shift
1603 on such a character converts it into another character rather
1604 than actually just adding a Shift modifier.
1606 `control': The Control key.
1608 `meta': The Meta key. On PC's and PC-style keyboards, this is generally
1609 labelled \"Alt\"; Meta is a holdover from early Lisp Machines and
1610 such, propagated through the X Window System. On Sun keyboards,
1611 this key is labelled with a diamond.
1613 `alt': The \"Alt\" key. Alt is in quotes because this does not refer
1614 to what it obviously should refer to, namely the Alt key on PC
1615 keyboards. Instead, it refers to the key labelled Alt on Sun
1616 keyboards, and to no key at all on PC keyboards.
1618 `super': The Super key. Most keyboards don't have any such key, but
1619 under X Windows using `xmodmap' you can assign any key (such as
1620 an underused right-shift, right-control, or right-alt key) to
1621 this key modifier. No support currently exists under MS Windows
1622 for generating these modifiers.
1624 `hyper': The Hyper key. Works just like the Super key.
1626 `button1': The mouse buttons. This means that the specified button was held
1627 `button2': down at the time the event occurred. NOTE: For button-press
1628 `button3': events, the button that was just pressed down does NOT appear in
1629 `button4': the modifiers.
1632 Button modifiers are currently ignored when defining and looking up key and
1633 mouse strokes in keymaps. This could be changed, which would allow a user to
1634 create button-chord actions, use a button as a key modifier and do other
1639 int mod = XINT (Fevent_modifier_bits (event));
1640 Lisp_Object result = Qnil;
1641 struct gcpro gcpro1;
1644 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result);
1645 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result);
1646 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result);
1647 if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result);
1648 if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result);
1649 if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result);
1650 if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result);
1651 if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result);
1652 if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result);
1653 if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result);
1654 if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result);
1655 RETURN_UNGCPRO (Fnreverse (result));
1659 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1664 if (XEVENT (event)->event_type == pointer_motion_event)
1666 *x = XEVENT (event)->event.motion.x;
1667 *y = XEVENT (event)->event.motion.y;
1669 else if (XEVENT (event)->event_type == button_press_event ||
1670 XEVENT (event)->event_type == button_release_event)
1672 *x = XEVENT (event)->event.button.x;
1673 *y = XEVENT (event)->event.button.y;
1675 else if (XEVENT (event)->event_type == misc_user_event)
1677 *x = XEVENT (event)->event.misc.x;
1678 *y = XEVENT (event)->event.misc.y;
1683 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1687 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1690 return 1; /* #### What should really happen here? */
1692 *x -= w->pixel_left;
1697 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1698 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1699 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1700 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1706 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1707 Return the X 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-x-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 (x);
1724 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1725 Return the Y position in pixels of mouse event EVENT.
1726 The value returned is relative to the window 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-y-pixel'.
1734 CHECK_LIVE_EVENT (event);
1736 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1737 return wrong_type_argument (Qmouse_event_p, event);
1739 return make_int (y);
1742 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1743 Return the X 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' and `event-window-x-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 (x);
1760 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1761 Return the Y position in pixels of mouse event EVENT.
1762 The value returned is relative to the frame the event occurred in.
1763 This will signal an error if the event is not a mouse event.
1764 See also `mouse-event-p' `event-window-y-pixel'.
1770 CHECK_LIVE_EVENT (event);
1772 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1773 return wrong_type_argument (Qmouse_event_p, event);
1775 return make_int (y);
1778 /* Given an event, return a value:
1780 OVER_TOOLBAR: over one of the 4 frame toolbars
1781 OVER_MODELINE: over a modeline
1782 OVER_BORDER: over an internal border
1783 OVER_NOTHING: over the text area, but not over text
1784 OVER_OUTSIDE: outside of the frame border
1785 OVER_TEXT: over text in the text area
1786 OVER_V_DIVIDER: over windows vertical divider
1790 The X char position in CHAR_X, if not a null pointer.
1791 The Y char position in CHAR_Y, if not a null pointer.
1792 (These last two values are relative to the window the event is over.)
1793 The window it's over in W, if not a null pointer.
1794 The buffer position it's over in BUFP, if not a null pointer.
1795 The closest buffer position in CLOSEST, if not a null pointer.
1797 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1801 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1802 int *obj_x, int *obj_y,
1803 struct window **w, Bufpos *bufp, Bufpos *closest,
1804 Charcount *modeline_closest,
1805 Lisp_Object *obj1, Lisp_Object *obj2)
1812 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1813 struct window *ret_w;
1814 Bufpos ret_bufp, ret_closest;
1815 Charcount ret_modeline_closest;
1816 Lisp_Object ret_obj1, ret_obj2;
1818 CHECK_LIVE_EVENT (event);
1819 frame = XEVENT (event)->channel;
1820 switch (XEVENT (event)->event_type)
1822 case pointer_motion_event :
1823 pix_x = XEVENT (event)->event.motion.x;
1824 pix_y = XEVENT (event)->event.motion.y;
1826 case button_press_event :
1827 case button_release_event :
1828 pix_x = XEVENT (event)->event.button.x;
1829 pix_y = XEVENT (event)->event.button.y;
1831 case misc_user_event :
1832 pix_x = XEVENT (event)->event.misc.x;
1833 pix_y = XEVENT (event)->event.misc.y;
1836 dead_wrong_type_argument (Qmouse_event_p, event);
1839 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1840 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1841 &ret_w, &ret_bufp, &ret_closest,
1842 &ret_modeline_closest,
1843 &ret_obj1, &ret_obj2);
1845 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1847 else if (ret_w && NILP (ret_w->buffer))
1848 /* Why does this happen? (Does it still happen?)
1849 I guess the window has gotten reused as a non-leaf... */
1852 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1853 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1854 pointer points to random memory, often filled with 0, sometimes not.
1856 /* #### Chuck, do we still need this crap? */
1857 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1858 #ifdef HAVE_TOOLBARS
1859 || TOOLBAR_BUTTONP (ret_obj1)
1863 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1879 *closest = ret_closest;
1880 if (modeline_closest)
1881 *modeline_closest = ret_modeline_closest;
1890 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1891 Return t if the mouse event EVENT occurred over the text area of a window.
1892 The modeline is not considered to be part of the text area.
1896 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1898 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1901 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1902 Return t if the mouse event EVENT occurred over the modeline of a window.
1906 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1908 return result == OVER_MODELINE ? Qt : Qnil;
1911 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1912 Return t if the mouse event EVENT occurred over an internal border.
1916 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1918 return result == OVER_BORDER ? Qt : Qnil;
1921 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1922 Return t if the mouse event EVENT occurred over a toolbar.
1926 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1928 return result == OVER_TOOLBAR ? Qt : Qnil;
1931 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1932 Return t if the mouse event EVENT occurred over a window divider.
1936 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1938 return result == OVER_V_DIVIDER ? Qt : Qnil;
1942 event_console_or_selected (Lisp_Object event)
1944 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1945 Lisp_Object console = CDFW_CONSOLE (channel);
1948 console = Vselected_console;
1950 return XCONSOLE (console);
1953 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1954 Return the channel that the event EVENT occurred on.
1955 This will be a frame, device, console, or nil for some types
1956 of events (e.g. eval events).
1960 CHECK_LIVE_EVENT (event);
1961 return EVENT_CHANNEL (XEVENT (event));
1964 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1965 Return the window over which mouse event EVENT occurred.
1966 This may be nil if the event occurred in the border or over a toolbar.
1967 The modeline is considered to be within the window it describes.
1973 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1981 XSETWINDOW (window, w);
1986 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1987 Return the character position of the mouse event EVENT.
1988 If the event did not occur over a window, or did not occur over text,
1989 then this returns nil. Otherwise, it returns a position in the buffer
1990 visible in the event's window.
1997 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1999 return w && bufp ? make_int (bufp) : Qnil;
2002 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
2003 Return the character position closest to the mouse event EVENT.
2004 If the event did not occur over a window or over text, return the
2005 closest point to the location of the event. If the Y pixel position
2006 overlaps a window and the X pixel position is to the left of that
2007 window, the closest point is the beginning of the line containing the
2008 Y position. If the Y pixel position overlaps a window and the X pixel
2009 position is to the right of that window, the closest point is the end
2010 of the line containing the Y position. If the Y pixel position is
2011 above a window, return 0. If it is below the last character in a window,
2012 return the value of (window-end).
2018 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
2020 return bufp ? make_int (bufp) : Qnil;
2023 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
2024 Return the X position of the mouse event EVENT in characters.
2025 This is relative to the window the event occurred over.
2031 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
2033 return make_int (char_x);
2036 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
2037 Return the Y position of the mouse event EVENT in characters.
2038 This is relative to the window the event occurred over.
2044 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
2046 return make_int (char_y);
2049 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
2050 Return the character position in the modeline that EVENT occurred over.
2051 EVENT should be a mouse event. If EVENT did not occur over a modeline,
2052 nil is returned. You can determine the actual character that the
2053 event occurred over by looking in `generated-modeline-string' at the
2054 returned character position. Note that `generated-modeline-string'
2055 is buffer-local, and you must use EVENT's buffer when retrieving
2056 `generated-modeline-string' in order to get accurate results.
2063 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
2065 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
2068 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
2069 Return the glyph that the mouse event EVENT occurred over, or nil.
2076 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
2078 return w && GLYPHP (glyph) ? glyph : Qnil;
2081 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
2082 Return the extent of the glyph that the mouse event EVENT occurred over.
2083 If the event did not occur over a glyph, nil is returned.
2090 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
2092 return w && EXTENTP (extent) ? extent : Qnil;
2095 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
2096 Return the X pixel position of EVENT relative to the glyph it occurred over.
2097 EVENT should be a mouse event. If the event did not occur over a glyph,
2106 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2108 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2111 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2112 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2113 EVENT should be a mouse event. If the event did not occur over a glyph,
2122 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2124 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2127 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2128 Return the toolbar button that the mouse event EVENT occurred over.
2129 If the event did not occur over a toolbar button, nil is returned.
2133 #ifdef HAVE_TOOLBARS
2136 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2138 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2144 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2145 Return the process of the process-output event EVENT.
2149 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2150 return XEVENT (event)->event.process.process;
2153 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2154 Return the callback function of EVENT.
2155 EVENT should be a timeout, misc-user, or eval event.
2160 CHECK_LIVE_EVENT (event);
2161 switch (XEVENT (event)->event_type)
2164 return XEVENT (event)->event.timeout.function;
2165 case misc_user_event:
2166 return XEVENT (event)->event.misc.function;
2168 return XEVENT (event)->event.eval.function;
2170 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2175 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2176 Return the callback function argument of EVENT.
2177 EVENT should be a timeout, misc-user, or eval event.
2182 CHECK_LIVE_EVENT (event);
2183 switch (XEVENT (event)->event_type)
2186 return XEVENT (event)->event.timeout.object;
2187 case misc_user_event:
2188 return XEVENT (event)->event.misc.object;
2190 return XEVENT (event)->event.eval.object;
2192 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2197 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2198 Return a list of all of the properties of EVENT.
2199 This is in the form of a property list (alternating keyword/value pairs).
2203 Lisp_Object props = Qnil;
2205 struct gcpro gcpro1;
2207 CHECK_LIVE_EVENT (event);
2211 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2213 switch (e->event_type)
2218 props = cons3 (Qprocess, e->event.process.process, props);
2222 props = cons3 (Qobject, Fevent_object (event), props);
2223 props = cons3 (Qfunction, Fevent_function (event), props);
2224 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2227 case key_press_event:
2228 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2229 props = cons3 (Qkey, Fevent_key (event), props);
2232 case button_press_event:
2233 case button_release_event:
2234 props = cons3 (Qy, Fevent_y_pixel (event), props);
2235 props = cons3 (Qx, Fevent_x_pixel (event), props);
2236 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2237 props = cons3 (Qbutton, Fevent_button (event), props);
2240 case pointer_motion_event:
2241 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2242 props = cons3 (Qy, Fevent_y_pixel (event), props);
2243 props = cons3 (Qx, Fevent_x_pixel (event), props);
2246 case misc_user_event:
2247 props = cons3 (Qobject, Fevent_object (event), props);
2248 props = cons3 (Qfunction, Fevent_function (event), props);
2249 props = cons3 (Qy, Fevent_y_pixel (event), props);
2250 props = cons3 (Qx, Fevent_x_pixel (event), props);
2251 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2252 props = cons3 (Qbutton, Fevent_button (event), props);
2256 props = cons3 (Qobject, Fevent_object (event), props);
2257 props = cons3 (Qfunction, Fevent_function (event), props);
2260 case magic_eval_event:
2265 RETURN_UNGCPRO (Qnil);
2269 props = cons3 (Qchannel, Fevent_channel (event), props);
2276 /************************************************************************/
2277 /* initialization */
2278 /************************************************************************/
2281 syms_of_events (void)
2283 INIT_LRECORD_IMPLEMENTATION (event);
2285 DEFSUBR (Fcharacter_to_event);
2286 DEFSUBR (Fevent_to_character);
2288 DEFSUBR (Fmake_event);
2289 DEFSUBR (Fdeallocate_event);
2290 DEFSUBR (Fcopy_event);
2292 DEFSUBR (Fevent_live_p);
2293 DEFSUBR (Fevent_type);
2294 DEFSUBR (Fevent_properties);
2296 DEFSUBR (Fevent_timestamp);
2297 DEFSUBR (Fevent_timestamp_lessp);
2298 DEFSUBR (Fevent_key);
2299 DEFSUBR (Fevent_button);
2300 DEFSUBR (Fevent_modifier_bits);
2301 DEFSUBR (Fevent_modifiers);
2302 DEFSUBR (Fevent_x_pixel);
2303 DEFSUBR (Fevent_y_pixel);
2304 DEFSUBR (Fevent_window_x_pixel);
2305 DEFSUBR (Fevent_window_y_pixel);
2306 DEFSUBR (Fevent_over_text_area_p);
2307 DEFSUBR (Fevent_over_modeline_p);
2308 DEFSUBR (Fevent_over_border_p);
2309 DEFSUBR (Fevent_over_toolbar_p);
2310 DEFSUBR (Fevent_over_vertical_divider_p);
2311 DEFSUBR (Fevent_channel);
2312 DEFSUBR (Fevent_window);
2313 DEFSUBR (Fevent_point);
2314 DEFSUBR (Fevent_closest_point);
2317 DEFSUBR (Fevent_modeline_position);
2318 DEFSUBR (Fevent_glyph);
2319 DEFSUBR (Fevent_glyph_extent);
2320 DEFSUBR (Fevent_glyph_x_pixel);
2321 DEFSUBR (Fevent_glyph_y_pixel);
2322 DEFSUBR (Fevent_toolbar_button);
2323 DEFSUBR (Fevent_process);
2324 DEFSUBR (Fevent_function);
2325 DEFSUBR (Fevent_object);
2327 defsymbol (&Qeventp, "eventp");
2328 defsymbol (&Qevent_live_p, "event-live-p");
2329 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2330 defsymbol (&Qbutton_event_p, "button-event-p");
2331 defsymbol (&Qmouse_event_p, "mouse-event-p");
2332 defsymbol (&Qprocess_event_p, "process-event-p");
2333 defsymbol (&Qkey_press, "key-press");
2334 defsymbol (&Qbutton_press, "button-press");
2335 defsymbol (&Qbutton_release, "button-release");
2336 defsymbol (&Qmisc_user, "misc-user");
2337 defsymbol (&Qascii_character, "ascii-character");
2339 defsymbol (&QKbackspace, "backspace");
2340 defsymbol (&QKtab, "tab");
2341 defsymbol (&QKlinefeed, "linefeed");
2342 defsymbol (&QKreturn, "return");
2343 defsymbol (&QKescape, "escape");
2344 defsymbol (&QKspace, "space");
2345 defsymbol (&QKdelete, "delete");
2350 reinit_vars_of_events (void)
2352 Vevent_resource = Qnil;
2356 vars_of_events (void)
2358 reinit_vars_of_events ();
2360 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2361 A symbol used to look up the 8-bit character of a keysym.
2362 To convert a keysym symbol to an 8-bit code, as when that key is
2363 bound to self-insert-command, we will look up the property that this
2364 variable names on the property list of the keysym-symbol. The window-
2365 system-specific code will set up appropriate properties and set this
2368 Vcharacter_set_property = Qnil;