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 Lisp_Event *event = XEVENT (ev);
86 for (i = 0; i < (int) (sizeof (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 (Lisp_Event *e)
99 set_lheader_implementation (&(e->lheader), &lrecord_event);
100 e->event_type = empty_event;
106 mark_event (Lisp_Object obj)
108 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 Lisp_Event *e1 = XEVENT (obj1);
225 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)));
299 return 1; /* not reached */
302 case empty_event: /* Empty and deallocated events are equal. */
309 event_hash (Lisp_Object obj, int depth)
311 Lisp_Event *e = XEVENT (obj);
314 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
315 switch (e->event_type)
318 return HASH2 (hash, LISP_HASH (e->event.process.process));
321 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
322 internal_hash (e->event.timeout.object, depth + 1));
324 case key_press_event:
325 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
326 e->event.key.modifiers);
328 case button_press_event:
329 case button_release_event:
330 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
332 case pointer_motion_event:
333 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
335 case misc_user_event:
336 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
337 internal_hash (e->event.misc.object, depth + 1),
338 e->event.misc.button, e->event.misc.modifiers);
341 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
342 internal_hash (e->event.eval.object, depth + 1));
344 case magic_eval_event:
346 (unsigned long) e->event.magic_eval.internal_function,
347 internal_hash (e->event.magic_eval.object, depth + 1));
351 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
352 #ifdef HAVE_X_WINDOWS
353 if (CONSOLE_X_P (con))
354 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
357 if (CONSOLE_TTY_P (con))
358 return HASH2 (hash, e->event.magic.underlying_tty_event);
360 #ifdef HAVE_MS_WINDOWS
361 if (CONSOLE_MSWINDOWS_P (con))
362 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
376 return 0; /* unreached */
379 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
380 mark_event, print_event, 0, event_equal,
381 event_hash, 0, Lisp_Event);
384 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
385 Return a new event of type TYPE, with properties described by PLIST.
387 TYPE is a symbol, either `empty', `key-press', `button-press',
388 `button-release', `misc-user' or `motion'. If TYPE is nil, it
391 PLIST is a property list, the properties being compatible to those
392 returned by `event-properties'. The following properties are
395 channel -- The event channel, a frame or a console. For
396 button-press, button-release, misc-user and motion events,
397 this must be a frame. For key-press events, it must be
398 a console. If channel is unspecified, it will be set to
399 the selected frame or selected console, as appropriate.
400 key -- The event key, a symbol or character. Allowed only for
402 button -- The event button, integer 1, 2 or 3. Allowed for
403 button-press, button-release and misc-user events.
404 modifiers -- The event modifiers, a list of modifier symbols. Allowed
405 for key-press, button-press, button-release, motion and
407 function -- Function. Allowed for misc-user events only.
408 object -- An object, function's parameter. Allowed for misc-user
410 x -- The event X coordinate, an integer. This is relative
411 to the left of CHANNEL's root window. Allowed for
412 motion, button-press, button-release and misc-user events.
413 y -- The event Y coordinate, an integer. This is relative
414 to the top of CHANNEL's root window. Allowed for
415 motion, button-press, button-release and misc-user events.
416 timestamp -- The event timestamp, a non-negative integer. Allowed for
417 all types of events. If unspecified, it will be set to 0
420 For event type `empty', PLIST must be nil.
421 `button-release', or `motion'. If TYPE is left out, it defaults to
423 PLIST is a list of properties, as returned by `event-properties'. Not
424 all properties are allowed for all kinds of events, and some are
427 WARNING: the event object returned may be a reused one; see the function
432 Lisp_Object tail, keyword, value;
433 Lisp_Object event = Qnil;
435 EMACS_INT coord_x = 0, coord_y = 0;
443 if (!NILP (Vevent_resource))
445 event = Vevent_resource;
446 Vevent_resource = XEVENT_NEXT (event);
450 event = allocate_event ();
455 if (EQ (type, Qempty))
457 /* For empty event, we return immediately, without processing
458 PLIST. In fact, processing PLIST would be wrong, because the
459 sanitizing process would fill in the properties
460 (e.g. CHANNEL), which we don't want in empty events. */
461 e->event_type = empty_event;
463 error ("Cannot set properties of empty event");
467 else if (EQ (type, Qkey_press))
469 e->event_type = key_press_event;
470 e->event.key.keysym = Qunbound;
472 else if (EQ (type, Qbutton_press))
473 e->event_type = button_press_event;
474 else if (EQ (type, Qbutton_release))
475 e->event_type = button_release_event;
476 else if (EQ (type, Qmotion))
477 e->event_type = pointer_motion_event;
478 else if (EQ (type, Qmisc_user))
480 e->event_type = misc_user_event;
481 e->event.eval.function = e->event.eval.object = Qnil;
485 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
486 signal_simple_error ("Invalid event type", type);
489 EVENT_CHANNEL (e) = Qnil;
491 plist = Fcopy_sequence (plist);
492 Fcanonicalize_plist (plist, Qnil);
494 #define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \
495 error_with_frob (prop, "Invalid property for %s event", \
496 string_data (symbol_name (XSYMBOL (type))))
498 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist)
500 if (EQ (keyword, Qchannel))
502 if (e->event_type == key_press_event)
504 if (!CONSOLEP (value))
505 value = wrong_type_argument (Qconsolep, value);
510 value = wrong_type_argument (Qframep, value);
512 EVENT_CHANNEL (e) = value;
514 else if (EQ (keyword, Qkey))
516 switch (e->event_type)
518 case key_press_event:
519 if (!SYMBOLP (value) && !CHARP (value))
520 signal_simple_error ("Invalid event key", value);
521 e->event.key.keysym = value;
524 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
528 else if (EQ (keyword, Qbutton))
530 CHECK_NATNUM (value);
531 check_int_range (XINT (value), 0, 7);
533 switch (e->event_type)
535 case button_press_event:
536 case button_release_event:
537 e->event.button.button = XINT (value);
539 case misc_user_event:
540 e->event.misc.button = XINT (value);
543 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
547 else if (EQ (keyword, Qmodifiers))
552 EXTERNAL_LIST_LOOP_2 (sym, value)
554 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL;
555 else if (EQ (sym, Qmeta)) modifiers |= MOD_META;
556 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER;
557 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER;
558 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT;
559 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT;
560 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT;
562 signal_simple_error ("Invalid key modifier", sym);
565 switch (e->event_type)
567 case key_press_event:
568 e->event.key.modifiers = modifiers;
570 case button_press_event:
571 case button_release_event:
572 e->event.button.modifiers = modifiers;
574 case pointer_motion_event:
575 e->event.motion.modifiers = modifiers;
577 case misc_user_event:
578 e->event.misc.modifiers = modifiers;
581 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
585 else if (EQ (keyword, Qx))
587 switch (e->event_type)
589 case pointer_motion_event:
590 case button_press_event:
591 case button_release_event:
592 case misc_user_event:
593 /* Allow negative values, so we can specify toolbar
596 coord_x = XINT (value);
599 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
603 else if (EQ (keyword, Qy))
605 switch (e->event_type)
607 case pointer_motion_event:
608 case button_press_event:
609 case button_release_event:
610 case misc_user_event:
611 /* Allow negative values; see above. */
613 coord_y = XINT (value);
616 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
620 else if (EQ (keyword, Qtimestamp))
622 CHECK_NATNUM (value);
623 e->timestamp = XINT (value);
625 else if (EQ (keyword, Qfunction))
627 switch (e->event_type)
629 case misc_user_event:
630 e->event.eval.function = value;
633 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
637 else if (EQ (keyword, Qobject))
639 switch (e->event_type)
641 case misc_user_event:
642 e->event.eval.object = value;
645 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
650 signal_simple_error_2 ("Invalid property", keyword, value);
653 /* Insert the channel, if missing. */
654 if (NILP (EVENT_CHANNEL (e)))
656 if (e->event_type == key_press_event)
657 EVENT_CHANNEL (e) = Vselected_console;
659 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
662 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
663 to the frame, so we must adjust accordingly. */
664 if (FRAMEP (EVENT_CHANNEL (e)))
666 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
667 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
669 switch (e->event_type)
671 case pointer_motion_event:
672 e->event.motion.x = coord_x;
673 e->event.motion.y = coord_y;
675 case button_press_event:
676 case button_release_event:
677 e->event.button.x = coord_x;
678 e->event.button.y = coord_y;
680 case misc_user_event:
681 e->event.misc.x = coord_x;
682 e->event.misc.y = coord_y;
689 /* Finally, do some more validation. */
690 switch (e->event_type)
692 case key_press_event:
693 if (UNBOUNDP (e->event.key.keysym))
694 error ("A key must be specified to make a keypress event");
696 case button_press_event:
697 if (!e->event.button.button)
698 error ("A button must be specified to make a button-press event");
700 case button_release_event:
701 if (!e->event.button.button)
702 error ("A button must be specified to make a button-release event");
704 case misc_user_event:
705 if (NILP (e->event.misc.function))
706 error ("A function must be specified to make a misc-user event");
716 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
717 Allow the given event structure to be reused.
718 You MUST NOT use this event object after calling this function with it.
719 You will lose. It is not necessary to call this function, as event
720 objects are garbage-collected like all other objects; however, it may
721 be more efficient to explicitly deallocate events when you are sure
722 that it is safe to do so.
728 if (XEVENT_TYPE (event) == dead_event)
729 error ("this event is already deallocated!");
731 assert (XEVENT_TYPE (event) <= last_event_type);
737 if (EQ (event, Vlast_command_event) ||
738 EQ (event, Vlast_input_event) ||
739 EQ (event, Vunread_command_event))
742 len = XVECTOR_LENGTH (Vthis_command_keys);
743 for (i = 0; i < len; i++)
744 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
746 if (!NILP (Vrecent_keys_ring))
748 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
749 for (i = 0; i < recent_ring_len; i++)
750 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
756 assert (!EQ (event, Vevent_resource));
757 deinitialize_event (event);
758 #ifndef ALLOC_NO_POOLS
759 XSET_EVENT_NEXT (event, Vevent_resource);
760 Vevent_resource = event;
765 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
766 Make a copy of the given event object.
767 If a second argument is given, the first event is copied into the second
768 and the second is returned. If the second argument is not supplied (or
769 is nil) then a new event will be made as with `make-event'. See also
770 the function `deallocate-event'.
774 CHECK_LIVE_EVENT (event1);
776 event2 = Fmake_event (Qnil, Qnil);
779 CHECK_LIVE_EVENT (event2);
780 if (EQ (event1, event2))
781 return signal_simple_continuable_error_2
782 ("copy-event called with `eq' events", event1, event2);
785 assert (XEVENT_TYPE (event1) <= last_event_type);
786 assert (XEVENT_TYPE (event2) <= last_event_type);
789 Lisp_Event *ev2 = XEVENT (event2);
790 Lisp_Event *ev1 = XEVENT (event1);
792 ev2->event_type = ev1->event_type;
793 ev2->channel = ev1->channel;
794 ev2->timestamp = ev1->timestamp;
795 ev2->event = ev1->event;
803 /* Given a chain of events (or possibly nil), deallocate them all. */
806 deallocate_event_chain (Lisp_Object event_chain)
808 while (!NILP (event_chain))
810 Lisp_Object next = XEVENT_NEXT (event_chain);
811 Fdeallocate_event (event_chain);
816 /* Return the last event in a chain.
817 NOTE: You cannot pass nil as a value here! The routine will
821 event_chain_tail (Lisp_Object event_chain)
825 Lisp_Object next = XEVENT_NEXT (event_chain);
832 /* Enqueue a single event onto the end of a chain of events.
833 HEAD points to the first event in the chain, TAIL to the last event.
834 If the chain is empty, both values should be nil. */
837 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
839 assert (NILP (XEVENT_NEXT (event)));
840 assert (!EQ (*tail, event));
843 XSET_EVENT_NEXT (*tail, event);
848 assert (!EQ (event, XEVENT_NEXT (event)));
851 /* Remove an event off the head of a chain of events and return it.
852 HEAD points to the first event in the chain, TAIL to the last event. */
855 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
860 *head = XEVENT_NEXT (event);
861 XSET_EVENT_NEXT (event, Qnil);
867 /* Enqueue a chain of events (or possibly nil) onto the end of another
868 chain of events. HEAD points to the first event in the chain being
869 queued onto, TAIL to the last event. If the chain is empty, both values
873 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
876 if (NILP (event_chain))
886 XSET_EVENT_NEXT (*tail, event_chain);
887 *tail = event_chain_tail (event_chain);
891 /* Return the number of events (possibly 0) on an event chain. */
894 event_chain_count (Lisp_Object event_chain)
899 EVENT_CHAIN_LOOP (event, event_chain)
905 /* Find the event before EVENT in an event chain. This aborts
906 if the event is not in the chain. */
909 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
911 Lisp_Object previous = Qnil;
913 while (!NILP (event_chain))
915 if (EQ (event_chain, event))
917 previous = event_chain;
918 event_chain = XEVENT_NEXT (event_chain);
926 event_chain_nth (Lisp_Object event_chain, int n)
929 EVENT_CHAIN_LOOP (event, event_chain)
939 copy_event_chain (Lisp_Object event_chain)
941 Lisp_Object new_chain = Qnil;
942 Lisp_Object new_chain_tail = Qnil;
945 EVENT_CHAIN_LOOP (event, event_chain)
947 Lisp_Object copy = Fcopy_event (event, Qnil);
948 enqueue_event (copy, &new_chain, &new_chain_tail);
956 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
960 command_event_p (Lisp_Object event)
962 switch (XEVENT_TYPE (event))
964 case key_press_event:
965 case button_press_event:
966 case button_release_event:
967 case misc_user_event:
976 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
977 int use_console_meta_flag, int do_backspace_mapping)
979 Lisp_Object k = Qnil;
981 if (event->event_type == dead_event)
982 error ("character-to-event called with a deallocated event!");
987 if (c > 127 && c <= 255)
990 if (use_console_meta_flag && CONSOLE_TTY_P (con))
991 meta_flag = TTY_FLAGS (con).meta_key;
994 case 0: /* ignore top bit; it's parity */
997 case 1: /* top bit is meta */
1001 default: /* this is a real character */
1005 if (c < ' ') c += '@', m |= MOD_CONTROL;
1006 if (m & MOD_CONTROL)
1010 case 'I': k = QKtab; m &= ~MOD_CONTROL; break;
1011 case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break;
1012 case 'M': k = QKreturn; m &= ~MOD_CONTROL; break;
1013 case '[': k = QKescape; m &= ~MOD_CONTROL; break;
1015 #if defined(HAVE_TTY)
1016 if (do_backspace_mapping &&
1017 CHARP (con->tty_erase_char) &&
1018 c - '@' == XCHAR (con->tty_erase_char))
1023 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1026 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1028 #if defined(HAVE_TTY)
1029 else if (do_backspace_mapping &&
1030 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1032 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1038 event->event_type = key_press_event;
1039 event->timestamp = 0; /* #### */
1040 event->channel = make_console (con);
1041 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1042 event->event.key.modifiers = m;
1045 /* This variable controls what character name -> character code mapping
1046 we are using. Window-system-specific code sets this to some symbol,
1047 and we use that symbol as the plist key to convert keysyms into 8-bit
1048 codes. In this way one can have several character sets predefined and
1049 switch them by changing this.
1051 #### This is utterly bogus and should be removed.
1053 Lisp_Object Vcharacter_set_property;
1056 event_to_character (Lisp_Event *event,
1057 int allow_extra_modifiers,
1059 int allow_non_ascii)
1064 if (event->event_type != key_press_event)
1066 assert (event->event_type != dead_event);
1069 if (!allow_extra_modifiers &&
1070 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT))
1072 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1073 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1074 else if (!SYMBOLP (event->event.key.keysym))
1076 else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1077 /* Allow window-system-specific extensibility of
1078 keysym->code mapping */
1079 && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1080 Vcharacter_set_property,
1082 c = XCHAR_OR_CHAR_INT (code);
1083 else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1084 Qascii_character, Qnil)))
1085 c = XCHAR_OR_CHAR_INT (code);
1089 if (event->event.key.modifiers & MOD_CONTROL)
1091 if (c >= 'a' && c <= 'z')
1094 /* reject Control-Shift- keys */
1095 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1098 if (c >= '@' && c <= '_')
1100 else if (c == ' ') /* C-space and C-@ are the same. */
1103 /* reject keys that can't take Control- modifiers */
1104 if (! allow_extra_modifiers) return -1;
1107 if (event->event.key.modifiers & MOD_META)
1109 if (! allow_meta) return -1;
1110 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1112 if (c >= 256) return -1;
1119 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1120 Return the closest ASCII approximation to the given event object.
1121 If the event isn't a keypress, this returns nil.
1122 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1123 its translation; it will ignore modifier keys other than control and meta,
1124 and will ignore the shift modifier on those characters which have no
1125 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1126 the same ASCII code as Control-A).
1127 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1128 represented by turning on the high bit of the byte returned; otherwise, nil
1129 will be returned for events containing the Meta modifier.
1130 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1131 present in the prevailing character set (see the `character-set-property'
1132 variable) will be returned as their code in that character set, instead of
1133 the return value being restricted to ASCII.
1134 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1135 both use the high bit; `M-x' and `oslash' will be indistinguishable.
1137 (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1140 CHECK_LIVE_EVENT (event);
1141 c = event_to_character (XEVENT (event),
1142 !NILP (allow_extra_modifiers),
1144 !NILP (allow_non_ascii));
1145 return c < 0 ? Qnil : make_char (c);
1148 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1149 Convert keystroke CH into an event structure ,replete with bucky bits.
1150 The keystroke is the first argument, and the event to fill
1151 in is the second. This function contains knowledge about what the codes
1152 ``mean'' -- for example, the number 9 is converted to the character ``Tab'',
1153 not the distinct character ``Control-I''.
1155 Note that CH (the keystroke specifier) can be an integer, a character,
1156 a symbol such as 'clear, or a list such as '(control backspace).
1158 If the optional second argument is an event, it is modified;
1159 otherwise, a new event object is created.
1161 Optional third arg CONSOLE is the console to store in the event, and
1162 defaults to the selected console.
1164 If CH is an integer or character, the high bit may be interpreted as the
1165 meta key. (This is done for backward compatibility in lots of places.)
1166 If USE-CONSOLE-META-FLAG is nil, this will always be the case. If
1167 USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects
1168 whether the high bit is interpreted as a meta key. (See `set-input-mode'.)
1169 If you don't want this silly meta interpretation done, you should pass
1170 in a list containing the character.
1172 Beware that character-to-event and event-to-character are not strictly
1173 inverse functions, since events contain much more information than the
1174 ASCII character set can encode.
1176 (ch, event, console, use_console_meta_flag))
1178 struct console *con = decode_console (console);
1180 event = Fmake_event (Qnil, Qnil);
1182 CHECK_LIVE_EVENT (event);
1183 if (CONSP (ch) || SYMBOLP (ch))
1184 key_desc_list_to_event (ch, event, 1);
1187 CHECK_CHAR_COERCE_INT (ch);
1188 character_to_event (XCHAR (ch), XEVENT (event), con,
1189 !NILP (use_console_meta_flag), 1);
1195 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1197 assert (STRINGP (seq) || VECTORP (seq));
1198 assert (n < XINT (Flength (seq)));
1202 Emchar ch = string_char (XSTRING (seq), n);
1203 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1207 Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1208 if (EVENTP (keystroke))
1209 Fcopy_event (keystroke, event);
1211 Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1216 key_sequence_to_event_chain (Lisp_Object seq)
1218 int len = XINT (Flength (seq));
1220 Lisp_Object head = Qnil, tail = Qnil;
1222 for (i = 0; i < len; i++)
1224 Lisp_Object event = Fmake_event (Qnil, Qnil);
1225 nth_of_key_sequence_as_event (seq, i, event);
1226 enqueue_event (event, &head, &tail);
1233 format_event_object (char *buf, Lisp_Event *event, int brief)
1239 switch (event->event_type)
1241 case key_press_event:
1243 mod = event->event.key.modifiers;
1244 key = event->event.key.keysym;
1246 if (! brief && CHARP (key) &&
1247 mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER))
1249 int k = XCHAR (key);
1250 if (k >= 'a' && k <= 'z')
1251 key = make_char (k - ('a' - 'A'));
1252 else if (k >= 'A' && k <= 'Z')
1257 case button_release_event:
1260 case button_press_event:
1263 mod = event->event.button.modifiers;
1264 key = make_char (event->event.button.button + '0');
1269 const char *name = NULL;
1271 #ifdef HAVE_X_WINDOWS
1273 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1274 if (CONSOLE_X_P (XCONSOLE (console)))
1275 name = x_event_name (event->event.magic.underlying_x_event.type);
1277 #endif /* HAVE_X_WINDOWS */
1278 if (name) strcpy (buf, name);
1279 else strcpy (buf, "???");
1282 case magic_eval_event: strcpy (buf, "magic-eval"); return;
1283 case pointer_motion_event: strcpy (buf, "motion"); return;
1284 case misc_user_event: strcpy (buf, "misc-user"); return;
1285 case eval_event: strcpy (buf, "eval"); return;
1286 case process_event: strcpy (buf, "process"); return;
1287 case timeout_event: strcpy (buf, "timeout"); return;
1288 case empty_event: strcpy (buf, "empty"); return;
1289 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1293 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1294 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1295 if (mod & MOD_CONTROL) modprint ("control-", "C-");
1296 if (mod & MOD_META) modprint ("meta-", "M-");
1297 if (mod & MOD_SUPER) modprint ("super-", "S-");
1298 if (mod & MOD_HYPER) modprint ("hyper-", "H-");
1299 if (mod & MOD_ALT) modprint ("alt-", "A-");
1300 if (mod & MOD_SHIFT) modprint ("shift-", "Sh-");
1303 modprint1 ("button");
1312 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1315 else if (SYMBOLP (key))
1317 const char *str = 0;
1320 if (EQ (key, QKlinefeed)) str = "LFD";
1321 else if (EQ (key, QKtab)) str = "TAB";
1322 else if (EQ (key, QKreturn)) str = "RET";
1323 else if (EQ (key, QKescape)) str = "ESC";
1324 else if (EQ (key, QKdelete)) str = "DEL";
1325 else if (EQ (key, QKspace)) str = "SPC";
1326 else if (EQ (key, QKbackspace)) str = "BS";
1330 int i = strlen (str);
1331 memcpy (buf, str, i+1);
1336 Lisp_String *name = XSYMBOL (key)->name;
1337 memcpy (buf, string_data (name), string_length (name) + 1);
1338 str += string_length (name);
1344 strncpy (buf, "up", 4);
1347 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1348 True if OBJECT is an event object.
1352 return EVENTP (object) ? Qt : Qnil;
1355 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1356 True if OBJECT is an event object that has not been deallocated.
1360 return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1364 #if 0 /* debugging functions */
1366 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1367 Return the event object's `next' event, or nil if it has none.
1368 The `next-event' field is changed by calling `set-next-event'.
1373 CHECK_LIVE_EVENT (event);
1375 return XEVENT_NEXT (event);
1378 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1379 Set the `next event' of EVENT to NEXT-EVENT.
1380 NEXT-EVENT must be an event object or nil.
1382 (event, next_event))
1386 CHECK_LIVE_EVENT (event);
1387 if (NILP (next_event))
1389 XSET_EVENT_NEXT (event, Qnil);
1393 CHECK_LIVE_EVENT (next_event);
1395 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1399 signal_error (Qerror,
1400 list3 (build_string ("Cyclic event-next"),
1404 XSET_EVENT_NEXT (event, next_event);
1410 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1411 Return the type of EVENT.
1412 This will be a symbol; one of
1414 key-press A key was pressed.
1415 button-press A mouse button was pressed.
1416 button-release A mouse button was released.
1417 misc-user Some other user action happened; typically, this is
1418 a menu selection or scrollbar action.
1419 motion The mouse moved.
1420 process Input is available from a subprocess.
1421 timeout A timeout has expired.
1422 eval This causes a specified action to occur when dispatched.
1423 magic Some window-system-specific event has occurred.
1424 empty The event has been allocated but not assigned.
1429 CHECK_LIVE_EVENT (event);
1430 switch (XEVENT (event)->event_type)
1432 case key_press_event: return Qkey_press;
1433 case button_press_event: return Qbutton_press;
1434 case button_release_event: return Qbutton_release;
1435 case misc_user_event: return Qmisc_user;
1436 case pointer_motion_event: return Qmotion;
1437 case process_event: return Qprocess;
1438 case timeout_event: return Qtimeout;
1439 case eval_event: return Qeval;
1441 case magic_eval_event:
1453 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1454 Return the timestamp of the event object EVENT.
1458 CHECK_LIVE_EVENT (event);
1459 /* This junk is so that timestamps don't get to be negative, but contain
1460 as many bits as this particular emacs will allow.
1462 return make_int (((1L << (VALBITS - 1)) - 1) &
1463 XEVENT (event)->timestamp);
1466 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1467 CHECK_LIVE_EVENT (e); \
1468 if (XEVENT(e)->event_type != (t1)) \
1469 e = wrong_type_argument (sym,e); \
1472 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \
1473 CHECK_LIVE_EVENT (e); \
1475 emacs_event_type CET_type = XEVENT (e)->event_type; \
1476 if (CET_type != (t1) && \
1478 e = wrong_type_argument (sym,e); \
1482 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1483 CHECK_LIVE_EVENT (e); \
1485 emacs_event_type CET_type = XEVENT (e)->event_type; \
1486 if (CET_type != (t1) && \
1487 CET_type != (t2) && \
1489 e = wrong_type_argument (sym,e); \
1493 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1494 Return the Keysym of the key-press event EVENT.
1495 This will be a character if the event is associated with one, else a symbol.
1499 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1500 return XEVENT (event)->event.key.keysym;
1503 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1504 Return the button-number of the given button-press or button-release event.
1509 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1510 misc_user_event, Qbutton_event_p);
1511 #ifdef HAVE_WINDOW_SYSTEM
1512 if ( XEVENT (event)->event_type == misc_user_event)
1513 return make_int (XEVENT (event)->event.misc.button);
1515 return make_int (XEVENT (event)->event.button.button);
1516 #else /* !HAVE_WINDOW_SYSTEM */
1518 #endif /* !HAVE_WINDOW_SYSTEM */
1522 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1523 Return a number representing the modifier keys which were down
1524 when the given mouse or keyboard event was produced.
1525 See also the function event-modifiers.
1530 CHECK_LIVE_EVENT (event);
1531 switch (XEVENT (event)->event_type)
1533 case key_press_event:
1534 return make_int (XEVENT (event)->event.key.modifiers);
1535 case button_press_event:
1536 case button_release_event:
1537 return make_int (XEVENT (event)->event.button.modifiers);
1538 case pointer_motion_event:
1539 return make_int (XEVENT (event)->event.motion.modifiers);
1540 case misc_user_event:
1541 return make_int (XEVENT (event)->event.misc.modifiers);
1543 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1548 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1549 Return a list of symbols, the names of the modifier keys
1550 which were down when the given mouse or keyboard event was produced.
1551 See also the function event-modifier-bits.
1555 int mod = XINT (Fevent_modifier_bits (event));
1556 Lisp_Object result = Qnil;
1557 if (mod & MOD_SHIFT) result = Fcons (Qshift, result);
1558 if (mod & MOD_ALT) result = Fcons (Qalt, result);
1559 if (mod & MOD_HYPER) result = Fcons (Qhyper, result);
1560 if (mod & MOD_SUPER) result = Fcons (Qsuper, result);
1561 if (mod & MOD_META) result = Fcons (Qmeta, result);
1562 if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result);
1567 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1572 if (XEVENT (event)->event_type == pointer_motion_event)
1574 *x = XEVENT (event)->event.motion.x;
1575 *y = XEVENT (event)->event.motion.y;
1577 else if (XEVENT (event)->event_type == button_press_event ||
1578 XEVENT (event)->event_type == button_release_event)
1580 *x = XEVENT (event)->event.button.x;
1581 *y = XEVENT (event)->event.button.y;
1583 else if (XEVENT (event)->event_type == misc_user_event)
1585 *x = XEVENT (event)->event.misc.x;
1586 *y = XEVENT (event)->event.misc.y;
1591 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1595 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1598 return 1; /* #### What should really happen here. */
1600 *x -= w->pixel_left;
1605 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1606 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1607 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1608 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1614 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1615 Return the X position in pixels of mouse event EVENT.
1616 The value returned is relative to the window the event occurred in.
1617 This will signal an error if the event is not a mouse event.
1618 See also `mouse-event-p' and `event-x-pixel'.
1624 CHECK_LIVE_EVENT (event);
1626 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1627 return wrong_type_argument (Qmouse_event_p, event);
1629 return make_int (x);
1632 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1633 Return the Y position in pixels of mouse event EVENT.
1634 The value returned is relative to the window the event occurred in.
1635 This will signal an error if the event is not a mouse event.
1636 See also `mouse-event-p' and `event-y-pixel'.
1642 CHECK_LIVE_EVENT (event);
1644 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1645 return wrong_type_argument (Qmouse_event_p, event);
1647 return make_int (y);
1650 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1651 Return the X position in pixels of mouse event EVENT.
1652 The value returned is relative to the frame the event occurred in.
1653 This will signal an error if the event is not a mouse event.
1654 See also `mouse-event-p' and `event-window-x-pixel'.
1660 CHECK_LIVE_EVENT (event);
1662 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1663 return wrong_type_argument (Qmouse_event_p, event);
1665 return make_int (x);
1668 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1669 Return the Y position in pixels of mouse event EVENT.
1670 The value returned is relative to the frame the event occurred in.
1671 This will signal an error if the event is not a mouse event.
1672 See also `mouse-event-p' `event-window-y-pixel'.
1678 CHECK_LIVE_EVENT (event);
1680 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1681 return wrong_type_argument (Qmouse_event_p, event);
1683 return make_int (y);
1686 /* Given an event, return a value:
1688 OVER_TOOLBAR: over one of the 4 frame toolbars
1689 OVER_MODELINE: over a modeline
1690 OVER_BORDER: over an internal border
1691 OVER_NOTHING: over the text area, but not over text
1692 OVER_OUTSIDE: outside of the frame border
1693 OVER_TEXT: over text in the text area
1694 OVER_V_DIVIDER: over windows vertical divider
1698 The X char position in CHAR_X, if not a null pointer.
1699 The Y char position in CHAR_Y, if not a null pointer.
1700 (These last two values are relative to the window the event is over.)
1701 The window it's over in W, if not a null pointer.
1702 The buffer position it's over in BUFP, if not a null pointer.
1703 The closest buffer position in CLOSEST, if not a null pointer.
1705 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1709 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1710 int *obj_x, int *obj_y,
1711 struct window **w, Bufpos *bufp, Bufpos *closest,
1712 Charcount *modeline_closest,
1713 Lisp_Object *obj1, Lisp_Object *obj2)
1720 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1721 struct window *ret_w;
1722 Bufpos ret_bufp, ret_closest;
1723 Charcount ret_modeline_closest;
1724 Lisp_Object ret_obj1, ret_obj2;
1726 CHECK_LIVE_EVENT (event);
1727 frame = XEVENT (event)->channel;
1728 switch (XEVENT (event)->event_type)
1730 case pointer_motion_event :
1731 pix_x = XEVENT (event)->event.motion.x;
1732 pix_y = XEVENT (event)->event.motion.y;
1734 case button_press_event :
1735 case button_release_event :
1736 pix_x = XEVENT (event)->event.button.x;
1737 pix_y = XEVENT (event)->event.button.y;
1739 case misc_user_event :
1740 pix_x = XEVENT (event)->event.misc.x;
1741 pix_y = XEVENT (event)->event.misc.y;
1744 dead_wrong_type_argument (Qmouse_event_p, event);
1747 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1748 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1749 &ret_w, &ret_bufp, &ret_closest,
1750 &ret_modeline_closest,
1751 &ret_obj1, &ret_obj2);
1753 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1755 else if (ret_w && NILP (ret_w->buffer))
1756 /* Why does this happen? (Does it still happen?)
1757 I guess the window has gotten reused as a non-leaf... */
1760 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1761 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1762 pointer points to random memory, often filled with 0, sometimes not.
1764 /* #### Chuck, do we still need this crap? */
1765 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1766 #ifdef HAVE_TOOLBARS
1767 || TOOLBAR_BUTTONP (ret_obj1)
1771 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1787 *closest = ret_closest;
1788 if (modeline_closest)
1789 *modeline_closest = ret_modeline_closest;
1798 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1799 Return t if the mouse event EVENT occurred over the text area of a window.
1800 The modeline is not considered to be part of the text area.
1804 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1806 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1809 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1810 Return t if the mouse event EVENT occurred over the modeline of a window.
1814 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1816 return result == OVER_MODELINE ? Qt : Qnil;
1819 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1820 Return t if the mouse event EVENT occurred over an internal border.
1824 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1826 return result == OVER_BORDER ? Qt : Qnil;
1829 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1830 Return t if the mouse event EVENT occurred over a toolbar.
1834 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1836 return result == OVER_TOOLBAR ? Qt : Qnil;
1839 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1840 Return t if the mouse event EVENT occurred over a window divider.
1844 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1846 return result == OVER_V_DIVIDER ? Qt : Qnil;
1850 event_console_or_selected (Lisp_Object event)
1852 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1853 Lisp_Object console = CDFW_CONSOLE (channel);
1856 console = Vselected_console;
1858 return XCONSOLE (console);
1861 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1862 Return the channel that the event EVENT occurred on.
1863 This will be a frame, device, console, or nil for some types
1864 of events (e.g. eval events).
1868 CHECK_LIVE_EVENT (event);
1869 return EVENT_CHANNEL (XEVENT (event));
1872 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1873 Return the window over which mouse event EVENT occurred.
1874 This may be nil if the event occurred in the border or over a toolbar.
1875 The modeline is considered to be within the window it describes.
1881 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1889 XSETWINDOW (window, w);
1894 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1895 Return the character position of the mouse event EVENT.
1896 If the event did not occur over a window, or did not occur over text,
1897 then this returns nil. Otherwise, it returns a position in the buffer
1898 visible in the event's window.
1905 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1907 return w && bufp ? make_int (bufp) : Qnil;
1910 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1911 Return the character position closest to the mouse event EVENT.
1912 If the event did not occur over a window or over text, return the
1913 closest point to the location of the event. If the Y pixel position
1914 overlaps a window and the X pixel position is to the left of that
1915 window, the closest point is the beginning of the line containing the
1916 Y position. If the Y pixel position overlaps a window and the X pixel
1917 position is to the right of that window, the closest point is the end
1918 of the line containing the Y position. If the Y pixel position is
1919 above a window, return 0. If it is below the last character in a window,
1920 return the value of (window-end).
1926 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
1928 return bufp ? make_int (bufp) : Qnil;
1931 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
1932 Return the X position of the mouse event EVENT in characters.
1933 This is relative to the window the event occurred over.
1939 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1941 return make_int (char_x);
1944 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
1945 Return the Y position of the mouse event EVENT in characters.
1946 This is relative to the window the event occurred over.
1952 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
1954 return make_int (char_y);
1957 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
1958 Return the character position in the modeline that EVENT occurred over.
1959 EVENT should be a mouse event. If EVENT did not occur over a modeline,
1960 nil is returned. You can determine the actual character that the
1961 event occurred over by looking in `generated-modeline-string' at the
1962 returned character position. Note that `generated-modeline-string'
1963 is buffer-local, and you must use EVENT's buffer when retrieving
1964 `generated-modeline-string' in order to get accurate results.
1971 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
1973 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
1976 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
1977 Return the glyph that the mouse event EVENT occurred over, or nil.
1984 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
1986 return w && GLYPHP (glyph) ? glyph : Qnil;
1989 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
1990 Return the extent of the glyph that the mouse event EVENT occurred over.
1991 If the event did not occur over a glyph, nil is returned.
1998 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
2000 return w && EXTENTP (extent) ? extent : Qnil;
2003 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
2004 Return the X pixel position of EVENT relative to the glyph it occurred over.
2005 EVENT should be a mouse event. If the event did not occur over a glyph,
2014 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2016 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2019 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2020 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2021 EVENT should be a mouse event. If the event did not occur over a glyph,
2030 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2032 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2035 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2036 Return the toolbar button that the mouse event EVENT occurred over.
2037 If the event did not occur over a toolbar button, nil is returned.
2041 #ifdef HAVE_TOOLBARS
2044 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2046 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2052 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2053 Return the process of the given process-output event.
2057 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2058 return XEVENT (event)->event.process.process;
2061 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2062 Return the callback function of EVENT.
2063 EVENT should be a timeout, misc-user, or eval event.
2068 CHECK_LIVE_EVENT (event);
2069 switch (XEVENT (event)->event_type)
2072 return XEVENT (event)->event.timeout.function;
2073 case misc_user_event:
2074 return XEVENT (event)->event.misc.function;
2076 return XEVENT (event)->event.eval.function;
2078 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2083 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2084 Return the callback function argument of EVENT.
2085 EVENT should be a timeout, misc-user, or eval event.
2090 CHECK_LIVE_EVENT (event);
2091 switch (XEVENT (event)->event_type)
2094 return XEVENT (event)->event.timeout.object;
2095 case misc_user_event:
2096 return XEVENT (event)->event.misc.object;
2098 return XEVENT (event)->event.eval.object;
2100 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2105 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2106 Return a list of all of the properties of EVENT.
2107 This is in the form of a property list (alternating keyword/value pairs).
2111 Lisp_Object props = Qnil;
2113 struct gcpro gcpro1;
2115 CHECK_LIVE_EVENT (event);
2119 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2121 switch (e->event_type)
2126 props = cons3 (Qprocess, e->event.process.process, props);
2130 props = cons3 (Qobject, Fevent_object (event), props);
2131 props = cons3 (Qfunction, Fevent_function (event), props);
2132 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2135 case key_press_event:
2136 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2137 props = cons3 (Qkey, Fevent_key (event), props);
2140 case button_press_event:
2141 case button_release_event:
2142 props = cons3 (Qy, Fevent_y_pixel (event), props);
2143 props = cons3 (Qx, Fevent_x_pixel (event), props);
2144 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2145 props = cons3 (Qbutton, Fevent_button (event), props);
2148 case pointer_motion_event:
2149 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2150 props = cons3 (Qy, Fevent_y_pixel (event), props);
2151 props = cons3 (Qx, Fevent_x_pixel (event), props);
2154 case misc_user_event:
2155 props = cons3 (Qobject, Fevent_object (event), props);
2156 props = cons3 (Qfunction, Fevent_function (event), props);
2157 props = cons3 (Qy, Fevent_y_pixel (event), props);
2158 props = cons3 (Qx, Fevent_x_pixel (event), props);
2159 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2160 props = cons3 (Qbutton, Fevent_button (event), props);
2164 props = cons3 (Qobject, Fevent_object (event), props);
2165 props = cons3 (Qfunction, Fevent_function (event), props);
2168 case magic_eval_event:
2173 RETURN_UNGCPRO (Qnil);
2177 props = cons3 (Qchannel, Fevent_channel (event), props);
2184 /************************************************************************/
2185 /* initialization */
2186 /************************************************************************/
2189 syms_of_events (void)
2191 INIT_LRECORD_IMPLEMENTATION (event);
2193 DEFSUBR (Fcharacter_to_event);
2194 DEFSUBR (Fevent_to_character);
2196 DEFSUBR (Fmake_event);
2197 DEFSUBR (Fdeallocate_event);
2198 DEFSUBR (Fcopy_event);
2200 DEFSUBR (Fevent_live_p);
2201 DEFSUBR (Fevent_type);
2202 DEFSUBR (Fevent_properties);
2204 DEFSUBR (Fevent_timestamp);
2205 DEFSUBR (Fevent_key);
2206 DEFSUBR (Fevent_button);
2207 DEFSUBR (Fevent_modifier_bits);
2208 DEFSUBR (Fevent_modifiers);
2209 DEFSUBR (Fevent_x_pixel);
2210 DEFSUBR (Fevent_y_pixel);
2211 DEFSUBR (Fevent_window_x_pixel);
2212 DEFSUBR (Fevent_window_y_pixel);
2213 DEFSUBR (Fevent_over_text_area_p);
2214 DEFSUBR (Fevent_over_modeline_p);
2215 DEFSUBR (Fevent_over_border_p);
2216 DEFSUBR (Fevent_over_toolbar_p);
2217 DEFSUBR (Fevent_over_vertical_divider_p);
2218 DEFSUBR (Fevent_channel);
2219 DEFSUBR (Fevent_window);
2220 DEFSUBR (Fevent_point);
2221 DEFSUBR (Fevent_closest_point);
2224 DEFSUBR (Fevent_modeline_position);
2225 DEFSUBR (Fevent_glyph);
2226 DEFSUBR (Fevent_glyph_extent);
2227 DEFSUBR (Fevent_glyph_x_pixel);
2228 DEFSUBR (Fevent_glyph_y_pixel);
2229 DEFSUBR (Fevent_toolbar_button);
2230 DEFSUBR (Fevent_process);
2231 DEFSUBR (Fevent_function);
2232 DEFSUBR (Fevent_object);
2234 defsymbol (&Qeventp, "eventp");
2235 defsymbol (&Qevent_live_p, "event-live-p");
2236 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2237 defsymbol (&Qbutton_event_p, "button-event-p");
2238 defsymbol (&Qmouse_event_p, "mouse-event-p");
2239 defsymbol (&Qprocess_event_p, "process-event-p");
2240 defsymbol (&Qkey_press, "key-press");
2241 defsymbol (&Qbutton_press, "button-press");
2242 defsymbol (&Qbutton_release, "button-release");
2243 defsymbol (&Qmisc_user, "misc-user");
2244 defsymbol (&Qascii_character, "ascii-character");
2246 defsymbol (&QKbackspace, "backspace");
2247 defsymbol (&QKtab, "tab");
2248 defsymbol (&QKlinefeed, "linefeed");
2249 defsymbol (&QKreturn, "return");
2250 defsymbol (&QKescape, "escape");
2251 defsymbol (&QKspace, "space");
2252 defsymbol (&QKdelete, "delete");
2257 reinit_vars_of_events (void)
2259 Vevent_resource = Qnil;
2263 vars_of_events (void)
2265 reinit_vars_of_events ();
2267 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2268 A symbol used to look up the 8-bit character of a keysym.
2269 To convert a keysym symbol to an 8-bit code, as when that key is
2270 bound to self-insert-command, we will look up the property that this
2271 variable names on the property list of the keysym-symbol. The window-
2272 system-specific code will set up appropriate properties and set this
2275 Vcharacter_set_property = Qnil;