1 /* Events: printing them, converting them to and from characters.
2 Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* This file has been Mule-ized. */
30 #include "console-tty.h" /* for stuff in character_to_event */
32 #include "console-x.h" /* for x_event_name prototype */
33 #include "extents.h" /* Just for the EXTENTP abort check... */
37 #include "keymap.h" /* for key_desc_list_to_event() */
38 #include "redisplay.h"
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
51 #include "events-mod.h"
53 /* Where old events go when they are explicitly deallocated.
54 The event chain here is cut loose before GC, so these will be freed
57 static Lisp_Object Vevent_resource;
60 Lisp_Object Qevent_live_p;
61 Lisp_Object Qkey_press_event_p;
62 Lisp_Object Qbutton_event_p;
63 Lisp_Object Qmouse_event_p;
64 Lisp_Object Qprocess_event_p;
66 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
67 Lisp_Object Qascii_character;
69 EXFUN (Fevent_x_pixel, 1);
70 EXFUN (Fevent_y_pixel, 1);
72 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
74 clear_event_resource (void)
76 Vevent_resource = Qnil;
79 /* Make sure we lose quickly if we try to use this event */
81 deinitialize_event (Lisp_Object ev)
84 struct Lisp_Event *event = XEVENT (ev);
86 for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++)
87 ((int *) event) [i] = 0xdeadbeef;
88 event->event_type = dead_event;
89 event->channel = Qnil;
90 set_lheader_implementation (&(event->lheader), lrecord_event);
91 XSET_EVENT_NEXT (ev, Qnil);
94 /* Set everything to zero or nil so that it's predictable. */
96 zero_event (struct Lisp_Event *e)
99 set_lheader_implementation (&(e->lheader), lrecord_event);
100 e->event_type = empty_event;
106 mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object))
108 struct Lisp_Event *event = XEVENT (obj);
110 switch (event->event_type)
112 case key_press_event:
113 markobj (event->event.key.keysym);
116 markobj (event->event.process.process);
119 markobj (event->event.timeout.function);
120 markobj (event->event.timeout.object);
123 case misc_user_event:
124 markobj (event->event.eval.function);
125 markobj (event->event.eval.object);
127 case magic_eval_event:
128 markobj (event->event.magic_eval.object);
130 case button_press_event:
131 case button_release_event:
132 case pointer_motion_event:
140 markobj (event->channel);
145 print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun)
148 write_c_string (str, printcharfun);
149 format_event_object (buf, XEVENT (obj), 0);
150 write_c_string (buf, printcharfun);
154 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
157 error ("Printing unreadable object #<event>");
159 switch (XEVENT (obj)->event_type)
161 case key_press_event:
162 print_event_1 ("#<keypress-event ", obj, printcharfun);
164 case button_press_event:
165 print_event_1 ("#<buttondown-event ", obj, printcharfun);
167 case button_release_event:
168 print_event_1 ("#<buttonup-event ", obj, printcharfun);
171 case magic_eval_event:
172 print_event_1 ("#<magic-event ", obj, printcharfun);
174 case pointer_motion_event:
178 Vx = Fevent_x_pixel (obj);
180 Vy = Fevent_y_pixel (obj);
182 sprintf (buf, "#<motion-event %ld, %ld", (long)(XINT (Vx)), (long)(XINT (Vy)));
183 write_c_string (buf, printcharfun);
187 write_c_string ("#<process-event ", printcharfun);
188 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
191 write_c_string ("#<timeout-event ", printcharfun);
192 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
195 write_c_string ("#<empty-event", printcharfun);
197 case misc_user_event:
198 write_c_string ("#<misc-user-event (", printcharfun);
199 print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
200 write_c_string (" ", printcharfun);
201 print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
202 write_c_string (")", printcharfun);
205 write_c_string ("#<eval-event (", printcharfun);
206 print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
207 write_c_string (" ", printcharfun);
208 print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
209 write_c_string (")", printcharfun);
212 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
215 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
218 write_c_string (">", printcharfun);
222 event_equal (Lisp_Object 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, 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 `allocate-event.' See also
767 the function `deallocate-event'.
771 CHECK_LIVE_EVENT (event1);
773 event2 = Fmake_event (Qnil, Qnil);
774 else CHECK_LIVE_EVENT (event2);
775 if (EQ (event1, event2))
776 return signal_simple_continuable_error_2
777 ("copy-event called with `eq' events", event1, event2);
779 assert (XEVENT_TYPE (event1) <= last_event_type);
780 assert (XEVENT_TYPE (event2) <= last_event_type);
783 Lisp_Object save_next = XEVENT_NEXT (event2);
785 *XEVENT (event2) = *XEVENT (event1);
786 XSET_EVENT_NEXT (event2, save_next);
793 /* Given a chain of events (or possibly nil), deallocate them all. */
796 deallocate_event_chain (Lisp_Object event_chain)
798 while (!NILP (event_chain))
800 Lisp_Object next = XEVENT_NEXT (event_chain);
801 Fdeallocate_event (event_chain);
806 /* Return the last event in a chain.
807 NOTE: You cannot pass nil as a value here! The routine will
811 event_chain_tail (Lisp_Object event_chain)
815 Lisp_Object next = XEVENT_NEXT (event_chain);
822 /* Enqueue a single event onto the end of a chain of events.
823 HEAD points to the first event in the chain, TAIL to the last event.
824 If the chain is empty, both values should be nil. */
827 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
829 assert (NILP (XEVENT_NEXT (event)));
830 assert (!EQ (*tail, event));
833 XSET_EVENT_NEXT (*tail, event);
838 assert (!EQ (event, XEVENT_NEXT (event)));
841 /* Remove an event off the head of a chain of events and return it.
842 HEAD points to the first event in the chain, TAIL to the last event. */
845 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
850 *head = XEVENT_NEXT (event);
851 XSET_EVENT_NEXT (event, Qnil);
857 /* Enqueue a chain of events (or possibly nil) onto the end of another
858 chain of events. HEAD points to the first event in the chain being
859 queued onto, TAIL to the last event. If the chain is empty, both values
863 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
866 if (NILP (event_chain))
876 XSET_EVENT_NEXT (*tail, event_chain);
877 *tail = event_chain_tail (event_chain);
881 /* Return the number of events (possibly 0) on an event chain. */
884 event_chain_count (Lisp_Object event_chain)
889 EVENT_CHAIN_LOOP (event, event_chain)
895 /* Find the event before EVENT in an event chain. This aborts
896 if the event is not in the chain. */
899 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
901 Lisp_Object previous = Qnil;
903 while (!NILP (event_chain))
905 if (EQ (event_chain, event))
907 previous = event_chain;
908 event_chain = XEVENT_NEXT (event_chain);
916 event_chain_nth (Lisp_Object event_chain, int n)
919 EVENT_CHAIN_LOOP (event, event_chain)
929 copy_event_chain (Lisp_Object event_chain)
931 Lisp_Object new_chain = Qnil;
932 Lisp_Object new_chain_tail = Qnil;
935 EVENT_CHAIN_LOOP (event, event_chain)
937 Lisp_Object copy = Fcopy_event (event, Qnil);
938 enqueue_event (copy, &new_chain, &new_chain_tail);
946 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
950 command_event_p (Lisp_Object event)
952 switch (XEVENT_TYPE (event))
954 case key_press_event:
955 case button_press_event:
956 case button_release_event:
957 case misc_user_event:
966 character_to_event (Emchar c, struct Lisp_Event *event, struct console *con,
967 int use_console_meta_flag, int do_backspace_mapping)
969 Lisp_Object k = Qnil;
971 if (event->event_type == dead_event)
972 error ("character-to-event called with a deallocated event!");
977 if (c > 127 && c <= 255)
980 if (use_console_meta_flag && CONSOLE_TTY_P (con))
981 meta_flag = TTY_FLAGS (con).meta_key;
984 case 0: /* ignore top bit; it's parity */
987 case 1: /* top bit is meta */
991 default: /* this is a real character */
995 if (c < ' ') c += '@', m |= MOD_CONTROL;
1000 case 'I': k = QKtab; m &= ~MOD_CONTROL; break;
1001 case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break;
1002 case 'M': k = QKreturn; m &= ~MOD_CONTROL; break;
1003 case '[': k = QKescape; m &= ~MOD_CONTROL; break;
1005 #if defined(HAVE_TTY)
1006 if (do_backspace_mapping &&
1007 CHARP (con->tty_erase_char) &&
1008 c - '@' == XCHAR (con->tty_erase_char))
1013 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1016 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1018 #if defined(HAVE_TTY)
1019 else if (do_backspace_mapping &&
1020 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1022 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1028 event->event_type = key_press_event;
1029 event->timestamp = 0; /* #### */
1030 event->channel = make_console (con);
1031 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1032 event->event.key.modifiers = m;
1036 /* This variable controls what character name -> character code mapping
1037 we are using. Window-system-specific code sets this to some symbol,
1038 and we use that symbol as the plist key to convert keysyms into 8-bit
1039 codes. In this way one can have several character sets predefined and
1040 switch them by changing this.
1042 Lisp_Object Vcharacter_set_property;
1045 event_to_character (struct Lisp_Event *event,
1046 int allow_extra_modifiers,
1048 int allow_non_ascii)
1053 if (event->event_type != key_press_event)
1055 if (event->event_type == dead_event) abort ();
1058 if (!allow_extra_modifiers &&
1059 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
1061 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1062 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1063 else if (!SYMBOLP (event->event.key.keysym))
1065 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1066 /* Allow window-system-specific extensibility of
1067 keysym->code mapping */
1068 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1069 Vcharacter_set_property,
1071 c = XCHAR_OR_CHAR_INT (code);
1072 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1073 Qascii_character, Qnil)))
1074 c = XCHAR_OR_CHAR_INT (code);
1078 if (event->event.key.modifiers & MOD_CONTROL)
1080 if (c >= 'a' && c <= 'z')
1083 /* reject Control-Shift- keys */
1084 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1087 if (c >= '@' && c <= '_')
1089 else if (c == ' ') /* C-space and C-@ are the same. */
1092 /* reject keys that can't take Control- modifiers */
1093 if (! allow_extra_modifiers) return -1;
1096 if (event->event.key.modifiers & MOD_META)
1098 if (! allow_meta) return -1;
1099 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1101 if (c >= 256) return -1;
1108 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1109 Return the closest ASCII approximation to the given event object.
1110 If the event isn't a keypress, this returns nil.
1111 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1112 its translation; it will ignore modifier keys other than control and meta,
1113 and will ignore the shift modifier on those characters which have no
1114 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1115 the same ASCII code as Control-A).
1116 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1117 represented by turning on the high bit of the byte returned; otherwise, nil
1118 will be returned for events containing the Meta modifier.
1119 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1120 present in the prevailing character set (see the `character-set-property'
1121 variable) will be returned as their code in that character set, instead of
1122 the return value being restricted to ASCII.
1123 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1124 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1126 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1129 CHECK_LIVE_EVENT (event);
1130 c = event_to_character (XEVENT (event),
1131 !NILP (allow_extra_modifiers),
1133 !NILP (allow_non_ascii));
1134 return c < 0 ? Qnil : make_char (c);
1137 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1138 Convert keystroke CH into an event structure ,replete with bucky bits.
1139 The keystroke is the first argument, and the event to fill
1140 in is the second. This function contains knowledge about what the codes
1141 ``mean'' -- for example, the number 9 is converted to the character ``Tab'',
1142 not the distinct character ``Control-I''.
1144 Note that CH (the keystroke specifier) can be an integer, a character,
1145 a symbol such as 'clear, or a list such as '(control backspace).
1147 If the optional second argument is an event, it is modified;
1148 otherwise, a new event object is created.
1150 Optional third arg CONSOLE is the console to store in the event, and
1151 defaults to the selected console.
1153 If CH is an integer or character, the high bit may be interpreted as the
1154 meta key. (This is done for backward compatibility in lots of places.)
1155 If USE-CONSOLE-META-FLAG is nil, this will always be the case. If
1156 USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects
1157 whether the high bit is interpreted as a meta key. (See `set-input-mode'.)
1158 If you don't want this silly meta interpretation done, you should pass
1159 in a list containing the character.
1161 Beware that character-to-event and event-to-character are not strictly
1162 inverse functions, since events contain much more information than the
1163 ASCII character set can encode.
1165 (ch, event, console, use_console_meta_flag))
1167 struct console *con = decode_console (console);
1169 event = Fmake_event (Qnil, Qnil);
1171 CHECK_LIVE_EVENT (event);
1172 if (CONSP (ch) || SYMBOLP (ch))
1173 key_desc_list_to_event (ch, event, 1);
1176 CHECK_CHAR_COERCE_INT (ch);
1177 character_to_event (XCHAR (ch), XEVENT (event), con,
1178 !NILP (use_console_meta_flag), 1);
1184 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1186 assert (STRINGP (seq) || VECTORP (seq));
1187 assert (n < XINT (Flength (seq)));
1191 Emchar ch = string_char (XSTRING (seq), n);
1192 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1196 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1197 if (EVENTP (keystroke))
1198 Fcopy_event (keystroke, event);
1200 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1205 key_sequence_to_event_chain (Lisp_Object seq)
1207 int len = XINT (Flength (seq));
1209 Lisp_Object head = Qnil, tail = Qnil;
1211 for (i = 0; i < len; i++)
1213 Lisp_Object event = Fmake_event (Qnil, Qnil);
1214 nth_of_key_sequence_as_event (seq, i, event);
1215 enqueue_event (event, &head, &tail);
1222 format_event_object (char *buf, struct Lisp_Event *event, int brief)
1228 switch (event->event_type)
1230 case key_press_event:
1232 mod = event->event.key.modifiers;
1233 key = event->event.key.keysym;
1235 if (! brief && CHARP (key) &&
1236 mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER))
1238 int k = XCHAR (key);
1239 if (k >= 'a' && k <= 'z')
1240 key = make_char (k - ('a' - 'A'));
1241 else if (k >= 'A' && k <= 'Z')
1246 case button_release_event:
1249 case button_press_event:
1252 mod = event->event.button.modifiers;
1253 key = make_char (event->event.button.button + '0');
1258 CONST char *name = NULL;
1260 #ifdef HAVE_X_WINDOWS
1262 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1263 if (CONSOLE_X_P (XCONSOLE (console)))
1264 name = x_event_name (event->event.magic.underlying_x_event.type);
1266 #endif /* HAVE_X_WINDOWS */
1267 if (name) strcpy (buf, name);
1268 else strcpy (buf, "???");
1271 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1272 case pointer_motion_event: strcpy (buf, "motion"); return;
1273 case misc_user_event: strcpy (buf, "misc-user"); return;
1274 case eval_event: strcpy (buf, "eval"); return;
1275 case process_event: strcpy (buf, "process"); return;
1276 case timeout_event: strcpy (buf, "timeout"); return;
1277 case empty_event: strcpy (buf, "empty"); return;
1278 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1282 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1283 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1284 if (mod & MOD_CONTROL) modprint ("control-", "C-");
1285 if (mod & MOD_META) modprint ("meta-", "M-");
1286 if (mod & MOD_SUPER) modprint ("super-", "S-");
1287 if (mod & MOD_HYPER) modprint ("hyper-", "H-");
1288 if (mod & MOD_ALT) modprint ("alt-", "A-");
1289 if (mod & MOD_SHIFT) modprint ("shift-", "Sh-");
1292 modprint1 ("button");
1301 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1304 else if (SYMBOLP (key))
1306 CONST char *str = 0;
1309 if (EQ (key, QKlinefeed)) str = "LFD";
1310 else if (EQ (key, QKtab)) str = "TAB";
1311 else if (EQ (key, QKreturn)) str = "RET";
1312 else if (EQ (key, QKescape)) str = "ESC";
1313 else if (EQ (key, QKdelete)) str = "DEL";
1314 else if (EQ (key, QKspace)) str = "SPC";
1315 else if (EQ (key, QKbackspace)) str = "BS";
1319 int i = strlen (str);
1320 memcpy (buf, str, i+1);
1325 struct Lisp_String *name = XSYMBOL (key)->name;
1326 memcpy (buf, string_data (name), string_length (name) + 1);
1327 str += string_length (name);
1333 strncpy (buf, "up", 4);
1336 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1337 True if OBJECT is an event object.
1341 return EVENTP (object) ? Qt : Qnil;
1344 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1345 True if OBJECT is an event object that has not been deallocated.
1349 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1353 #if 0 /* debugging functions */
1355 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1356 Return the event object's `next' event, or nil if it has none.
1357 The `next-event' field is changed by calling `set-next-event'.
1361 struct Lisp_Event *e;
1362 CHECK_LIVE_EVENT (event);
1364 return XEVENT_NEXT (event);
1367 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1368 Set the `next event' of EVENT to NEXT-EVENT.
1369 NEXT-EVENT must be an event object or nil.
1371 (event, next_event))
1375 CHECK_LIVE_EVENT (event);
1376 if (NILP (next_event))
1378 XSET_EVENT_NEXT (event, Qnil);
1382 CHECK_LIVE_EVENT (next_event);
1384 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1388 signal_error (Qerror,
1389 list3 (build_string ("Cyclic event-next"),
1393 XSET_EVENT_NEXT (event, next_event);
1399 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1400 Return the type of EVENT.
1401 This will be a symbol; one of
1403 key-press A key was pressed.
1404 button-press A mouse button was pressed.
1405 button-release A mouse button was released.
1406 misc-user Some other user action happened; typically, this is
1407 a menu selection or scrollbar action.
1408 motion The mouse moved.
1409 process Input is available from a subprocess.
1410 timeout A timeout has expired.
1411 eval This causes a specified action to occur when dispatched.
1412 magic Some window-system-specific event has occurred.
1413 empty The event has been allocated but not assigned.
1418 CHECK_LIVE_EVENT (event);
1419 switch (XEVENT (event)->event_type)
1421 case key_press_event: return Qkey_press;
1422 case button_press_event: return Qbutton_press;
1423 case button_release_event: return Qbutton_release;
1424 case misc_user_event: return Qmisc_user;
1425 case pointer_motion_event: return Qmotion;
1426 case process_event: return Qprocess;
1427 case timeout_event: return Qtimeout;
1428 case eval_event: return Qeval;
1430 case magic_eval_event:
1442 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1443 Return the timestamp of the event object EVENT.
1447 CHECK_LIVE_EVENT (event);
1448 /* This junk is so that timestamps don't get to be negative, but contain
1449 as many bits as this particular emacs will allow.
1451 return make_int (((1L << (VALBITS - 1)) - 1) &
1452 XEVENT (event)->timestamp);
1455 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1456 CHECK_LIVE_EVENT (e); \
1457 if (XEVENT(e)->event_type != (t1)) \
1458 e = wrong_type_argument ((sym),(e)); \
1461 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1462 CHECK_LIVE_EVENT (e); \
1463 if (XEVENT(e)->event_type != (t1) && \
1464 XEVENT(e)->event_type != (t2)) \
1465 e = wrong_type_argument ((sym),(e)); \
1468 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1469 CHECK_LIVE_EVENT (e); \
1470 if (XEVENT(e)->event_type != (t1) && \
1471 XEVENT(e)->event_type != (t2) && \
1472 XEVENT(e)->event_type != (t3)) \
1473 e = wrong_type_argument ((sym),(e)); \
1476 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1477 Return the Keysym of the key-press event EVENT.
1478 This will be a character if the event is associated with one, else a symbol.
1482 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1483 return XEVENT (event)->event.key.keysym;
1486 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1487 Return the button-number of the given button-press or button-release event.
1492 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1493 misc_user_event, Qbutton_event_p);
1494 #ifdef HAVE_WINDOW_SYSTEM
1495 if ( XEVENT (event)->event_type == misc_user_event)
1496 return make_int (XEVENT (event)->event.misc.button);
1498 return make_int (XEVENT (event)->event.button.button);
1499 #else /* !HAVE_WINDOW_SYSTEM */
1501 #endif /* !HAVE_WINDOW_SYSTEM */
1505 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1506 Return a number representing the modifier keys which were down
1507 when the given mouse or keyboard event was produced.
1508 See also the function event-modifiers.
1513 CHECK_LIVE_EVENT (event);
1514 switch (XEVENT (event)->event_type)
1516 case key_press_event:
1517 return make_int (XEVENT (event)->event.key.modifiers);
1518 case button_press_event:
1519 case button_release_event:
1520 return make_int (XEVENT (event)->event.button.modifiers);
1521 case pointer_motion_event:
1522 return make_int (XEVENT (event)->event.motion.modifiers);
1523 case misc_user_event:
1524 return make_int (XEVENT (event)->event.misc.modifiers);
1526 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1531 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1532 Return a list of symbols, the names of the modifier keys
1533 which were down when the given mouse or keyboard event was produced.
1534 See also the function event-modifier-bits.
1538 int mod = XINT (Fevent_modifier_bits (event));
1539 Lisp_Object result = Qnil;
1540 if (mod & MOD_SHIFT) result = Fcons (Qshift, result);
1541 if (mod & MOD_ALT) result = Fcons (Qalt, result);
1542 if (mod & MOD_HYPER) result = Fcons (Qhyper, result);
1543 if (mod & MOD_SUPER) result = Fcons (Qsuper, result);
1544 if (mod & MOD_META) result = Fcons (Qmeta, result);
1545 if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result);
1550 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1555 if (XEVENT (event)->event_type == pointer_motion_event)
1557 *x = XEVENT (event)->event.motion.x;
1558 *y = XEVENT (event)->event.motion.y;
1560 else if (XEVENT (event)->event_type == button_press_event ||
1561 XEVENT (event)->event_type == button_release_event)
1563 *x = XEVENT (event)->event.button.x;
1564 *y = XEVENT (event)->event.button.y;
1566 else if (XEVENT (event)->event_type == misc_user_event)
1568 *x = XEVENT (event)->event.misc.x;
1569 *y = XEVENT (event)->event.misc.y;
1574 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1578 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1581 return 1; /* #### What should really happen here. */
1583 *x -= w->pixel_left;
1588 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1589 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1590 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1591 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1597 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1598 Return the X position in pixels of mouse event EVENT.
1599 The value returned is relative to the window the event occurred in.
1600 This will signal an error if the event is not a mouse event.
1601 See also `mouse-event-p' and `event-x-pixel'.
1607 CHECK_LIVE_EVENT (event);
1609 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1610 return wrong_type_argument (Qmouse_event_p, event);
1612 return make_int (x);
1615 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1616 Return the Y position in pixels of mouse event EVENT.
1617 The value returned is relative to the window the event occurred in.
1618 This will signal an error if the event is not a mouse event.
1619 See also `mouse-event-p' and `event-y-pixel'.
1625 CHECK_LIVE_EVENT (event);
1627 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1628 return wrong_type_argument (Qmouse_event_p, event);
1630 return make_int (y);
1633 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1634 Return the X position in pixels of mouse event EVENT.
1635 The value returned is relative to the frame the event occurred in.
1636 This will signal an error if the event is not a mouse event.
1637 See also `mouse-event-p' and `event-window-x-pixel'.
1643 CHECK_LIVE_EVENT (event);
1645 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1646 return wrong_type_argument (Qmouse_event_p, event);
1648 return make_int (x);
1651 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1652 Return the Y position in pixels of mouse event EVENT.
1653 The value returned is relative to the frame the event occurred in.
1654 This will signal an error if the event is not a mouse event.
1655 See also `mouse-event-p' `event-window-y-pixel'.
1661 CHECK_LIVE_EVENT (event);
1663 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1664 return wrong_type_argument (Qmouse_event_p, event);
1666 return make_int (y);
1669 /* Given an event, return a value:
1671 OVER_TOOLBAR: over one of the 4 frame toolbars
1672 OVER_MODELINE: over a modeline
1673 OVER_BORDER: over an internal border
1674 OVER_NOTHING: over the text area, but not over text
1675 OVER_OUTSIDE: outside of the frame border
1676 OVER_TEXT: over text in the text area
1677 OVER_V_DIVIDER: over windows vertical divider
1681 The X char position in CHAR_X, if not a null pointer.
1682 The Y char position in CHAR_Y, if not a null pointer.
1683 (These last two values are relative to the window the event is over.)
1684 The window it's over in W, if not a null pointer.
1685 The buffer position it's over in BUFP, if not a null pointer.
1686 The closest buffer position in CLOSEST, if not a null pointer.
1688 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1692 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1693 int *obj_x, int *obj_y,
1694 struct window **w, Bufpos *bufp, Bufpos *closest,
1695 Charcount *modeline_closest,
1696 Lisp_Object *obj1, Lisp_Object *obj2)
1703 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1704 struct window *ret_w;
1705 Bufpos ret_bufp, ret_closest;
1706 Charcount ret_modeline_closest;
1707 Lisp_Object ret_obj1, ret_obj2;
1709 CHECK_LIVE_EVENT (event);
1710 frame = XEVENT (event)->channel;
1711 switch (XEVENT (event)->event_type)
1713 case pointer_motion_event :
1714 pix_x = XEVENT (event)->event.motion.x;
1715 pix_y = XEVENT (event)->event.motion.y;
1717 case button_press_event :
1718 case button_release_event :
1719 pix_x = XEVENT (event)->event.button.x;
1720 pix_y = XEVENT (event)->event.button.y;
1722 case misc_user_event :
1723 pix_x = XEVENT (event)->event.misc.x;
1724 pix_y = XEVENT (event)->event.misc.y;
1727 dead_wrong_type_argument (Qmouse_event_p, event);
1730 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1731 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1732 &ret_w, &ret_bufp, &ret_closest,
1733 &ret_modeline_closest,
1734 &ret_obj1, &ret_obj2);
1736 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1738 else if (ret_w && NILP (ret_w->buffer))
1739 /* Why does this happen? (Does it still happen?)
1740 I guess the window has gotten reused as a non-leaf... */
1743 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1744 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1745 pointer points to random memory, often filled with 0, sometimes not.
1747 /* #### Chuck, do we still need this crap? */
1748 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1749 #ifdef HAVE_TOOLBARS
1750 || TOOLBAR_BUTTONP (ret_obj1)
1754 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1770 *closest = ret_closest;
1771 if (modeline_closest)
1772 *modeline_closest = ret_modeline_closest;
1781 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1782 Return t if the mouse event EVENT occurred over the text area of a window.
1783 The modeline is not considered to be part of the text area.
1787 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1789 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1792 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1793 Return t if the mouse event EVENT occurred over the modeline of a window.
1797 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1799 return result == OVER_MODELINE ? Qt : Qnil;
1802 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1803 Return t if the mouse event EVENT occurred over an internal border.
1807 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1809 return result == OVER_BORDER ? Qt : Qnil;
1812 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1813 Return t if the mouse event EVENT occurred over a toolbar.
1817 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1819 return result == OVER_TOOLBAR ? Qt : Qnil;
1822 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1823 Return t if the mouse event EVENT occurred over a window divider.
1827 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1829 return result == OVER_V_DIVIDER ? Qt : Qnil;
1833 event_console_or_selected (Lisp_Object event)
1835 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1836 Lisp_Object console = CDFW_CONSOLE (channel);
1839 console = Vselected_console;
1841 return XCONSOLE (console);
1844 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1845 Return the channel that the event EVENT occurred on.
1846 This will be a frame, device, console, or nil for some types
1847 of events (e.g. eval events).
1851 CHECK_LIVE_EVENT (event);
1852 return EVENT_CHANNEL (XEVENT (event));
1855 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1856 Return the window over which mouse event EVENT occurred.
1857 This may be nil if the event occurred in the border or over a toolbar.
1858 The modeline is considered to be within the window it describes.
1864 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1872 XSETWINDOW (window, w);
1877 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1878 Return the character position of the mouse event EVENT.
1879 If the event did not occur over a window, or did not occur over text,
1880 then this returns nil. Otherwise, it returns a position in the buffer
1881 visible in the event's window.
1888 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1890 return w && bufp ? make_int (bufp) : Qnil;
1893 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1894 Return the character position closest to the mouse event EVENT.
1895 If the event did not occur over a window or over text, return the
1896 closest point to the location of the event. If the Y pixel position
1897 overlaps a window and the X pixel position is to the left of that
1898 window, the closest point is the beginning of the line containing the
1899 Y position. If the Y pixel position overlaps a window and the X pixel
1900 position is to the right of that window, the closest point is the end
1901 of the line containing the Y position. If the Y pixel position is
1902 above a window, return 0. If it is below the last character in a window,
1903 return the value of (window-end).
1909 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
1911 return bufp ? make_int (bufp) : Qnil;
1914 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
1915 Return the X position of the mouse event EVENT in characters.
1916 This is relative to the window the event occurred over.
1922 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1924 return make_int (char_x);
1927 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
1928 Return the Y position of the mouse event EVENT in characters.
1929 This is relative to the window the event occurred over.
1935 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
1937 return make_int (char_y);
1940 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
1941 Return the character position in the modeline that EVENT occurred over.
1942 EVENT should be a mouse event. If EVENT did not occur over a modeline,
1943 nil is returned. You can determine the actual character that the
1944 event occurred over by looking in `generated-modeline-string' at the
1945 returned character position. Note that `generated-modeline-string'
1946 is buffer-local, and you must use EVENT's buffer when retrieving
1947 `generated-modeline-string' in order to get accurate results.
1954 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
1956 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
1959 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
1960 Return the glyph that the mouse event EVENT occurred over, or nil.
1967 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
1969 return w && GLYPHP (glyph) ? glyph : Qnil;
1972 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
1973 Return the extent of the glyph that the mouse event EVENT occurred over.
1974 If the event did not occur over a glyph, nil is returned.
1981 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
1983 return w && EXTENTP (extent) ? extent : Qnil;
1986 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
1987 Return the X pixel position of EVENT relative to the glyph it occurred over.
1988 EVENT should be a mouse event. If the event did not occur over a glyph,
1997 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
1999 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2002 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2003 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2004 EVENT should be a mouse event. If the event did not occur over a glyph,
2013 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2015 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2018 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2019 Return the toolbar button that the mouse event EVENT occurred over.
2020 If the event did not occur over a toolbar button, nil is returned.
2024 #ifdef HAVE_TOOLBARS
2027 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2029 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2035 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2036 Return the process of the given process-output event.
2040 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2041 return XEVENT (event)->event.process.process;
2044 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2045 Return the callback function of EVENT.
2046 EVENT should be a timeout, misc-user, or eval event.
2051 CHECK_LIVE_EVENT (event);
2052 switch (XEVENT (event)->event_type)
2055 return XEVENT (event)->event.timeout.function;
2056 case misc_user_event:
2057 return XEVENT (event)->event.misc.function;
2059 return XEVENT (event)->event.eval.function;
2061 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2066 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2067 Return the callback function argument of EVENT.
2068 EVENT should be a timeout, misc-user, or eval event.
2073 CHECK_LIVE_EVENT (event);
2074 switch (XEVENT (event)->event_type)
2077 return XEVENT (event)->event.timeout.object;
2078 case misc_user_event:
2079 return XEVENT (event)->event.misc.object;
2081 return XEVENT (event)->event.eval.object;
2083 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2088 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2089 Return a list of all of the properties of EVENT.
2090 This is in the form of a property list (alternating keyword/value pairs).
2094 Lisp_Object props = Qnil;
2095 struct Lisp_Event *e;
2096 struct gcpro gcpro1;
2098 CHECK_LIVE_EVENT (event);
2102 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2104 switch (e->event_type)
2109 props = cons3 (Qprocess, e->event.process.process, props);
2113 props = cons3 (Qobject, Fevent_object (event), props);
2114 props = cons3 (Qfunction, Fevent_function (event), props);
2115 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2118 case key_press_event:
2119 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2120 props = cons3 (Qkey, Fevent_key (event), props);
2123 case button_press_event:
2124 case button_release_event:
2125 props = cons3 (Qy, Fevent_y_pixel (event), props);
2126 props = cons3 (Qx, Fevent_x_pixel (event), props);
2127 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2128 props = cons3 (Qbutton, Fevent_button (event), props);
2131 case pointer_motion_event:
2132 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2133 props = cons3 (Qy, Fevent_y_pixel (event), props);
2134 props = cons3 (Qx, Fevent_x_pixel (event), props);
2137 case misc_user_event:
2138 props = cons3 (Qobject, Fevent_object (event), props);
2139 props = cons3 (Qfunction, Fevent_function (event), props);
2140 props = cons3 (Qy, Fevent_y_pixel (event), props);
2141 props = cons3 (Qx, Fevent_x_pixel (event), props);
2142 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2143 props = cons3 (Qbutton, Fevent_button (event), props);
2147 props = cons3 (Qobject, Fevent_object (event), props);
2148 props = cons3 (Qfunction, Fevent_function (event), props);
2151 case magic_eval_event:
2156 RETURN_UNGCPRO (Qnil);
2160 props = cons3 (Qchannel, Fevent_channel (event), props);
2167 /************************************************************************/
2168 /* initialization */
2169 /************************************************************************/
2172 syms_of_events (void)
2174 DEFSUBR (Fcharacter_to_event);
2175 DEFSUBR (Fevent_to_character);
2177 DEFSUBR (Fmake_event);
2178 DEFSUBR (Fdeallocate_event);
2179 DEFSUBR (Fcopy_event);
2181 DEFSUBR (Fevent_live_p);
2182 DEFSUBR (Fevent_type);
2183 DEFSUBR (Fevent_properties);
2185 DEFSUBR (Fevent_timestamp);
2186 DEFSUBR (Fevent_key);
2187 DEFSUBR (Fevent_button);
2188 DEFSUBR (Fevent_modifier_bits);
2189 DEFSUBR (Fevent_modifiers);
2190 DEFSUBR (Fevent_x_pixel);
2191 DEFSUBR (Fevent_y_pixel);
2192 DEFSUBR (Fevent_window_x_pixel);
2193 DEFSUBR (Fevent_window_y_pixel);
2194 DEFSUBR (Fevent_over_text_area_p);
2195 DEFSUBR (Fevent_over_modeline_p);
2196 DEFSUBR (Fevent_over_border_p);
2197 DEFSUBR (Fevent_over_toolbar_p);
2198 DEFSUBR (Fevent_over_vertical_divider_p);
2199 DEFSUBR (Fevent_channel);
2200 DEFSUBR (Fevent_window);
2201 DEFSUBR (Fevent_point);
2202 DEFSUBR (Fevent_closest_point);
2205 DEFSUBR (Fevent_modeline_position);
2206 DEFSUBR (Fevent_glyph);
2207 DEFSUBR (Fevent_glyph_extent);
2208 DEFSUBR (Fevent_glyph_x_pixel);
2209 DEFSUBR (Fevent_glyph_y_pixel);
2210 DEFSUBR (Fevent_toolbar_button);
2211 DEFSUBR (Fevent_process);
2212 DEFSUBR (Fevent_function);
2213 DEFSUBR (Fevent_object);
2215 defsymbol (&Qeventp, "eventp");
2216 defsymbol (&Qevent_live_p, "event-live-p");
2217 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2218 defsymbol (&Qbutton_event_p, "button-event-p");
2219 defsymbol (&Qmouse_event_p, "mouse-event-p");
2220 defsymbol (&Qprocess_event_p, "process-event-p");
2221 defsymbol (&Qkey_press, "key-press");
2222 defsymbol (&Qbutton_press, "button-press");
2223 defsymbol (&Qbutton_release, "button-release");
2224 defsymbol (&Qmisc_user, "misc-user");
2225 defsymbol (&Qascii_character, "ascii-character");
2229 vars_of_events (void)
2231 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2232 A symbol used to look up the 8-bit character of a keysym.
2233 To convert a keysym symbol to an 8-bit code, as when that key is
2234 bound to self-insert-command, we will look up the property that this
2235 variable names on the property list of the keysym-symbol. The window-
2236 system-specific code will set up appropriate properties and set this
2239 Vcharacter_set_property = Qnil;
2241 Vevent_resource = Qnil;
2243 QKbackspace = KEYSYM ("backspace");
2244 QKtab = KEYSYM ("tab");
2245 QKlinefeed = KEYSYM ("linefeed");
2246 QKreturn = KEYSYM ("return");
2247 QKescape = KEYSYM ("escape");
2248 QKspace = KEYSYM ("space");
2249 QKdelete = KEYSYM ("delete");
2251 staticpro (&QKbackspace);
2253 staticpro (&QKlinefeed);
2254 staticpro (&QKreturn);
2255 staticpro (&QKescape);
2256 staticpro (&QKspace);
2257 staticpro (&QKdelete);