1 /* Events: printing them, converting them to and from characters.
2 Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
30 #include "console-tty.h" /* for stuff in character_to_event */
32 #include "console-x.h" /* for x_event_name prototype */
33 #include "extents.h" /* Just for the EXTENTP abort check... */
37 #include "keymap.h" /* for key_desc_list_to_event() */
38 #include "redisplay.h"
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
51 #include "events-mod.h"
53 /* Where old events go when they are explicitly deallocated.
54 The event chain here is cut loose before GC, so these will be freed
57 static Lisp_Object Vevent_resource;
60 Lisp_Object Qevent_live_p;
61 Lisp_Object Qkey_press_event_p;
62 Lisp_Object Qbutton_event_p;
63 Lisp_Object Qmouse_event_p;
64 Lisp_Object Qprocess_event_p;
66 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
67 Lisp_Object Qascii_character;
69 EXFUN (Fevent_x_pixel, 1);
70 EXFUN (Fevent_y_pixel, 1);
72 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
74 clear_event_resource (void)
76 Vevent_resource = Qnil;
79 /* Make sure we lose quickly if we try to use this event */
81 deinitialize_event (Lisp_Object ev)
84 struct Lisp_Event *event = XEVENT (ev);
86 for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++)
87 ((int *) event) [i] = 0xdeadbeef;
88 event->event_type = dead_event;
89 event->channel = Qnil;
90 set_lheader_implementation (&(event->lheader), &lrecord_event);
91 XSET_EVENT_NEXT (ev, Qnil);
94 /* Set everything to zero or nil so that it's predictable. */
96 zero_event (struct Lisp_Event *e)
99 set_lheader_implementation (&(e->lheader), &lrecord_event);
100 e->event_type = empty_event;
106 mark_event (Lisp_Object obj)
108 struct Lisp_Event *event = XEVENT (obj);
110 switch (event->event_type)
112 case key_press_event:
113 mark_object (event->event.key.keysym);
116 mark_object (event->event.process.process);
119 mark_object (event->event.timeout.function);
120 mark_object (event->event.timeout.object);
123 case misc_user_event:
124 mark_object (event->event.eval.function);
125 mark_object (event->event.eval.object);
127 case magic_eval_event:
128 mark_object (event->event.magic_eval.object);
130 case button_press_event:
131 case button_release_event:
132 case pointer_motion_event:
140 mark_object (event->channel);
145 print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun)
148 write_c_string (str, printcharfun);
149 format_event_object (buf, XEVENT (obj), 0);
150 write_c_string (buf, printcharfun);
154 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
157 error ("Printing unreadable object #<event>");
159 switch (XEVENT (obj)->event_type)
161 case key_press_event:
162 print_event_1 ("#<keypress-event ", obj, printcharfun);
164 case button_press_event:
165 print_event_1 ("#<buttondown-event ", obj, printcharfun);
167 case button_release_event:
168 print_event_1 ("#<buttonup-event ", obj, printcharfun);
171 case magic_eval_event:
172 print_event_1 ("#<magic-event ", obj, printcharfun);
174 case pointer_motion_event:
178 Vx = Fevent_x_pixel (obj);
180 Vy = Fevent_y_pixel (obj);
182 sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
183 write_c_string (buf, printcharfun);
187 write_c_string ("#<process-event ", printcharfun);
188 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
191 write_c_string ("#<timeout-event ", printcharfun);
192 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
195 write_c_string ("#<empty-event", printcharfun);
197 case misc_user_event:
198 write_c_string ("#<misc-user-event (", printcharfun);
199 print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
200 write_c_string (" ", printcharfun);
201 print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
202 write_c_string (")", printcharfun);
205 write_c_string ("#<eval-event (", printcharfun);
206 print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
207 write_c_string (" ", printcharfun);
208 print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
209 write_c_string (")", printcharfun);
212 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
215 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
218 write_c_string (">", printcharfun);
222 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
224 struct Lisp_Event *e1 = XEVENT (obj1);
225 struct Lisp_Event *e2 = XEVENT (obj2);
227 if (e1->event_type != e2->event_type) return 0;
228 if (!EQ (e1->channel, e2->channel)) return 0;
229 /* if (e1->timestamp != e2->timestamp) return 0; */
230 switch (e1->event_type)
235 return EQ (e1->event.process.process, e2->event.process.process);
238 return (internal_equal (e1->event.timeout.function,
239 e2->event.timeout.function, 0) &&
240 internal_equal (e1->event.timeout.object,
241 e2->event.timeout.object, 0));
243 case key_press_event:
244 return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
245 (e1->event.key.modifiers == e2->event.key.modifiers));
247 case button_press_event:
248 case button_release_event:
249 return (e1->event.button.button == e2->event.button.button &&
250 e1->event.button.modifiers == e2->event.button.modifiers);
252 case pointer_motion_event:
253 return (e1->event.motion.x == e2->event.motion.x &&
254 e1->event.motion.y == e2->event.motion.y);
256 case misc_user_event:
257 return (internal_equal (e1->event.eval.function,
258 e2->event.eval.function, 0) &&
259 internal_equal (e1->event.eval.object,
260 e2->event.eval.object, 0) &&
261 /* is this really needed for equality
262 or is x and y also important? */
263 e1->event.misc.button == e2->event.misc.button &&
264 e1->event.misc.modifiers == e2->event.misc.modifiers);
267 return (internal_equal (e1->event.eval.function,
268 e2->event.eval.function, 0) &&
269 internal_equal (e1->event.eval.object,
270 e2->event.eval.object, 0));
272 case magic_eval_event:
273 return (e1->event.magic_eval.internal_function ==
274 e2->event.magic_eval.internal_function &&
275 internal_equal (e1->event.magic_eval.object,
276 e2->event.magic_eval.object, 0));
280 struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
282 #ifdef HAVE_X_WINDOWS
283 if (CONSOLE_X_P (con))
284 return (e1->event.magic.underlying_x_event.xany.serial ==
285 e2->event.magic.underlying_x_event.xany.serial);
288 if (CONSOLE_TTY_P (con))
289 return (e1->event.magic.underlying_tty_event ==
290 e2->event.magic.underlying_tty_event);
292 #ifdef HAVE_MS_WINDOWS
293 if (CONSOLE_MSWINDOWS_P (con))
294 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
295 &e2->event.magic.underlying_mswindows_event,
296 sizeof(union magic_data)));
298 return 1; /* not reached */
301 case empty_event: /* Empty and deallocated events are equal. */
308 event_hash (Lisp_Object obj, int depth)
310 struct Lisp_Event *e = XEVENT (obj);
313 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
314 switch (e->event_type)
317 return HASH2 (hash, LISP_HASH (e->event.process.process));
320 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
321 internal_hash (e->event.timeout.object, depth + 1));
323 case key_press_event:
324 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
325 e->event.key.modifiers);
327 case button_press_event:
328 case button_release_event:
329 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
331 case pointer_motion_event:
332 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
334 case misc_user_event:
335 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
336 internal_hash (e->event.misc.object, depth + 1),
337 e->event.misc.button, e->event.misc.modifiers);
340 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
341 internal_hash (e->event.eval.object, depth + 1));
343 case magic_eval_event:
345 (unsigned long) e->event.magic_eval.internal_function,
346 internal_hash (e->event.magic_eval.object, depth + 1));
350 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
351 #ifdef HAVE_X_WINDOWS
352 if (CONSOLE_X_P (con))
353 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
356 if (CONSOLE_TTY_P (con))
357 return HASH2 (hash, e->event.magic.underlying_tty_event);
359 #ifdef HAVE_MS_WINDOWS
360 if (CONSOLE_MSWINDOWS_P (con))
361 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
373 return 0; /* unreached */
376 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
377 mark_event, print_event, 0, event_equal,
378 event_hash, 0, struct Lisp_Event);
381 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
382 Return a new event of type TYPE, with properties described by PLIST.
384 TYPE is a symbol, either `empty', `key-press', `button-press',
385 `button-release', `misc-user' or `motion'. If TYPE is nil, it
388 PLIST is a property list, the properties being compatible to those
389 returned by `event-properties'. The following properties are
392 channel -- The event channel, a frame or a console. For
393 button-press, button-release, misc-user and motion events,
394 this must be a frame. For key-press events, it must be
395 a console. If channel is unspecified, it will be set to
396 the selected frame or selected console, as appropriate.
397 key -- The event key, a symbol or character. Allowed only for
399 button -- The event button, integer 1, 2 or 3. Allowed for
400 button-press, button-release and misc-user events.
401 modifiers -- The event modifiers, a list of modifier symbols. Allowed
402 for key-press, button-press, button-release, motion and
404 function -- Function. Allowed for misc-user events only.
405 object -- An object, function's parameter. Allowed for misc-user
407 x -- The event X coordinate, an integer. This is relative
408 to the left of CHANNEL's root window. Allowed for
409 motion, button-press, button-release and misc-user events.
410 y -- The event Y coordinate, an integer. This is relative
411 to the top of CHANNEL's root window. Allowed for
412 motion, button-press, button-release and misc-user events.
413 timestamp -- The event timestamp, a non-negative integer. Allowed for
414 all types of events. If unspecified, it will be set to 0
417 For event type `empty', PLIST must be nil.
418 `button-release', or `motion'. If TYPE is left out, it defaults to
420 PLIST is a list of properties, as returned by `event-properties'. Not
421 all properties are allowed for all kinds of events, and some are
424 WARNING: the event object returned may be a reused one; see the function
429 Lisp_Object tail, keyword, value;
430 Lisp_Object event = Qnil;
431 struct Lisp_Event *e;
432 EMACS_INT coord_x = 0, coord_y = 0;
440 if (!NILP (Vevent_resource))
442 event = Vevent_resource;
443 Vevent_resource = XEVENT_NEXT (event);
447 event = allocate_event ();
452 if (EQ (type, Qempty))
454 /* For empty event, we return immediately, without processing
455 PLIST. In fact, processing PLIST would be wrong, because the
456 sanitizing process would fill in the properties
457 (e.g. CHANNEL), which we don't want in empty events. */
458 e->event_type = empty_event;
460 error ("Cannot set properties of empty event");
464 else if (EQ (type, Qkey_press))
466 e->event_type = key_press_event;
467 e->event.key.keysym = Qunbound;
469 else if (EQ (type, Qbutton_press))
470 e->event_type = button_press_event;
471 else if (EQ (type, Qbutton_release))
472 e->event_type = button_release_event;
473 else if (EQ (type, Qmotion))
474 e->event_type = pointer_motion_event;
475 else if (EQ (type, Qmisc_user))
477 e->event_type = misc_user_event;
478 e->event.eval.function = e->event.eval.object = Qnil;
482 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
483 signal_simple_error ("Invalid event type", type);
486 EVENT_CHANNEL (e) = Qnil;
488 plist = Fcopy_sequence (plist);
489 Fcanonicalize_plist (plist, Qnil);
491 #define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \
492 error_with_frob (prop, "Invalid property for %s event", \
493 string_data (symbol_name (XSYMBOL (type))))
495 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist)
497 if (EQ (keyword, Qchannel))
499 if (e->event_type == key_press_event)
501 if (!CONSOLEP (value))
502 value = wrong_type_argument (Qconsolep, value);
507 value = wrong_type_argument (Qframep, value);
509 EVENT_CHANNEL (e) = value;
511 else if (EQ (keyword, Qkey))
513 switch (e->event_type)
515 case key_press_event:
516 if (!SYMBOLP (value) && !CHARP (value))
517 signal_simple_error ("Invalid event key", value);
518 e->event.key.keysym = value;
521 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
525 else if (EQ (keyword, Qbutton))
527 CHECK_NATNUM (value);
528 check_int_range (XINT (value), 0, 7);
530 switch (e->event_type)
532 case button_press_event:
533 case button_release_event:
534 e->event.button.button = XINT (value);
536 case misc_user_event:
537 e->event.misc.button = XINT (value);
540 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
544 else if (EQ (keyword, Qmodifiers))
549 EXTERNAL_LIST_LOOP_2 (sym, value)
551 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL;
552 else if (EQ (sym, Qmeta)) modifiers |= MOD_META;
553 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER;
554 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER;
555 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT;
556 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT;
557 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT;
559 signal_simple_error ("Invalid key modifier", sym);
562 switch (e->event_type)
564 case key_press_event:
565 e->event.key.modifiers = modifiers;
567 case button_press_event:
568 case button_release_event:
569 e->event.button.modifiers = modifiers;
571 case pointer_motion_event:
572 e->event.motion.modifiers = modifiers;
574 case misc_user_event:
575 e->event.misc.modifiers = modifiers;
578 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
582 else if (EQ (keyword, Qx))
584 switch (e->event_type)
586 case pointer_motion_event:
587 case button_press_event:
588 case button_release_event:
589 case misc_user_event:
590 /* Allow negative values, so we can specify toolbar
593 coord_x = XINT (value);
596 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
600 else if (EQ (keyword, Qy))
602 switch (e->event_type)
604 case pointer_motion_event:
605 case button_press_event:
606 case button_release_event:
607 case misc_user_event:
608 /* Allow negative values; see above. */
610 coord_y = XINT (value);
613 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
617 else if (EQ (keyword, Qtimestamp))
619 CHECK_NATNUM (value);
620 e->timestamp = XINT (value);
622 else if (EQ (keyword, Qfunction))
624 switch (e->event_type)
626 case misc_user_event:
627 e->event.eval.function = value;
630 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
634 else if (EQ (keyword, Qobject))
636 switch (e->event_type)
638 case misc_user_event:
639 e->event.eval.object = value;
642 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
647 signal_simple_error_2 ("Invalid property", keyword, value);
650 /* Insert the channel, if missing. */
651 if (NILP (EVENT_CHANNEL (e)))
653 if (e->event_type == key_press_event)
654 EVENT_CHANNEL (e) = Vselected_console;
656 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
659 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
660 to the frame, so we must adjust accordingly. */
661 if (FRAMEP (EVENT_CHANNEL (e)))
663 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
664 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
666 switch (e->event_type)
668 case pointer_motion_event:
669 e->event.motion.x = coord_x;
670 e->event.motion.y = coord_y;
672 case button_press_event:
673 case button_release_event:
674 e->event.button.x = coord_x;
675 e->event.button.y = coord_y;
677 case misc_user_event:
678 e->event.misc.x = coord_x;
679 e->event.misc.y = coord_y;
686 /* Finally, do some more validation. */
687 switch (e->event_type)
689 case key_press_event:
690 if (UNBOUNDP (e->event.key.keysym))
691 error ("A key must be specified to make a keypress event");
693 case button_press_event:
694 if (!e->event.button.button)
695 error ("A button must be specified to make a button-press event");
697 case button_release_event:
698 if (!e->event.button.button)
699 error ("A button must be specified to make a button-release event");
701 case misc_user_event:
702 if (NILP (e->event.misc.function))
703 error ("A function must be specified to make a misc-user event");
713 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
714 Allow the given event structure to be reused.
715 You MUST NOT use this event object after calling this function with it.
716 You will lose. It is not necessary to call this function, as event
717 objects are garbage-collected like all other objects; however, it may
718 be more efficient to explicitly deallocate events when you are sure
719 that it is safe to do so.
725 if (XEVENT_TYPE (event) == dead_event)
726 error ("this event is already deallocated!");
728 assert (XEVENT_TYPE (event) <= last_event_type);
734 if (EQ (event, Vlast_command_event) ||
735 EQ (event, Vlast_input_event) ||
736 EQ (event, Vunread_command_event))
739 len = XVECTOR_LENGTH (Vthis_command_keys);
740 for (i = 0; i < len; i++)
741 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
743 if (!NILP (Vrecent_keys_ring))
745 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
746 for (i = 0; i < recent_ring_len; i++)
747 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
753 assert (!EQ (event, Vevent_resource));
754 deinitialize_event (event);
755 #ifndef ALLOC_NO_POOLS
756 XSET_EVENT_NEXT (event, Vevent_resource);
757 Vevent_resource = event;
762 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
763 Make a copy of the given event object.
764 If a second argument is given, the first event is copied into the second
765 and the second is returned. If the second argument is not supplied (or
766 is nil) then a new event will be made as with `make-event'. See also
767 the function `deallocate-event'.
771 CHECK_LIVE_EVENT (event1);
773 event2 = Fmake_event (Qnil, Qnil);
776 CHECK_LIVE_EVENT (event2);
777 if (EQ (event1, event2))
778 return signal_simple_continuable_error_2
779 ("copy-event called with `eq' events", event1, event2);
782 assert (XEVENT_TYPE (event1) <= last_event_type);
783 assert (XEVENT_TYPE (event2) <= last_event_type);
786 Lisp_Event *ev2 = XEVENT (event2);
787 Lisp_Event *ev1 = XEVENT (event1);
789 ev2->event_type = ev1->event_type;
790 ev2->channel = ev1->channel;
791 ev2->timestamp = ev1->timestamp;
792 ev2->event = ev1->event;
800 /* Given a chain of events (or possibly nil), deallocate them all. */
803 deallocate_event_chain (Lisp_Object event_chain)
805 while (!NILP (event_chain))
807 Lisp_Object next = XEVENT_NEXT (event_chain);
808 Fdeallocate_event (event_chain);
813 /* Return the last event in a chain.
814 NOTE: You cannot pass nil as a value here! The routine will
818 event_chain_tail (Lisp_Object event_chain)
822 Lisp_Object next = XEVENT_NEXT (event_chain);
829 /* Enqueue a single event onto the end of a chain of events.
830 HEAD points to the first event in the chain, TAIL to the last event.
831 If the chain is empty, both values should be nil. */
834 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
836 assert (NILP (XEVENT_NEXT (event)));
837 assert (!EQ (*tail, event));
840 XSET_EVENT_NEXT (*tail, event);
845 assert (!EQ (event, XEVENT_NEXT (event)));
848 /* Remove an event off the head of a chain of events and return it.
849 HEAD points to the first event in the chain, TAIL to the last event. */
852 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
857 *head = XEVENT_NEXT (event);
858 XSET_EVENT_NEXT (event, Qnil);
864 /* Enqueue a chain of events (or possibly nil) onto the end of another
865 chain of events. HEAD points to the first event in the chain being
866 queued onto, TAIL to the last event. If the chain is empty, both values
870 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
873 if (NILP (event_chain))
883 XSET_EVENT_NEXT (*tail, event_chain);
884 *tail = event_chain_tail (event_chain);
888 /* Return the number of events (possibly 0) on an event chain. */
891 event_chain_count (Lisp_Object event_chain)
896 EVENT_CHAIN_LOOP (event, event_chain)
902 /* Find the event before EVENT in an event chain. This aborts
903 if the event is not in the chain. */
906 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
908 Lisp_Object previous = Qnil;
910 while (!NILP (event_chain))
912 if (EQ (event_chain, event))
914 previous = event_chain;
915 event_chain = XEVENT_NEXT (event_chain);
923 event_chain_nth (Lisp_Object event_chain, int n)
926 EVENT_CHAIN_LOOP (event, event_chain)
936 copy_event_chain (Lisp_Object event_chain)
938 Lisp_Object new_chain = Qnil;
939 Lisp_Object new_chain_tail = Qnil;
942 EVENT_CHAIN_LOOP (event, event_chain)
944 Lisp_Object copy = Fcopy_event (event, Qnil);
945 enqueue_event (copy, &new_chain, &new_chain_tail);
953 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
957 command_event_p (Lisp_Object event)
959 switch (XEVENT_TYPE (event))
961 case key_press_event:
962 case button_press_event:
963 case button_release_event:
964 case misc_user_event:
973 character_to_event (Emchar c, struct Lisp_Event *event, struct console *con,
974 int use_console_meta_flag, int do_backspace_mapping)
976 Lisp_Object k = Qnil;
978 if (event->event_type == dead_event)
979 error ("character-to-event called with a deallocated event!");
984 if (c > 127 && c <= 255)
987 if (use_console_meta_flag && CONSOLE_TTY_P (con))
988 meta_flag = TTY_FLAGS (con).meta_key;
991 case 0: /* ignore top bit; it's parity */
994 case 1: /* top bit is meta */
998 default: /* this is a real character */
1002 if (c < ' ') c += '@', m |= MOD_CONTROL;
1003 if (m & MOD_CONTROL)
1007 case 'I': k = QKtab; m &= ~MOD_CONTROL; break;
1008 case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break;
1009 case 'M': k = QKreturn; m &= ~MOD_CONTROL; break;
1010 case '[': k = QKescape; m &= ~MOD_CONTROL; break;
1012 #if defined(HAVE_TTY)
1013 if (do_backspace_mapping &&
1014 CHARP (con->tty_erase_char) &&
1015 c - '@' == XCHAR (con->tty_erase_char))
1020 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1023 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1025 #if defined(HAVE_TTY)
1026 else if (do_backspace_mapping &&
1027 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1029 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1035 event->event_type = key_press_event;
1036 event->timestamp = 0; /* #### */
1037 event->channel = make_console (con);
1038 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1039 event->event.key.modifiers = m;
1043 /* This variable controls what character name -> character code mapping
1044 we are using. Window-system-specific code sets this to some symbol,
1045 and we use that symbol as the plist key to convert keysyms into 8-bit
1046 codes. In this way one can have several character sets predefined and
1047 switch them by changing this.
1049 Lisp_Object Vcharacter_set_property;
1052 event_to_character (struct Lisp_Event *event,
1053 int allow_extra_modifiers,
1055 int allow_non_ascii)
1060 if (event->event_type != key_press_event)
1062 if (event->event_type == dead_event) abort ();
1065 if (!allow_extra_modifiers &&
1066 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
1068 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1069 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1070 else if (!SYMBOLP (event->event.key.keysym))
1072 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1073 /* Allow window-system-specific extensibility of
1074 keysym->code mapping */
1075 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1076 Vcharacter_set_property,
1078 c = XCHAR_OR_CHAR_INT (code);
1079 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1080 Qascii_character, Qnil)))
1081 c = XCHAR_OR_CHAR_INT (code);
1085 if (event->event.key.modifiers & MOD_CONTROL)
1087 if (c >= 'a' && c <= 'z')
1090 /* reject Control-Shift- keys */
1091 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1094 if (c >= '@' && c <= '_')
1096 else if (c == ' ') /* C-space and C-@ are the same. */
1099 /* reject keys that can't take Control- modifiers */
1100 if (! allow_extra_modifiers) return -1;
1103 if (event->event.key.modifiers & MOD_META)
1105 if (! allow_meta) return -1;
1106 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1108 if (c >= 256) return -1;
1115 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1116 Return the closest ASCII approximation to the given event object.
1117 If the event isn't a keypress, this returns nil.
1118 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1119 its translation; it will ignore modifier keys other than control and meta,
1120 and will ignore the shift modifier on those characters which have no
1121 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1122 the same ASCII code as Control-A).
1123 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1124 represented by turning on the high bit of the byte returned; otherwise, nil
1125 will be returned for events containing the Meta modifier.
1126 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1127 present in the prevailing character set (see the `character-set-property'
1128 variable) will be returned as their code in that character set, instead of
1129 the return value being restricted to ASCII.
1130 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1131 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1133 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1136 CHECK_LIVE_EVENT (event);
1137 c = event_to_character (XEVENT (event),
1138 !NILP (allow_extra_modifiers),
1140 !NILP (allow_non_ascii));
1141 return c < 0 ? Qnil : make_char (c);
1144 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1145 Convert keystroke CH into an event structure ,replete with bucky bits.
1146 The keystroke is the first argument, and the event to fill
1147 in is the second. This function contains knowledge about what the codes
1148 ``mean'' -- for example, the number 9 is converted to the character ``Tab'',
1149 not the distinct character ``Control-I''.
1151 Note that CH (the keystroke specifier) can be an integer, a character,
1152 a symbol such as 'clear, or a list such as '(control backspace).
1154 If the optional second argument is an event, it is modified;
1155 otherwise, a new event object is created.
1157 Optional third arg CONSOLE is the console to store in the event, and
1158 defaults to the selected console.
1160 If CH is an integer or character, the high bit may be interpreted as the
1161 meta key. (This is done for backward compatibility in lots of places.)
1162 If USE-CONSOLE-META-FLAG is nil, this will always be the case. If
1163 USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects
1164 whether the high bit is interpreted as a meta key. (See `set-input-mode'.)
1165 If you don't want this silly meta interpretation done, you should pass
1166 in a list containing the character.
1168 Beware that character-to-event and event-to-character are not strictly
1169 inverse functions, since events contain much more information than the
1170 ASCII character set can encode.
1172 (ch, event, console, use_console_meta_flag))
1174 struct console *con = decode_console (console);
1176 event = Fmake_event (Qnil, Qnil);
1178 CHECK_LIVE_EVENT (event);
1179 if (CONSP (ch) || SYMBOLP (ch))
1180 key_desc_list_to_event (ch, event, 1);
1183 CHECK_CHAR_COERCE_INT (ch);
1184 character_to_event (XCHAR (ch), XEVENT (event), con,
1185 !NILP (use_console_meta_flag), 1);
1191 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1193 assert (STRINGP (seq) || VECTORP (seq));
1194 assert (n < XINT (Flength (seq)));
1198 Emchar ch = string_char (XSTRING (seq), n);
1199 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1203 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1204 if (EVENTP (keystroke))
1205 Fcopy_event (keystroke, event);
1207 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1212 key_sequence_to_event_chain (Lisp_Object seq)
1214 int len = XINT (Flength (seq));
1216 Lisp_Object head = Qnil, tail = Qnil;
1218 for (i = 0; i < len; i++)
1220 Lisp_Object event = Fmake_event (Qnil, Qnil);
1221 nth_of_key_sequence_as_event (seq, i, event);
1222 enqueue_event (event, &head, &tail);
1229 format_event_object (char *buf, struct Lisp_Event *event, int brief)
1235 switch (event->event_type)
1237 case key_press_event:
1239 mod = event->event.key.modifiers;
1240 key = event->event.key.keysym;
1242 if (! brief && CHARP (key) &&
1243 mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER))
1245 int k = XCHAR (key);
1246 if (k >= 'a' && k <= 'z')
1247 key = make_char (k - ('a' - 'A'));
1248 else if (k >= 'A' && k <= 'Z')
1253 case button_release_event:
1256 case button_press_event:
1259 mod = event->event.button.modifiers;
1260 key = make_char (event->event.button.button + '0');
1265 CONST char *name = NULL;
1267 #ifdef HAVE_X_WINDOWS
1269 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1270 if (CONSOLE_X_P (XCONSOLE (console)))
1271 name = x_event_name (event->event.magic.underlying_x_event.type);
1273 #endif /* HAVE_X_WINDOWS */
1274 if (name) strcpy (buf, name);
1275 else strcpy (buf, "???");
1278 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1279 case pointer_motion_event: strcpy (buf, "motion"); return;
1280 case misc_user_event: strcpy (buf, "misc-user"); return;
1281 case eval_event: strcpy (buf, "eval"); return;
1282 case process_event: strcpy (buf, "process"); return;
1283 case timeout_event: strcpy (buf, "timeout"); return;
1284 case empty_event: strcpy (buf, "empty"); return;
1285 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1289 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1290 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1291 if (mod & MOD_CONTROL) modprint ("control-", "C-");
1292 if (mod & MOD_META) modprint ("meta-", "M-");
1293 if (mod & MOD_SUPER) modprint ("super-", "S-");
1294 if (mod & MOD_HYPER) modprint ("hyper-", "H-");
1295 if (mod & MOD_ALT) modprint ("alt-", "A-");
1296 if (mod & MOD_SHIFT) modprint ("shift-", "Sh-");
1299 modprint1 ("button");
1308 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1311 else if (SYMBOLP (key))
1313 CONST char *str = 0;
1316 if (EQ (key, QKlinefeed)) str = "LFD";
1317 else if (EQ (key, QKtab)) str = "TAB";
1318 else if (EQ (key, QKreturn)) str = "RET";
1319 else if (EQ (key, QKescape)) str = "ESC";
1320 else if (EQ (key, QKdelete)) str = "DEL";
1321 else if (EQ (key, QKspace)) str = "SPC";
1322 else if (EQ (key, QKbackspace)) str = "BS";
1326 int i = strlen (str);
1327 memcpy (buf, str, i+1);
1332 struct Lisp_String *name = XSYMBOL (key)->name;
1333 memcpy (buf, string_data (name), string_length (name) + 1);
1334 str += string_length (name);
1340 strncpy (buf, "up", 4);
1343 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1344 True if OBJECT is an event object.
1348 return EVENTP (object) ? Qt : Qnil;
1351 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1352 True if OBJECT is an event object that has not been deallocated.
1356 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1360 #if 0 /* debugging functions */
1362 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1363 Return the event object's `next' event, or nil if it has none.
1364 The `next-event' field is changed by calling `set-next-event'.
1368 struct Lisp_Event *e;
1369 CHECK_LIVE_EVENT (event);
1371 return XEVENT_NEXT (event);
1374 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1375 Set the `next event' of EVENT to NEXT-EVENT.
1376 NEXT-EVENT must be an event object or nil.
1378 (event, next_event))
1382 CHECK_LIVE_EVENT (event);
1383 if (NILP (next_event))
1385 XSET_EVENT_NEXT (event, Qnil);
1389 CHECK_LIVE_EVENT (next_event);
1391 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1395 signal_error (Qerror,
1396 list3 (build_string ("Cyclic event-next"),
1400 XSET_EVENT_NEXT (event, next_event);
1406 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1407 Return the type of EVENT.
1408 This will be a symbol; one of
1410 key-press A key was pressed.
1411 button-press A mouse button was pressed.
1412 button-release A mouse button was released.
1413 misc-user Some other user action happened; typically, this is
1414 a menu selection or scrollbar action.
1415 motion The mouse moved.
1416 process Input is available from a subprocess.
1417 timeout A timeout has expired.
1418 eval This causes a specified action to occur when dispatched.
1419 magic Some window-system-specific event has occurred.
1420 empty The event has been allocated but not assigned.
1425 CHECK_LIVE_EVENT (event);
1426 switch (XEVENT (event)->event_type)
1428 case key_press_event: return Qkey_press;
1429 case button_press_event: return Qbutton_press;
1430 case button_release_event: return Qbutton_release;
1431 case misc_user_event: return Qmisc_user;
1432 case pointer_motion_event: return Qmotion;
1433 case process_event: return Qprocess;
1434 case timeout_event: return Qtimeout;
1435 case eval_event: return Qeval;
1437 case magic_eval_event:
1449 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1450 Return the timestamp of the event object EVENT.
1454 CHECK_LIVE_EVENT (event);
1455 /* This junk is so that timestamps don't get to be negative, but contain
1456 as many bits as this particular emacs will allow.
1458 return make_int (((1L << (VALBITS - 1)) - 1) &
1459 XEVENT (event)->timestamp);
1462 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1463 CHECK_LIVE_EVENT (e); \
1464 if (XEVENT(e)->event_type != (t1)) \
1465 e = wrong_type_argument (sym,e); \
1468 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1469 CHECK_LIVE_EVENT (e); \
1471 emacs_event_type CET_type = XEVENT (e)->event_type; \
1472 if (CET_type != (t1) && \
1474 e = wrong_type_argument (sym,e); \
1478 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1479 CHECK_LIVE_EVENT (e); \
1481 emacs_event_type CET_type = XEVENT (e)->event_type; \
1482 if (CET_type != (t1) && \
1483 CET_type != (t2) && \
1485 e = wrong_type_argument (sym,e); \
1489 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1490 Return the Keysym of the key-press event EVENT.
1491 This will be a character if the event is associated with one, else a symbol.
1495 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1496 return XEVENT (event)->event.key.keysym;
1499 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1500 Return the button-number of the given button-press or button-release event.
1505 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1506 misc_user_event, Qbutton_event_p);
1507 #ifdef HAVE_WINDOW_SYSTEM
1508 if ( XEVENT (event)->event_type == misc_user_event)
1509 return make_int (XEVENT (event)->event.misc.button);
1511 return make_int (XEVENT (event)->event.button.button);
1512 #else /* !HAVE_WINDOW_SYSTEM */
1514 #endif /* !HAVE_WINDOW_SYSTEM */
1518 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1519 Return a number representing the modifier keys which were down
1520 when the given mouse or keyboard event was produced.
1521 See also the function event-modifiers.
1526 CHECK_LIVE_EVENT (event);
1527 switch (XEVENT (event)->event_type)
1529 case key_press_event:
1530 return make_int (XEVENT (event)->event.key.modifiers);
1531 case button_press_event:
1532 case button_release_event:
1533 return make_int (XEVENT (event)->event.button.modifiers);
1534 case pointer_motion_event:
1535 return make_int (XEVENT (event)->event.motion.modifiers);
1536 case misc_user_event:
1537 return make_int (XEVENT (event)->event.misc.modifiers);
1539 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1544 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1545 Return a list of symbols, the names of the modifier keys
1546 which were down when the given mouse or keyboard event was produced.
1547 See also the function event-modifier-bits.
1551 int mod = XINT (Fevent_modifier_bits (event));
1552 Lisp_Object result = Qnil;
1553 if (mod & MOD_SHIFT) result = Fcons (Qshift, result);
1554 if (mod & MOD_ALT) result = Fcons (Qalt, result);
1555 if (mod & MOD_HYPER) result = Fcons (Qhyper, result);
1556 if (mod & MOD_SUPER) result = Fcons (Qsuper, result);
1557 if (mod & MOD_META) result = Fcons (Qmeta, result);
1558 if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result);
1563 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1568 if (XEVENT (event)->event_type == pointer_motion_event)
1570 *x = XEVENT (event)->event.motion.x;
1571 *y = XEVENT (event)->event.motion.y;
1573 else if (XEVENT (event)->event_type == button_press_event ||
1574 XEVENT (event)->event_type == button_release_event)
1576 *x = XEVENT (event)->event.button.x;
1577 *y = XEVENT (event)->event.button.y;
1579 else if (XEVENT (event)->event_type == misc_user_event)
1581 *x = XEVENT (event)->event.misc.x;
1582 *y = XEVENT (event)->event.misc.y;
1587 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1591 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1594 return 1; /* #### What should really happen here. */
1596 *x -= w->pixel_left;
1601 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1602 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1603 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1604 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1610 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1611 Return the X position in pixels of mouse event EVENT.
1612 The value returned is relative to the window the event occurred in.
1613 This will signal an error if the event is not a mouse event.
1614 See also `mouse-event-p' and `event-x-pixel'.
1620 CHECK_LIVE_EVENT (event);
1622 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1623 return wrong_type_argument (Qmouse_event_p, event);
1625 return make_int (x);
1628 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1629 Return the Y position in pixels of mouse event EVENT.
1630 The value returned is relative to the window the event occurred in.
1631 This will signal an error if the event is not a mouse event.
1632 See also `mouse-event-p' and `event-y-pixel'.
1638 CHECK_LIVE_EVENT (event);
1640 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1641 return wrong_type_argument (Qmouse_event_p, event);
1643 return make_int (y);
1646 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1647 Return the X position in pixels of mouse event EVENT.
1648 The value returned is relative to the frame the event occurred in.
1649 This will signal an error if the event is not a mouse event.
1650 See also `mouse-event-p' and `event-window-x-pixel'.
1656 CHECK_LIVE_EVENT (event);
1658 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1659 return wrong_type_argument (Qmouse_event_p, event);
1661 return make_int (x);
1664 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1665 Return the Y position in pixels of mouse event EVENT.
1666 The value returned is relative to the frame the event occurred in.
1667 This will signal an error if the event is not a mouse event.
1668 See also `mouse-event-p' `event-window-y-pixel'.
1674 CHECK_LIVE_EVENT (event);
1676 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1677 return wrong_type_argument (Qmouse_event_p, event);
1679 return make_int (y);
1682 /* Given an event, return a value:
1684 OVER_TOOLBAR: over one of the 4 frame toolbars
1685 OVER_MODELINE: over a modeline
1686 OVER_BORDER: over an internal border
1687 OVER_NOTHING: over the text area, but not over text
1688 OVER_OUTSIDE: outside of the frame border
1689 OVER_TEXT: over text in the text area
1690 OVER_V_DIVIDER: over windows vertical divider
1694 The X char position in CHAR_X, if not a null pointer.
1695 The Y char position in CHAR_Y, if not a null pointer.
1696 (These last two values are relative to the window the event is over.)
1697 The window it's over in W, if not a null pointer.
1698 The buffer position it's over in BUFP, if not a null pointer.
1699 The closest buffer position in CLOSEST, if not a null pointer.
1701 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1705 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1706 int *obj_x, int *obj_y,
1707 struct window **w, Bufpos *bufp, Bufpos *closest,
1708 Charcount *modeline_closest,
1709 Lisp_Object *obj1, Lisp_Object *obj2)
1716 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1717 struct window *ret_w;
1718 Bufpos ret_bufp, ret_closest;
1719 Charcount ret_modeline_closest;
1720 Lisp_Object ret_obj1, ret_obj2;
1722 CHECK_LIVE_EVENT (event);
1723 frame = XEVENT (event)->channel;
1724 switch (XEVENT (event)->event_type)
1726 case pointer_motion_event :
1727 pix_x = XEVENT (event)->event.motion.x;
1728 pix_y = XEVENT (event)->event.motion.y;
1730 case button_press_event :
1731 case button_release_event :
1732 pix_x = XEVENT (event)->event.button.x;
1733 pix_y = XEVENT (event)->event.button.y;
1735 case misc_user_event :
1736 pix_x = XEVENT (event)->event.misc.x;
1737 pix_y = XEVENT (event)->event.misc.y;
1740 dead_wrong_type_argument (Qmouse_event_p, event);
1743 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1744 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1745 &ret_w, &ret_bufp, &ret_closest,
1746 &ret_modeline_closest,
1747 &ret_obj1, &ret_obj2);
1749 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1751 else if (ret_w && NILP (ret_w->buffer))
1752 /* Why does this happen? (Does it still happen?)
1753 I guess the window has gotten reused as a non-leaf... */
1756 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1757 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1758 pointer points to random memory, often filled with 0, sometimes not.
1760 /* #### Chuck, do we still need this crap? */
1761 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1762 #ifdef HAVE_TOOLBARS
1763 || TOOLBAR_BUTTONP (ret_obj1)
1767 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1783 *closest = ret_closest;
1784 if (modeline_closest)
1785 *modeline_closest = ret_modeline_closest;
1794 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1795 Return t if the mouse event EVENT occurred over the text area of a window.
1796 The modeline is not considered to be part of the text area.
1800 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1802 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1805 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1806 Return t if the mouse event EVENT occurred over the modeline of a window.
1810 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1812 return result == OVER_MODELINE ? Qt : Qnil;
1815 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1816 Return t if the mouse event EVENT occurred over an internal border.
1820 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1822 return result == OVER_BORDER ? Qt : Qnil;
1825 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1826 Return t if the mouse event EVENT occurred over a toolbar.
1830 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1832 return result == OVER_TOOLBAR ? Qt : Qnil;
1835 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1836 Return t if the mouse event EVENT occurred over a window divider.
1840 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1842 return result == OVER_V_DIVIDER ? Qt : Qnil;
1846 event_console_or_selected (Lisp_Object event)
1848 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1849 Lisp_Object console = CDFW_CONSOLE (channel);
1852 console = Vselected_console;
1854 return XCONSOLE (console);
1857 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1858 Return the channel that the event EVENT occurred on.
1859 This will be a frame, device, console, or nil for some types
1860 of events (e.g. eval events).
1864 CHECK_LIVE_EVENT (event);
1865 return EVENT_CHANNEL (XEVENT (event));
1868 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1869 Return the window over which mouse event EVENT occurred.
1870 This may be nil if the event occurred in the border or over a toolbar.
1871 The modeline is considered to be within the window it describes.
1877 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1885 XSETWINDOW (window, w);
1890 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1891 Return the character position of the mouse event EVENT.
1892 If the event did not occur over a window, or did not occur over text,
1893 then this returns nil. Otherwise, it returns a position in the buffer
1894 visible in the event's window.
1901 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1903 return w && bufp ? make_int (bufp) : Qnil;
1906 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1907 Return the character position closest to the mouse event EVENT.
1908 If the event did not occur over a window or over text, return the
1909 closest point to the location of the event. If the Y pixel position
1910 overlaps a window and the X pixel position is to the left of that
1911 window, the closest point is the beginning of the line containing the
1912 Y position. If the Y pixel position overlaps a window and the X pixel
1913 position is to the right of that window, the closest point is the end
1914 of the line containing the Y position. If the Y pixel position is
1915 above a window, return 0. If it is below the last character in a window,
1916 return the value of (window-end).
1922 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
1924 return bufp ? make_int (bufp) : Qnil;
1927 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
1928 Return the X position of the mouse event EVENT in characters.
1929 This is relative to the window the event occurred over.
1935 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1937 return make_int (char_x);
1940 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
1941 Return the Y position of the mouse event EVENT in characters.
1942 This is relative to the window the event occurred over.
1948 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
1950 return make_int (char_y);
1953 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
1954 Return the character position in the modeline that EVENT occurred over.
1955 EVENT should be a mouse event. If EVENT did not occur over a modeline,
1956 nil is returned. You can determine the actual character that the
1957 event occurred over by looking in `generated-modeline-string' at the
1958 returned character position. Note that `generated-modeline-string'
1959 is buffer-local, and you must use EVENT's buffer when retrieving
1960 `generated-modeline-string' in order to get accurate results.
1967 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
1969 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
1972 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
1973 Return the glyph that the mouse event EVENT occurred over, or nil.
1980 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
1982 return w && GLYPHP (glyph) ? glyph : Qnil;
1985 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
1986 Return the extent of the glyph that the mouse event EVENT occurred over.
1987 If the event did not occur over a glyph, nil is returned.
1994 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
1996 return w && EXTENTP (extent) ? extent : Qnil;
1999 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
2000 Return the X pixel position of EVENT relative to the glyph it occurred over.
2001 EVENT should be a mouse event. If the event did not occur over a glyph,
2010 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2012 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2015 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2016 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2017 EVENT should be a mouse event. If the event did not occur over a glyph,
2026 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2028 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2031 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2032 Return the toolbar button that the mouse event EVENT occurred over.
2033 If the event did not occur over a toolbar button, nil is returned.
2037 #ifdef HAVE_TOOLBARS
2040 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2042 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2048 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2049 Return the process of the given process-output event.
2053 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2054 return XEVENT (event)->event.process.process;
2057 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2058 Return the callback function of EVENT.
2059 EVENT should be a timeout, misc-user, or eval event.
2064 CHECK_LIVE_EVENT (event);
2065 switch (XEVENT (event)->event_type)
2068 return XEVENT (event)->event.timeout.function;
2069 case misc_user_event:
2070 return XEVENT (event)->event.misc.function;
2072 return XEVENT (event)->event.eval.function;
2074 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2079 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2080 Return the callback function argument of EVENT.
2081 EVENT should be a timeout, misc-user, or eval event.
2086 CHECK_LIVE_EVENT (event);
2087 switch (XEVENT (event)->event_type)
2090 return XEVENT (event)->event.timeout.object;
2091 case misc_user_event:
2092 return XEVENT (event)->event.misc.object;
2094 return XEVENT (event)->event.eval.object;
2096 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2101 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2102 Return a list of all of the properties of EVENT.
2103 This is in the form of a property list (alternating keyword/value pairs).
2107 Lisp_Object props = Qnil;
2108 struct Lisp_Event *e;
2109 struct gcpro gcpro1;
2111 CHECK_LIVE_EVENT (event);
2115 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2117 switch (e->event_type)
2122 props = cons3 (Qprocess, e->event.process.process, props);
2126 props = cons3 (Qobject, Fevent_object (event), props);
2127 props = cons3 (Qfunction, Fevent_function (event), props);
2128 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2131 case key_press_event:
2132 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2133 props = cons3 (Qkey, Fevent_key (event), props);
2136 case button_press_event:
2137 case button_release_event:
2138 props = cons3 (Qy, Fevent_y_pixel (event), props);
2139 props = cons3 (Qx, Fevent_x_pixel (event), props);
2140 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2141 props = cons3 (Qbutton, Fevent_button (event), props);
2144 case pointer_motion_event:
2145 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2146 props = cons3 (Qy, Fevent_y_pixel (event), props);
2147 props = cons3 (Qx, Fevent_x_pixel (event), props);
2150 case misc_user_event:
2151 props = cons3 (Qobject, Fevent_object (event), props);
2152 props = cons3 (Qfunction, Fevent_function (event), props);
2153 props = cons3 (Qy, Fevent_y_pixel (event), props);
2154 props = cons3 (Qx, Fevent_x_pixel (event), props);
2155 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2156 props = cons3 (Qbutton, Fevent_button (event), props);
2160 props = cons3 (Qobject, Fevent_object (event), props);
2161 props = cons3 (Qfunction, Fevent_function (event), props);
2164 case magic_eval_event:
2169 RETURN_UNGCPRO (Qnil);
2173 props = cons3 (Qchannel, Fevent_channel (event), props);
2180 /************************************************************************/
2181 /* initialization */
2182 /************************************************************************/
2185 syms_of_events (void)
2187 DEFSUBR (Fcharacter_to_event);
2188 DEFSUBR (Fevent_to_character);
2190 DEFSUBR (Fmake_event);
2191 DEFSUBR (Fdeallocate_event);
2192 DEFSUBR (Fcopy_event);
2194 DEFSUBR (Fevent_live_p);
2195 DEFSUBR (Fevent_type);
2196 DEFSUBR (Fevent_properties);
2198 DEFSUBR (Fevent_timestamp);
2199 DEFSUBR (Fevent_key);
2200 DEFSUBR (Fevent_button);
2201 DEFSUBR (Fevent_modifier_bits);
2202 DEFSUBR (Fevent_modifiers);
2203 DEFSUBR (Fevent_x_pixel);
2204 DEFSUBR (Fevent_y_pixel);
2205 DEFSUBR (Fevent_window_x_pixel);
2206 DEFSUBR (Fevent_window_y_pixel);
2207 DEFSUBR (Fevent_over_text_area_p);
2208 DEFSUBR (Fevent_over_modeline_p);
2209 DEFSUBR (Fevent_over_border_p);
2210 DEFSUBR (Fevent_over_toolbar_p);
2211 DEFSUBR (Fevent_over_vertical_divider_p);
2212 DEFSUBR (Fevent_channel);
2213 DEFSUBR (Fevent_window);
2214 DEFSUBR (Fevent_point);
2215 DEFSUBR (Fevent_closest_point);
2218 DEFSUBR (Fevent_modeline_position);
2219 DEFSUBR (Fevent_glyph);
2220 DEFSUBR (Fevent_glyph_extent);
2221 DEFSUBR (Fevent_glyph_x_pixel);
2222 DEFSUBR (Fevent_glyph_y_pixel);
2223 DEFSUBR (Fevent_toolbar_button);
2224 DEFSUBR (Fevent_process);
2225 DEFSUBR (Fevent_function);
2226 DEFSUBR (Fevent_object);
2228 defsymbol (&Qeventp, "eventp");
2229 defsymbol (&Qevent_live_p, "event-live-p");
2230 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2231 defsymbol (&Qbutton_event_p, "button-event-p");
2232 defsymbol (&Qmouse_event_p, "mouse-event-p");
2233 defsymbol (&Qprocess_event_p, "process-event-p");
2234 defsymbol (&Qkey_press, "key-press");
2235 defsymbol (&Qbutton_press, "button-press");
2236 defsymbol (&Qbutton_release, "button-release");
2237 defsymbol (&Qmisc_user, "misc-user");
2238 defsymbol (&Qascii_character, "ascii-character");
2240 defsymbol (&QKbackspace, "backspace");
2241 defsymbol (&QKtab, "tab");
2242 defsymbol (&QKlinefeed, "linefeed");
2243 defsymbol (&QKreturn, "return");
2244 defsymbol (&QKescape, "escape");
2245 defsymbol (&QKspace, "space");
2246 defsymbol (&QKdelete, "delete");
2251 reinit_vars_of_events (void)
2253 Vevent_resource = Qnil;
2257 vars_of_events (void)
2259 reinit_vars_of_events ();
2261 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2262 A symbol used to look up the 8-bit character of a keysym.
2263 To convert a keysym symbol to an 8-bit code, as when that key is
2264 bound to self-insert-command, we will look up the property that this
2265 variable names on the property list of the keysym-symbol. The window-
2266 system-specific code will set up appropriate properties and set this
2269 Vcharacter_set_property = Qnil;