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"
40 #include "events-mod.h"
42 /* Where old events go when they are explicitly deallocated.
43 The event chain here is cut loose before GC, so these will be freed
46 static Lisp_Object Vevent_resource;
49 Lisp_Object Qevent_live_p;
50 Lisp_Object Qkey_press_event_p;
51 Lisp_Object Qbutton_event_p;
52 Lisp_Object Qmouse_event_p;
53 Lisp_Object Qprocess_event_p;
55 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
56 Lisp_Object Qascii_character;
58 EXFUN (Fevent_x_pixel, 1);
59 EXFUN (Fevent_y_pixel, 1);
61 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */
63 clear_event_resource (void)
65 Vevent_resource = Qnil;
68 /* Make sure we lose quickly if we try to use this event */
70 deinitialize_event (Lisp_Object ev)
73 Lisp_Event *event = XEVENT (ev);
75 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
76 ((int *) event) [i] = 0xdeadbeef;
77 event->event_type = dead_event;
78 event->channel = Qnil;
79 set_lheader_implementation (&event->lheader, &lrecord_event);
80 XSET_EVENT_NEXT (ev, Qnil);
83 /* Set everything to zero or nil so that it's predictable. */
85 zero_event (Lisp_Event *e)
88 set_lheader_implementation (&e->lheader, &lrecord_event);
89 e->event_type = empty_event;
95 mark_event (Lisp_Object obj)
97 Lisp_Event *event = XEVENT (obj);
99 switch (event->event_type)
101 case key_press_event:
102 mark_object (event->event.key.keysym);
105 mark_object (event->event.process.process);
108 mark_object (event->event.timeout.function);
109 mark_object (event->event.timeout.object);
112 case misc_user_event:
113 mark_object (event->event.eval.function);
114 mark_object (event->event.eval.object);
116 case magic_eval_event:
117 mark_object (event->event.magic_eval.object);
119 case button_press_event:
120 case button_release_event:
121 case pointer_motion_event:
129 mark_object (event->channel);
134 print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun)
137 write_c_string (str, printcharfun);
138 format_event_object (buf, XEVENT (obj), 0);
139 write_c_string (buf, printcharfun);
143 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
146 error ("Printing unreadable object #<event>");
148 switch (XEVENT (obj)->event_type)
150 case key_press_event:
151 print_event_1 ("#<keypress-event ", obj, printcharfun);
153 case button_press_event:
154 print_event_1 ("#<buttondown-event ", obj, printcharfun);
156 case button_release_event:
157 print_event_1 ("#<buttonup-event ", obj, printcharfun);
160 case magic_eval_event:
161 print_event_1 ("#<magic-event ", obj, printcharfun);
163 case pointer_motion_event:
167 Vx = Fevent_x_pixel (obj);
169 Vy = Fevent_y_pixel (obj);
171 sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
172 write_c_string (buf, printcharfun);
176 write_c_string ("#<process-event ", printcharfun);
177 print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
180 write_c_string ("#<timeout-event ", printcharfun);
181 print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
184 write_c_string ("#<empty-event", printcharfun);
186 case misc_user_event:
187 write_c_string ("#<misc-user-event (", printcharfun);
188 print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
189 write_c_string (" ", printcharfun);
190 print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
191 write_c_string (")", printcharfun);
194 write_c_string ("#<eval-event (", printcharfun);
195 print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
196 write_c_string (" ", printcharfun);
197 print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
198 write_c_string (")", printcharfun);
201 write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
204 write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
207 write_c_string (">", printcharfun);
211 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
213 Lisp_Event *e1 = XEVENT (obj1);
214 Lisp_Event *e2 = XEVENT (obj2);
216 if (e1->event_type != e2->event_type) return 0;
217 if (!EQ (e1->channel, e2->channel)) return 0;
218 /* if (e1->timestamp != e2->timestamp) return 0; */
219 switch (e1->event_type)
224 return EQ (e1->event.process.process, e2->event.process.process);
227 return (internal_equal (e1->event.timeout.function,
228 e2->event.timeout.function, 0) &&
229 internal_equal (e1->event.timeout.object,
230 e2->event.timeout.object, 0));
232 case key_press_event:
233 return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
234 (e1->event.key.modifiers == e2->event.key.modifiers));
236 case button_press_event:
237 case button_release_event:
238 return (e1->event.button.button == e2->event.button.button &&
239 e1->event.button.modifiers == e2->event.button.modifiers);
241 case pointer_motion_event:
242 return (e1->event.motion.x == e2->event.motion.x &&
243 e1->event.motion.y == e2->event.motion.y);
245 case misc_user_event:
246 return (internal_equal (e1->event.eval.function,
247 e2->event.eval.function, 0) &&
248 internal_equal (e1->event.eval.object,
249 e2->event.eval.object, 0) &&
250 /* is this really needed for equality
251 or is x and y also important? */
252 e1->event.misc.button == e2->event.misc.button &&
253 e1->event.misc.modifiers == e2->event.misc.modifiers);
256 return (internal_equal (e1->event.eval.function,
257 e2->event.eval.function, 0) &&
258 internal_equal (e1->event.eval.object,
259 e2->event.eval.object, 0));
261 case magic_eval_event:
262 return (e1->event.magic_eval.internal_function ==
263 e2->event.magic_eval.internal_function &&
264 internal_equal (e1->event.magic_eval.object,
265 e2->event.magic_eval.object, 0));
269 struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
271 #ifdef HAVE_X_WINDOWS
272 if (CONSOLE_X_P (con))
273 return (e1->event.magic.underlying_x_event.xany.serial ==
274 e2->event.magic.underlying_x_event.xany.serial);
277 if (CONSOLE_TTY_P (con))
278 return (e1->event.magic.underlying_tty_event ==
279 e2->event.magic.underlying_tty_event);
281 #ifdef HAVE_MS_WINDOWS
282 if (CONSOLE_MSWINDOWS_P (con))
283 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
284 &e2->event.magic.underlying_mswindows_event,
285 sizeof (union magic_data)));
288 return 1; /* not reached */
291 case empty_event: /* Empty and deallocated events are equal. */
298 event_hash (Lisp_Object obj, int depth)
300 Lisp_Event *e = XEVENT (obj);
303 hash = HASH2 (e->event_type, LISP_HASH (e->channel));
304 switch (e->event_type)
307 return HASH2 (hash, LISP_HASH (e->event.process.process));
310 return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
311 internal_hash (e->event.timeout.object, depth + 1));
313 case key_press_event:
314 return HASH3 (hash, LISP_HASH (e->event.key.keysym),
315 e->event.key.modifiers);
317 case button_press_event:
318 case button_release_event:
319 return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
321 case pointer_motion_event:
322 return HASH3 (hash, e->event.motion.x, e->event.motion.y);
324 case misc_user_event:
325 return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
326 internal_hash (e->event.misc.object, depth + 1),
327 e->event.misc.button, e->event.misc.modifiers);
330 return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
331 internal_hash (e->event.eval.object, depth + 1));
333 case magic_eval_event:
335 (unsigned long) e->event.magic_eval.internal_function,
336 internal_hash (e->event.magic_eval.object, depth + 1));
340 struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
341 #ifdef HAVE_X_WINDOWS
342 if (CONSOLE_X_P (con))
343 return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
346 if (CONSOLE_TTY_P (con))
347 return HASH2 (hash, e->event.magic.underlying_tty_event);
349 #ifdef HAVE_MS_WINDOWS
350 if (CONSOLE_MSWINDOWS_P (con))
351 return HASH2 (hash, e->event.magic.underlying_mswindows_event);
365 return 0; /* unreached */
368 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
369 mark_event, print_event, 0, event_equal,
370 event_hash, 0, Lisp_Event);
373 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
374 Return a new event of type TYPE, with properties described by PLIST.
376 TYPE is a symbol, either `empty', `key-press', `button-press',
377 `button-release', `misc-user' or `motion'. If TYPE is nil, it
380 PLIST is a property list, the properties being compatible to those
381 returned by `event-properties'. The following properties are
384 channel -- The event channel, a frame or a console. For
385 button-press, button-release, misc-user and motion events,
386 this must be a frame. For key-press events, it must be
387 a console. If channel is unspecified, it will be set to
388 the selected frame or selected console, as appropriate.
389 key -- The event key, a symbol or character. Allowed only for
391 button -- The event button, integer 1, 2 or 3. Allowed for
392 button-press, button-release and misc-user events.
393 modifiers -- The event modifiers, a list of modifier symbols. Allowed
394 for key-press, button-press, button-release, motion and
396 function -- Function. Allowed for misc-user events only.
397 object -- An object, function's parameter. Allowed for misc-user
399 x -- The event X coordinate, an integer. This is relative
400 to the left of CHANNEL's root window. Allowed for
401 motion, button-press, button-release and misc-user events.
402 y -- The event Y coordinate, an integer. This is relative
403 to the top of CHANNEL's root window. Allowed for
404 motion, button-press, button-release and misc-user events.
405 timestamp -- The event timestamp, a non-negative integer. Allowed for
406 all types of events. If unspecified, it will be set to 0
409 For event type `empty', PLIST must be nil.
410 `button-release', or `motion'. If TYPE is left out, it defaults to
412 PLIST is a list of properties, as returned by `event-properties'. Not
413 all properties are allowed for all kinds of events, and some are
416 WARNING: the event object returned may be a reused one; see the function
421 Lisp_Object tail, keyword, value;
422 Lisp_Object event = Qnil;
424 EMACS_INT coord_x = 0, coord_y = 0;
432 if (!NILP (Vevent_resource))
434 event = Vevent_resource;
435 Vevent_resource = XEVENT_NEXT (event);
439 event = allocate_event ();
444 if (EQ (type, Qempty))
446 /* For empty event, we return immediately, without processing
447 PLIST. In fact, processing PLIST would be wrong, because the
448 sanitizing process would fill in the properties
449 (e.g. CHANNEL), which we don't want in empty events. */
450 e->event_type = empty_event;
452 error ("Cannot set properties of empty event");
456 else if (EQ (type, Qkey_press))
458 e->event_type = key_press_event;
459 e->event.key.keysym = Qunbound;
461 else if (EQ (type, Qbutton_press))
462 e->event_type = button_press_event;
463 else if (EQ (type, Qbutton_release))
464 e->event_type = button_release_event;
465 else if (EQ (type, Qmotion))
466 e->event_type = pointer_motion_event;
467 else if (EQ (type, Qmisc_user))
469 e->event_type = misc_user_event;
470 e->event.eval.function = e->event.eval.object = Qnil;
474 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
475 signal_simple_error ("Invalid event type", type);
478 EVENT_CHANNEL (e) = Qnil;
480 plist = Fcopy_sequence (plist);
481 Fcanonicalize_plist (plist, Qnil);
483 #define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \
484 error_with_frob (prop, "Invalid property for %s event", \
485 string_data (symbol_name (XSYMBOL (type))))
487 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist)
489 if (EQ (keyword, Qchannel))
491 if (e->event_type == key_press_event)
493 if (!CONSOLEP (value))
494 value = wrong_type_argument (Qconsolep, value);
499 value = wrong_type_argument (Qframep, value);
501 EVENT_CHANNEL (e) = value;
503 else if (EQ (keyword, Qkey))
505 switch (e->event_type)
507 case key_press_event:
508 if (!SYMBOLP (value) && !CHARP (value))
509 signal_simple_error ("Invalid event key", value);
510 e->event.key.keysym = value;
513 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
517 else if (EQ (keyword, Qbutton))
519 CHECK_NATNUM (value);
520 check_int_range (XINT (value), 0, 7);
522 switch (e->event_type)
524 case button_press_event:
525 case button_release_event:
526 e->event.button.button = XINT (value);
528 case misc_user_event:
529 e->event.misc.button = XINT (value);
532 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
536 else if (EQ (keyword, Qmodifiers))
541 EXTERNAL_LIST_LOOP_2 (sym, value)
543 if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL;
544 else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META;
545 else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER;
546 else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER;
547 else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT;
548 else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT;
549 else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT;
551 signal_simple_error ("Invalid key modifier", sym);
554 switch (e->event_type)
556 case key_press_event:
557 e->event.key.modifiers = modifiers;
559 case button_press_event:
560 case button_release_event:
561 e->event.button.modifiers = modifiers;
563 case pointer_motion_event:
564 e->event.motion.modifiers = modifiers;
566 case misc_user_event:
567 e->event.misc.modifiers = modifiers;
570 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
574 else if (EQ (keyword, Qx))
576 switch (e->event_type)
578 case pointer_motion_event:
579 case button_press_event:
580 case button_release_event:
581 case misc_user_event:
582 /* Allow negative values, so we can specify toolbar
585 coord_x = XINT (value);
588 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
592 else if (EQ (keyword, Qy))
594 switch (e->event_type)
596 case pointer_motion_event:
597 case button_press_event:
598 case button_release_event:
599 case misc_user_event:
600 /* Allow negative values; see above. */
602 coord_y = XINT (value);
605 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
609 else if (EQ (keyword, Qtimestamp))
611 CHECK_NATNUM (value);
612 e->timestamp = XINT (value);
614 else if (EQ (keyword, Qfunction))
616 switch (e->event_type)
618 case misc_user_event:
619 e->event.eval.function = value;
622 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
626 else if (EQ (keyword, Qobject))
628 switch (e->event_type)
630 case misc_user_event:
631 e->event.eval.object = value;
634 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
639 signal_simple_error_2 ("Invalid property", keyword, value);
642 /* Insert the channel, if missing. */
643 if (NILP (EVENT_CHANNEL (e)))
645 if (e->event_type == key_press_event)
646 EVENT_CHANNEL (e) = Vselected_console;
648 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
651 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
652 to the frame, so we must adjust accordingly. */
653 if (FRAMEP (EVENT_CHANNEL (e)))
655 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
656 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
658 switch (e->event_type)
660 case pointer_motion_event:
661 e->event.motion.x = coord_x;
662 e->event.motion.y = coord_y;
664 case button_press_event:
665 case button_release_event:
666 e->event.button.x = coord_x;
667 e->event.button.y = coord_y;
669 case misc_user_event:
670 e->event.misc.x = coord_x;
671 e->event.misc.y = coord_y;
678 /* Finally, do some more validation. */
679 switch (e->event_type)
681 case key_press_event:
682 if (UNBOUNDP (e->event.key.keysym))
683 error ("A key must be specified to make a keypress event");
685 case button_press_event:
686 if (!e->event.button.button)
687 error ("A button must be specified to make a button-press event");
689 case button_release_event:
690 if (!e->event.button.button)
691 error ("A button must be specified to make a button-release event");
693 case misc_user_event:
694 if (NILP (e->event.misc.function))
695 error ("A function must be specified to make a misc-user event");
705 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
706 Allow the given event structure to be reused.
707 You MUST NOT use this event object after calling this function with it.
708 You will lose. It is not necessary to call this function, as event
709 objects are garbage-collected like all other objects; however, it may
710 be more efficient to explicitly deallocate events when you are sure
711 that it is safe to do so.
717 if (XEVENT_TYPE (event) == dead_event)
718 error ("this event is already deallocated!");
720 assert (XEVENT_TYPE (event) <= last_event_type);
726 if (EQ (event, Vlast_command_event) ||
727 EQ (event, Vlast_input_event) ||
728 EQ (event, Vunread_command_event))
731 len = XVECTOR_LENGTH (Vthis_command_keys);
732 for (i = 0; i < len; i++)
733 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
735 if (!NILP (Vrecent_keys_ring))
737 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
738 for (i = 0; i < recent_ring_len; i++)
739 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
745 assert (!EQ (event, Vevent_resource));
746 deinitialize_event (event);
747 #ifndef ALLOC_NO_POOLS
748 XSET_EVENT_NEXT (event, Vevent_resource);
749 Vevent_resource = event;
754 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
755 Make a copy of the given event object.
756 If a second argument is given, the first event is copied into the second
757 and the second is returned. If the second argument is not supplied (or
758 is nil) then a new event will be made as with `make-event'. See also
759 the function `deallocate-event'.
763 CHECK_LIVE_EVENT (event1);
765 event2 = Fmake_event (Qnil, Qnil);
768 CHECK_LIVE_EVENT (event2);
769 if (EQ (event1, event2))
770 return signal_simple_continuable_error_2
771 ("copy-event called with `eq' events", event1, event2);
774 assert (XEVENT_TYPE (event1) <= last_event_type);
775 assert (XEVENT_TYPE (event2) <= last_event_type);
778 Lisp_Event *ev2 = XEVENT (event2);
779 Lisp_Event *ev1 = XEVENT (event1);
781 ev2->event_type = ev1->event_type;
782 ev2->channel = ev1->channel;
783 ev2->timestamp = ev1->timestamp;
784 ev2->event = ev1->event;
792 /* Given a chain of events (or possibly nil), deallocate them all. */
795 deallocate_event_chain (Lisp_Object event_chain)
797 while (!NILP (event_chain))
799 Lisp_Object next = XEVENT_NEXT (event_chain);
800 Fdeallocate_event (event_chain);
805 /* Return the last event in a chain.
806 NOTE: You cannot pass nil as a value here! The routine will
810 event_chain_tail (Lisp_Object event_chain)
814 Lisp_Object next = XEVENT_NEXT (event_chain);
821 /* Enqueue a single event onto the end of a chain of events.
822 HEAD points to the first event in the chain, TAIL to the last event.
823 If the chain is empty, both values should be nil. */
826 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
828 assert (NILP (XEVENT_NEXT (event)));
829 assert (!EQ (*tail, event));
832 XSET_EVENT_NEXT (*tail, event);
837 assert (!EQ (event, XEVENT_NEXT (event)));
840 /* Remove an event off the head of a chain of events and return it.
841 HEAD points to the first event in the chain, TAIL to the last event. */
844 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
849 *head = XEVENT_NEXT (event);
850 XSET_EVENT_NEXT (event, Qnil);
856 /* Enqueue a chain of events (or possibly nil) onto the end of another
857 chain of events. HEAD points to the first event in the chain being
858 queued onto, TAIL to the last event. If the chain is empty, both values
862 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
865 if (NILP (event_chain))
875 XSET_EVENT_NEXT (*tail, event_chain);
876 *tail = event_chain_tail (event_chain);
880 /* Return the number of events (possibly 0) on an event chain. */
883 event_chain_count (Lisp_Object event_chain)
888 EVENT_CHAIN_LOOP (event, event_chain)
894 /* Find the event before EVENT in an event chain. This aborts
895 if the event is not in the chain. */
898 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
900 Lisp_Object previous = Qnil;
902 while (!NILP (event_chain))
904 if (EQ (event_chain, event))
906 previous = event_chain;
907 event_chain = XEVENT_NEXT (event_chain);
915 event_chain_nth (Lisp_Object event_chain, int n)
918 EVENT_CHAIN_LOOP (event, event_chain)
928 copy_event_chain (Lisp_Object event_chain)
930 Lisp_Object new_chain = Qnil;
931 Lisp_Object new_chain_tail = Qnil;
934 EVENT_CHAIN_LOOP (event, event_chain)
936 Lisp_Object copy = Fcopy_event (event, Qnil);
937 enqueue_event (copy, &new_chain, &new_chain_tail);
945 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
949 command_event_p (Lisp_Object event)
951 switch (XEVENT_TYPE (event))
953 case key_press_event:
954 case button_press_event:
955 case button_release_event:
956 case misc_user_event:
965 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
966 int use_console_meta_flag, int do_backspace_mapping)
968 Lisp_Object k = Qnil;
970 if (event->event_type == dead_event)
971 error ("character-to-event called with a deallocated event!");
976 if (c > 127 && c <= 255)
979 if (use_console_meta_flag && CONSOLE_TTY_P (con))
980 meta_flag = TTY_FLAGS (con).meta_key;
983 case 0: /* ignore top bit; it's parity */
986 case 1: /* top bit is meta */
990 default: /* this is a real character */
994 if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL;
995 if (m & XEMACS_MOD_CONTROL)
999 case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break;
1000 case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break;
1001 case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break;
1002 case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break;
1004 #if defined(HAVE_TTY)
1005 if (do_backspace_mapping &&
1006 CHARP (con->tty_erase_char) &&
1007 c - '@' == XCHAR (con->tty_erase_char))
1010 m &= ~XEMACS_MOD_CONTROL;
1012 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1015 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1017 #if defined(HAVE_TTY)
1018 else if (do_backspace_mapping &&
1019 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1021 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */
1027 event->event_type = key_press_event;
1028 event->timestamp = 0; /* #### */
1029 event->channel = make_console (con);
1030 event->event.key.keysym = (!NILP (k) ? k : make_char (c));
1031 event->event.key.modifiers = m;
1034 /* This variable controls what character name -> character code mapping
1035 we are using. Window-system-specific code sets this to some symbol,
1036 and we use that symbol as the plist key to convert keysyms into 8-bit
1037 codes. In this way one can have several character sets predefined and
1038 switch them by changing this.
1040 #### This is utterly bogus and should be removed.
1042 Lisp_Object Vcharacter_set_property;
1045 event_to_character (Lisp_Event *event,
1046 int allow_extra_modifiers,
1048 int allow_non_ascii)
1053 if (event->event_type != key_press_event)
1055 assert (event->event_type != dead_event);
1058 if (!allow_extra_modifiers &&
1059 event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_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 & XEMACS_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 & XEMACS_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, 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 & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_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')
1242 mod |= XEMACS_MOD_SHIFT;
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 & XEMACS_MOD_CONTROL) modprint ("control-", "C-");
1285 if (mod & XEMACS_MOD_META) modprint ("meta-", "M-");
1286 if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-");
1287 if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-");
1288 if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-");
1289 if (mod & XEMACS_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 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'.
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); \
1464 emacs_event_type CET_type = XEVENT (e)->event_type; \
1465 if (CET_type != (t1) && \
1467 e = wrong_type_argument (sym,e); \
1471 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \
1472 CHECK_LIVE_EVENT (e); \
1474 emacs_event_type CET_type = XEVENT (e)->event_type; \
1475 if (CET_type != (t1) && \
1476 CET_type != (t2) && \
1478 e = wrong_type_argument (sym,e); \
1482 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1483 Return the Keysym of the key-press event EVENT.
1484 This will be a character if the event is associated with one, else a symbol.
1488 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1489 return XEVENT (event)->event.key.keysym;
1492 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1493 Return the button-number of the given button-press or button-release event.
1498 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1499 misc_user_event, Qbutton_event_p);
1500 #ifdef HAVE_WINDOW_SYSTEM
1501 if ( XEVENT (event)->event_type == misc_user_event)
1502 return make_int (XEVENT (event)->event.misc.button);
1504 return make_int (XEVENT (event)->event.button.button);
1505 #else /* !HAVE_WINDOW_SYSTEM */
1507 #endif /* !HAVE_WINDOW_SYSTEM */
1511 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1512 Return a number representing the modifier keys which were down
1513 when the given mouse or keyboard event was produced.
1514 See also the function event-modifiers.
1519 CHECK_LIVE_EVENT (event);
1520 switch (XEVENT (event)->event_type)
1522 case key_press_event:
1523 return make_int (XEVENT (event)->event.key.modifiers);
1524 case button_press_event:
1525 case button_release_event:
1526 return make_int (XEVENT (event)->event.button.modifiers);
1527 case pointer_motion_event:
1528 return make_int (XEVENT (event)->event.motion.modifiers);
1529 case misc_user_event:
1530 return make_int (XEVENT (event)->event.misc.modifiers);
1532 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1537 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1538 Return a list of symbols, the names of the modifier keys
1539 which were down when the given mouse or keyboard event was produced.
1540 See also the function event-modifier-bits.
1544 int mod = XINT (Fevent_modifier_bits (event));
1545 Lisp_Object result = Qnil;
1546 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result);
1547 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result);
1548 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result);
1549 if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result);
1550 if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result);
1551 if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result);
1556 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1561 if (XEVENT (event)->event_type == pointer_motion_event)
1563 *x = XEVENT (event)->event.motion.x;
1564 *y = XEVENT (event)->event.motion.y;
1566 else if (XEVENT (event)->event_type == button_press_event ||
1567 XEVENT (event)->event_type == button_release_event)
1569 *x = XEVENT (event)->event.button.x;
1570 *y = XEVENT (event)->event.button.y;
1572 else if (XEVENT (event)->event_type == misc_user_event)
1574 *x = XEVENT (event)->event.misc.x;
1575 *y = XEVENT (event)->event.misc.y;
1580 f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1584 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1587 return 1; /* #### What should really happen here. */
1589 *x -= w->pixel_left;
1594 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1595 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1596 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1597 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1603 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1604 Return the X position in pixels of mouse event EVENT.
1605 The value returned is relative to the window the event occurred in.
1606 This will signal an error if the event is not a mouse event.
1607 See also `mouse-event-p' and `event-x-pixel'.
1613 CHECK_LIVE_EVENT (event);
1615 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1616 return wrong_type_argument (Qmouse_event_p, event);
1618 return make_int (x);
1621 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1622 Return the Y position in pixels of mouse event EVENT.
1623 The value returned is relative to the window the event occurred in.
1624 This will signal an error if the event is not a mouse event.
1625 See also `mouse-event-p' and `event-y-pixel'.
1631 CHECK_LIVE_EVENT (event);
1633 if (!event_x_y_pixel_internal (event, &x, &y, 1))
1634 return wrong_type_argument (Qmouse_event_p, event);
1636 return make_int (y);
1639 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1640 Return the X position in pixels of mouse event EVENT.
1641 The value returned is relative to the frame the event occurred in.
1642 This will signal an error if the event is not a mouse event.
1643 See also `mouse-event-p' and `event-window-x-pixel'.
1649 CHECK_LIVE_EVENT (event);
1651 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1652 return wrong_type_argument (Qmouse_event_p, event);
1654 return make_int (x);
1657 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1658 Return the Y position in pixels of mouse event EVENT.
1659 The value returned is relative to the frame the event occurred in.
1660 This will signal an error if the event is not a mouse event.
1661 See also `mouse-event-p' `event-window-y-pixel'.
1667 CHECK_LIVE_EVENT (event);
1669 if (!event_x_y_pixel_internal (event, &x, &y, 0))
1670 return wrong_type_argument (Qmouse_event_p, event);
1672 return make_int (y);
1675 /* Given an event, return a value:
1677 OVER_TOOLBAR: over one of the 4 frame toolbars
1678 OVER_MODELINE: over a modeline
1679 OVER_BORDER: over an internal border
1680 OVER_NOTHING: over the text area, but not over text
1681 OVER_OUTSIDE: outside of the frame border
1682 OVER_TEXT: over text in the text area
1683 OVER_V_DIVIDER: over windows vertical divider
1687 The X char position in CHAR_X, if not a null pointer.
1688 The Y char position in CHAR_Y, if not a null pointer.
1689 (These last two values are relative to the window the event is over.)
1690 The window it's over in W, if not a null pointer.
1691 The buffer position it's over in BUFP, if not a null pointer.
1692 The closest buffer position in CLOSEST, if not a null pointer.
1694 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1698 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1699 int *obj_x, int *obj_y,
1700 struct window **w, Bufpos *bufp, Bufpos *closest,
1701 Charcount *modeline_closest,
1702 Lisp_Object *obj1, Lisp_Object *obj2)
1709 int ret_x, ret_y, ret_obj_x, ret_obj_y;
1710 struct window *ret_w;
1711 Bufpos ret_bufp, ret_closest;
1712 Charcount ret_modeline_closest;
1713 Lisp_Object ret_obj1, ret_obj2;
1715 CHECK_LIVE_EVENT (event);
1716 frame = XEVENT (event)->channel;
1717 switch (XEVENT (event)->event_type)
1719 case pointer_motion_event :
1720 pix_x = XEVENT (event)->event.motion.x;
1721 pix_y = XEVENT (event)->event.motion.y;
1723 case button_press_event :
1724 case button_release_event :
1725 pix_x = XEVENT (event)->event.button.x;
1726 pix_y = XEVENT (event)->event.button.y;
1728 case misc_user_event :
1729 pix_x = XEVENT (event)->event.misc.x;
1730 pix_y = XEVENT (event)->event.misc.y;
1733 dead_wrong_type_argument (Qmouse_event_p, event);
1736 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1737 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1738 &ret_w, &ret_bufp, &ret_closest,
1739 &ret_modeline_closest,
1740 &ret_obj1, &ret_obj2);
1742 if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1744 else if (ret_w && NILP (ret_w->buffer))
1745 /* Why does this happen? (Does it still happen?)
1746 I guess the window has gotten reused as a non-leaf... */
1749 /* #### pixel_to_glyph_translation() sometimes returns garbage...
1750 The word has type Lisp_Type_Record (presumably meaning `extent') but the
1751 pointer points to random memory, often filled with 0, sometimes not.
1753 /* #### Chuck, do we still need this crap? */
1754 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1755 #ifdef HAVE_TOOLBARS
1756 || TOOLBAR_BUTTONP (ret_obj1)
1760 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1776 *closest = ret_closest;
1777 if (modeline_closest)
1778 *modeline_closest = ret_modeline_closest;
1787 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1788 Return t if the mouse event EVENT occurred over the text area of a window.
1789 The modeline is not considered to be part of the text area.
1793 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1795 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1798 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1799 Return t if the mouse event EVENT occurred over the modeline of a window.
1803 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1805 return result == OVER_MODELINE ? Qt : Qnil;
1808 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1809 Return t if the mouse event EVENT occurred over an internal border.
1813 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1815 return result == OVER_BORDER ? Qt : Qnil;
1818 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1819 Return t if the mouse event EVENT occurred over a toolbar.
1823 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1825 return result == OVER_TOOLBAR ? Qt : Qnil;
1828 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1829 Return t if the mouse event EVENT occurred over a window divider.
1833 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1835 return result == OVER_V_DIVIDER ? Qt : Qnil;
1839 event_console_or_selected (Lisp_Object event)
1841 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1842 Lisp_Object console = CDFW_CONSOLE (channel);
1845 console = Vselected_console;
1847 return XCONSOLE (console);
1850 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1851 Return the channel that the event EVENT occurred on.
1852 This will be a frame, device, console, or nil for some types
1853 of events (e.g. eval events).
1857 CHECK_LIVE_EVENT (event);
1858 return EVENT_CHANNEL (XEVENT (event));
1861 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1862 Return the window over which mouse event EVENT occurred.
1863 This may be nil if the event occurred in the border or over a toolbar.
1864 The modeline is considered to be within the window it describes.
1870 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1878 XSETWINDOW (window, w);
1883 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1884 Return the character position of the mouse event EVENT.
1885 If the event did not occur over a window, or did not occur over text,
1886 then this returns nil. Otherwise, it returns a position in the buffer
1887 visible in the event's window.
1894 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1896 return w && bufp ? make_int (bufp) : Qnil;
1899 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
1900 Return the character position closest to the mouse event EVENT.
1901 If the event did not occur over a window or over text, return the
1902 closest point to the location of the event. If the Y pixel position
1903 overlaps a window and the X pixel position is to the left of that
1904 window, the closest point is the beginning of the line containing the
1905 Y position. If the Y pixel position overlaps a window and the X pixel
1906 position is to the right of that window, the closest point is the end
1907 of the line containing the Y position. If the Y pixel position is
1908 above a window, return 0. If it is below the last character in a window,
1909 return the value of (window-end).
1915 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
1917 return bufp ? make_int (bufp) : Qnil;
1920 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
1921 Return the X position of the mouse event EVENT in characters.
1922 This is relative to the window the event occurred over.
1928 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1930 return make_int (char_x);
1933 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
1934 Return the Y position of the mouse event EVENT in characters.
1935 This is relative to the window the event occurred over.
1941 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
1943 return make_int (char_y);
1946 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
1947 Return the character position in the modeline that EVENT occurred over.
1948 EVENT should be a mouse event. If EVENT did not occur over a modeline,
1949 nil is returned. You can determine the actual character that the
1950 event occurred over by looking in `generated-modeline-string' at the
1951 returned character position. Note that `generated-modeline-string'
1952 is buffer-local, and you must use EVENT's buffer when retrieving
1953 `generated-modeline-string' in order to get accurate results.
1960 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
1962 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
1965 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
1966 Return the glyph that the mouse event EVENT occurred over, or nil.
1973 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
1975 return w && GLYPHP (glyph) ? glyph : Qnil;
1978 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
1979 Return the extent of the glyph that the mouse event EVENT occurred over.
1980 If the event did not occur over a glyph, nil is returned.
1987 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
1989 return w && EXTENTP (extent) ? extent : Qnil;
1992 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
1993 Return the X pixel position of EVENT relative to the glyph it occurred over.
1994 EVENT should be a mouse event. If the event did not occur over a glyph,
2003 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2005 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2008 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2009 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2010 EVENT should be a mouse event. If the event did not occur over a glyph,
2019 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2021 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2024 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2025 Return the toolbar button that the mouse event EVENT occurred over.
2026 If the event did not occur over a toolbar button, nil is returned.
2030 #ifdef HAVE_TOOLBARS
2033 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2035 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2041 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2042 Return the process of the given process-output event.
2046 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2047 return XEVENT (event)->event.process.process;
2050 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2051 Return the callback function of EVENT.
2052 EVENT should be a timeout, misc-user, or eval event.
2057 CHECK_LIVE_EVENT (event);
2058 switch (XEVENT (event)->event_type)
2061 return XEVENT (event)->event.timeout.function;
2062 case misc_user_event:
2063 return XEVENT (event)->event.misc.function;
2065 return XEVENT (event)->event.eval.function;
2067 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2072 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2073 Return the callback function argument of EVENT.
2074 EVENT should be a timeout, misc-user, or eval event.
2079 CHECK_LIVE_EVENT (event);
2080 switch (XEVENT (event)->event_type)
2083 return XEVENT (event)->event.timeout.object;
2084 case misc_user_event:
2085 return XEVENT (event)->event.misc.object;
2087 return XEVENT (event)->event.eval.object;
2089 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2094 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2095 Return a list of all of the properties of EVENT.
2096 This is in the form of a property list (alternating keyword/value pairs).
2100 Lisp_Object props = Qnil;
2102 struct gcpro gcpro1;
2104 CHECK_LIVE_EVENT (event);
2108 props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2110 switch (e->event_type)
2115 props = cons3 (Qprocess, e->event.process.process, props);
2119 props = cons3 (Qobject, Fevent_object (event), props);
2120 props = cons3 (Qfunction, Fevent_function (event), props);
2121 props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2124 case key_press_event:
2125 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2126 props = cons3 (Qkey, Fevent_key (event), props);
2129 case button_press_event:
2130 case button_release_event:
2131 props = cons3 (Qy, Fevent_y_pixel (event), props);
2132 props = cons3 (Qx, Fevent_x_pixel (event), props);
2133 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2134 props = cons3 (Qbutton, Fevent_button (event), props);
2137 case pointer_motion_event:
2138 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2139 props = cons3 (Qy, Fevent_y_pixel (event), props);
2140 props = cons3 (Qx, Fevent_x_pixel (event), props);
2143 case misc_user_event:
2144 props = cons3 (Qobject, Fevent_object (event), props);
2145 props = cons3 (Qfunction, Fevent_function (event), props);
2146 props = cons3 (Qy, Fevent_y_pixel (event), props);
2147 props = cons3 (Qx, Fevent_x_pixel (event), props);
2148 props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2149 props = cons3 (Qbutton, Fevent_button (event), props);
2153 props = cons3 (Qobject, Fevent_object (event), props);
2154 props = cons3 (Qfunction, Fevent_function (event), props);
2157 case magic_eval_event:
2162 RETURN_UNGCPRO (Qnil);
2166 props = cons3 (Qchannel, Fevent_channel (event), props);
2173 /************************************************************************/
2174 /* initialization */
2175 /************************************************************************/
2178 syms_of_events (void)
2180 INIT_LRECORD_IMPLEMENTATION (event);
2182 DEFSUBR (Fcharacter_to_event);
2183 DEFSUBR (Fevent_to_character);
2185 DEFSUBR (Fmake_event);
2186 DEFSUBR (Fdeallocate_event);
2187 DEFSUBR (Fcopy_event);
2189 DEFSUBR (Fevent_live_p);
2190 DEFSUBR (Fevent_type);
2191 DEFSUBR (Fevent_properties);
2193 DEFSUBR (Fevent_timestamp);
2194 DEFSUBR (Fevent_key);
2195 DEFSUBR (Fevent_button);
2196 DEFSUBR (Fevent_modifier_bits);
2197 DEFSUBR (Fevent_modifiers);
2198 DEFSUBR (Fevent_x_pixel);
2199 DEFSUBR (Fevent_y_pixel);
2200 DEFSUBR (Fevent_window_x_pixel);
2201 DEFSUBR (Fevent_window_y_pixel);
2202 DEFSUBR (Fevent_over_text_area_p);
2203 DEFSUBR (Fevent_over_modeline_p);
2204 DEFSUBR (Fevent_over_border_p);
2205 DEFSUBR (Fevent_over_toolbar_p);
2206 DEFSUBR (Fevent_over_vertical_divider_p);
2207 DEFSUBR (Fevent_channel);
2208 DEFSUBR (Fevent_window);
2209 DEFSUBR (Fevent_point);
2210 DEFSUBR (Fevent_closest_point);
2213 DEFSUBR (Fevent_modeline_position);
2214 DEFSUBR (Fevent_glyph);
2215 DEFSUBR (Fevent_glyph_extent);
2216 DEFSUBR (Fevent_glyph_x_pixel);
2217 DEFSUBR (Fevent_glyph_y_pixel);
2218 DEFSUBR (Fevent_toolbar_button);
2219 DEFSUBR (Fevent_process);
2220 DEFSUBR (Fevent_function);
2221 DEFSUBR (Fevent_object);
2223 defsymbol (&Qeventp, "eventp");
2224 defsymbol (&Qevent_live_p, "event-live-p");
2225 defsymbol (&Qkey_press_event_p, "key-press-event-p");
2226 defsymbol (&Qbutton_event_p, "button-event-p");
2227 defsymbol (&Qmouse_event_p, "mouse-event-p");
2228 defsymbol (&Qprocess_event_p, "process-event-p");
2229 defsymbol (&Qkey_press, "key-press");
2230 defsymbol (&Qbutton_press, "button-press");
2231 defsymbol (&Qbutton_release, "button-release");
2232 defsymbol (&Qmisc_user, "misc-user");
2233 defsymbol (&Qascii_character, "ascii-character");
2235 defsymbol (&QKbackspace, "backspace");
2236 defsymbol (&QKtab, "tab");
2237 defsymbol (&QKlinefeed, "linefeed");
2238 defsymbol (&QKreturn, "return");
2239 defsymbol (&QKescape, "escape");
2240 defsymbol (&QKspace, "space");
2241 defsymbol (&QKdelete, "delete");
2246 reinit_vars_of_events (void)
2248 Vevent_resource = Qnil;
2252 vars_of_events (void)
2254 reinit_vars_of_events ();
2256 DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2257 A symbol used to look up the 8-bit character of a keysym.
2258 To convert a keysym symbol to an 8-bit code, as when that key is
2259 bound to self-insert-command, we will look up the property that this
2260 variable names on the property list of the keysym-symbol. The window-
2261 system-specific code will set up appropriate properties and set this
2264 Vcharacter_set_property = Qnil;