1 /* The portable interface to event streams.
2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Not in FSF. */
28 Created 1991 by Jamie Zawinski.
29 A great deal of work over the ages by Ben Wing (Mule-ization for 19.12,
30 device abstraction for 19.12/19.13, async timers for 19.14,
31 rewriting of focus code for 19.12, pre-idle hook for 19.12,
32 redoing of signal and quit handling for 19.9 and 19.12,
33 misc-user events to clean up menu/scrollbar handling for 19.11,
34 function-key-map/key-translation-map/keyboard-translate-table for
35 19.13/19.14, open-dribble-file for 19.13, much other cleanup).
36 focus-follows-mouse from Chuck Thompson, 1995.
37 XIM stuff by Martin Buchholz, c. 1996?.
40 /* This file has been Mule-ized. */
45 * If you ever change ANYTHING in this file, you MUST run the
46 * testcases at the end to make sure that you haven't changed
47 * the semantics of recent-keys, last-input-char, or keyboard
48 * macros. You'd be surprised how easy it is to break this.
53 This stuff is way too hard to maintain - needs rework.
55 C-x @ h <scrollbar-drag> x causes a crash.
57 The command builder should deal only with key and button events.
58 Other command events should be able to come in the MIDDLE of a key
59 sequence, without disturbing the key sequence composition, or the
60 command builder structure representing it.
62 Someone should rethink universal-argument and figure out how an
63 arbitrary command can influence the next command (universal-argument
64 or universal-coding-system-argument) or the next key (hyperify).
66 Both C-h and Help in the middle of a key sequence should trigger
67 prefix-help-command. help-char is stupid. Maybe we need
68 keymap-of-last-resort?
70 After prefix-help is run, one should be able to CONTINUE TYPING,
71 instead of RETYPING, the key sequence.
77 #include "blocktype.h"
84 #include "insdel.h" /* for buffer_reset_changes */
87 #include "macros.h" /* for defining_keyboard_macro */
88 #include "menubar.h" /* #### for evil kludges. */
92 #include "sysdep.h" /* init_poll_for_quit() */
93 #include "syssignal.h" /* SIGCHLD, etc. */
95 #include "systime.h" /* to set Vlast_input_time */
97 #include "events-mod.h"
99 #include "file-coding.h"
104 /* The number of keystrokes between auto-saves. */
105 static int auto_save_interval;
107 Lisp_Object Qundefined_keystroke_sequence;
109 Lisp_Object Qcommand_event_p;
111 /* Hooks to run before and after each command. */
112 Lisp_Object Vpre_command_hook, Vpost_command_hook;
113 Lisp_Object Qpre_command_hook, Qpost_command_hook;
116 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
118 /* Hook run when XEmacs is about to be idle. */
119 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
121 /* Control gratuitous keyboard focus throwing. */
122 int focus_follows_mouse;
124 #if 0 /* FSF Emacs crap */
125 /* Hook run after a command if there's no more input soon. */
126 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
128 /* Delay time in microseconds before running post-command-idle-hook. */
129 int post_command_idle_delay;
131 /* List of deferred actions to be performed at a later time.
132 The precise format isn't relevant here; we just check whether it is nil. */
133 Lisp_Object Vdeferred_action_list;
135 /* Function to call to handle deferred actions, when there are any. */
136 Lisp_Object Vdeferred_action_function;
137 Lisp_Object Qdeferred_action_function;
138 #endif /* FSF Emacs crap */
140 /* Non-nil disable property on a command means
141 do not execute it; call disabled-command-hook's value instead. */
142 Lisp_Object Qdisabled, Vdisabled_command_hook;
144 EXFUN (Fnext_command_event, 2);
146 static void pre_command_hook (void);
147 static void post_command_hook (void);
149 /* Last keyboard or mouse input event read as a command. */
150 Lisp_Object Vlast_command_event;
152 /* The nearest ASCII equivalent of the above. */
153 Lisp_Object Vlast_command_char;
155 /* Last keyboard or mouse event read for any purpose. */
156 Lisp_Object Vlast_input_event;
158 /* The nearest ASCII equivalent of the above. */
159 Lisp_Object Vlast_input_char;
161 Lisp_Object Vcurrent_mouse_event;
163 /* This is fbound in cmdloop.el, see the commentary there */
164 Lisp_Object Qcancel_mode_internal;
166 /* If not Qnil, event objects to be read as the next command input */
167 Lisp_Object Vunread_command_events;
168 Lisp_Object Vunread_command_event; /* obsoleteness support */
170 static Lisp_Object Qunread_command_events, Qunread_command_event;
172 /* Previous command, represented by a Lisp object.
173 Does not include prefix commands and arg setting commands. */
174 Lisp_Object Vlast_command;
176 /* Contents of this-command-properties for the last command. */
177 Lisp_Object Vlast_command_properties;
179 /* If a command sets this, the value goes into
180 last-command for the next command. */
181 Lisp_Object Vthis_command;
183 /* If a command sets this, the value goes into
184 last-command-properties for the next command. */
185 Lisp_Object Vthis_command_properties;
187 /* The value of point when the last command was executed. */
188 Bufpos last_point_position;
190 /* The frame that was current when the last command was started. */
191 Lisp_Object Vlast_selected_frame;
193 /* The buffer that was current when the last command was started. */
194 Lisp_Object last_point_position_buffer;
196 /* A (16bit . 16bit) representation of the time of the last-command-event. */
197 Lisp_Object Vlast_input_time;
199 /* A (16bit 16bit usec) representation of the time
200 of the last-command-event. */
201 Lisp_Object Vlast_command_event_time;
203 /* Character to recognize as the help char. */
204 Lisp_Object Vhelp_char;
206 /* Form to execute when help char is typed. */
207 Lisp_Object Vhelp_form;
209 /* Command to run when the help character follows a prefix key. */
210 Lisp_Object Vprefix_help_command;
212 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
213 may have happened. */
214 volatile int something_happened;
216 /* Hash table to translate keysyms through */
217 Lisp_Object Vkeyboard_translate_table;
219 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
220 Lisp_Object Vretry_undefined_key_binding_unshifted;
221 Lisp_Object Qretry_undefined_key_binding_unshifted;
224 /* If composed input is undefined, use self-insert-char */
225 Lisp_Object Vcomposed_character_default_binding;
226 #endif /* HAVE_XIM */
228 /* Console that corresponds to our controlling terminal */
229 Lisp_Object Vcontrolling_terminal;
231 /* An event (actually an event chain linked through event_next) or Qnil.
233 Lisp_Object Vthis_command_keys;
234 Lisp_Object Vthis_command_keys_tail;
237 Lisp_Object Qauto_show_make_point_visible;
239 /* File in which we write all commands we read; an lstream */
240 static Lisp_Object Vdribble_file;
242 /* Recent keys ring location; a vector of events or nil-s */
243 Lisp_Object Vrecent_keys_ring;
244 int recent_keys_ring_size;
245 int recent_keys_ring_index;
247 /* Boolean specifying whether keystrokes should be added to
249 int inhibit_input_event_recording;
251 Lisp_Object Qself_insert_defer_undo;
253 /* this is in keymap.c */
254 extern Lisp_Object Fmake_keymap (Lisp_Object name);
257 int debug_emacs_events;
260 external_debugging_print_event (char *event_description, Lisp_Object event)
262 write_c_string ("(", Qexternal_debugging_output);
263 write_c_string (event_description, Qexternal_debugging_output);
264 write_c_string (") ", Qexternal_debugging_output);
265 print_internal (event, Qexternal_debugging_output, 1);
266 write_c_string ("\n", Qexternal_debugging_output);
268 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
269 if (debug_emacs_events) \
270 external_debugging_print_event (event_description, event); \
273 #define DEBUG_PRINT_EMACS_EVENT(string, event)
277 /* The callback routines for the window system or terminal driver */
278 struct event_stream *event_stream;
280 static void echo_key_event (struct command_builder *, Lisp_Object event);
281 static void maybe_kbd_translate (Lisp_Object event);
283 /* This structure is basically a typeahead queue: things like
284 wait-reading-process-output will delay the execution of
285 keyboard and mouse events by pushing them here.
287 Chained through event_next()
288 command_event_queue_tail is a pointer to the last-added element.
290 static Lisp_Object command_event_queue;
291 static Lisp_Object command_event_queue_tail;
293 /* Nonzero means echo unfinished commands after this many seconds of pause. */
294 static Lisp_Object Vecho_keystrokes;
296 /* The number of keystrokes since the last auto-save. */
297 static int keystrokes_since_auto_save;
299 /* Used by the C-g signal handler so that it will never "hard quit"
300 when waiting for an event. Otherwise holding down C-g could
301 cause a suspension back to the shell, which is generally
302 undesirable. (#### This doesn't fully work.) */
304 int emacs_is_blocking;
306 /* Handlers which run during sit-for, sleep-for and accept-process-output
307 are not allowed to recursively call these routines. We record here
308 if we are in that situation. */
310 static Lisp_Object recursive_sit_for;
314 /**********************************************************************/
315 /* Command-builder object */
316 /**********************************************************************/
318 #define XCOMMAND_BUILDER(x) \
319 XRECORD (x, command_builder, struct command_builder)
320 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
321 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
322 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
325 mark_command_builder (Lisp_Object obj)
327 struct command_builder *builder = XCOMMAND_BUILDER (obj);
328 mark_object (builder->prefix_events);
329 mark_object (builder->current_events);
330 mark_object (builder->most_current_event);
331 mark_object (builder->last_non_munged_event);
332 mark_object (builder->munge_me[0].first_mungeable_event);
333 mark_object (builder->munge_me[1].first_mungeable_event);
334 return builder->console;
338 finalize_command_builder (void *header, int for_disksave)
342 xfree (((struct command_builder *) header)->echo_buf);
343 ((struct command_builder *) header)->echo_buf = 0;
347 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
348 mark_command_builder, internal_object_printer,
349 finalize_command_builder, 0, 0, 0,
350 struct command_builder);
353 reset_command_builder_event_chain (struct command_builder *builder)
355 builder->prefix_events = Qnil;
356 builder->current_events = Qnil;
357 builder->most_current_event = Qnil;
358 builder->last_non_munged_event = Qnil;
359 builder->munge_me[0].first_mungeable_event = Qnil;
360 builder->munge_me[1].first_mungeable_event = Qnil;
364 allocate_command_builder (Lisp_Object console)
366 Lisp_Object builder_obj;
367 struct command_builder *builder =
368 alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
370 builder->console = console;
371 reset_command_builder_event_chain (builder);
372 builder->echo_buf_length = 300; /* #### Kludge */
373 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
374 builder->echo_buf[0] = 0;
375 builder->echo_buf_index = -1;
376 builder->echo_buf_index = -1;
377 builder->self_insert_countdown = 0;
379 XSETCOMMAND_BUILDER (builder_obj, builder);
384 command_builder_append_event (struct command_builder *builder,
387 assert (EVENTP (event));
389 if (EVENTP (builder->most_current_event))
390 XSET_EVENT_NEXT (builder->most_current_event, event);
392 builder->current_events = event;
394 builder->most_current_event = event;
395 if (NILP (builder->munge_me[0].first_mungeable_event))
396 builder->munge_me[0].first_mungeable_event = event;
397 if (NILP (builder->munge_me[1].first_mungeable_event))
398 builder->munge_me[1].first_mungeable_event = event;
402 /**********************************************************************/
403 /* Low-level interfaces onto event methods */
404 /**********************************************************************/
406 enum event_stream_operation
408 EVENT_STREAM_PROCESS,
409 EVENT_STREAM_TIMEOUT,
410 EVENT_STREAM_CONSOLE,
415 check_event_stream_ok (enum event_stream_operation op)
417 if (!event_stream && noninteractive)
421 case EVENT_STREAM_PROCESS:
422 error ("Can't start subprocesses in -batch mode");
423 case EVENT_STREAM_TIMEOUT:
424 error ("Can't add timeouts in -batch mode");
425 case EVENT_STREAM_CONSOLE:
426 error ("Can't add consoles in -batch mode");
427 case EVENT_STREAM_READ:
428 error ("Can't read events in -batch mode");
433 else if (!event_stream)
435 error ("event-stream callbacks not initialized (internal error?)");
440 event_stream_event_pending_p (int user)
442 return event_stream && event_stream->event_pending_p (user);
446 event_stream_force_event_pending (struct frame* f)
448 if (event_stream->force_event_pending)
449 event_stream->force_event_pending (f);
453 maybe_read_quit_event (Lisp_Event *event)
455 /* A C-g that came from `sigint_happened' will always come from the
456 controlling terminal. If that doesn't exist, however, then the
457 user manually sent us a SIGINT, and we pretend the C-g came from
458 the selected console. */
461 if (CONSOLEP (Vcontrolling_terminal) &&
462 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
463 con = XCONSOLE (Vcontrolling_terminal);
465 con = XCONSOLE (Fselected_console ());
469 int ch = CONSOLE_QUIT_CHAR (con);
472 character_to_event (ch, event, con, 1, 1);
473 event->channel = make_console (con);
480 event_stream_next_event (Lisp_Event *event)
482 Lisp_Object event_obj;
484 check_event_stream_ok (EVENT_STREAM_READ);
486 XSETEVENT (event_obj, event);
488 /* If C-g was pressed, treat it as a character to be read.
489 Note that if C-g was pressed while we were blocking,
490 the SIGINT signal handler will be called. It will
491 set Vquit_flag and write a byte on our "fake pipe",
492 which will unblock us. */
493 if (maybe_read_quit_event (event))
495 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
499 /* If a longjmp() happens in the callback, we're screwed.
500 Let's hope it doesn't. I think the code here is fairly
501 clean and doesn't do this. */
502 emacs_is_blocking = 1;
504 /* Do this if the poll-for-quit timer seems to be taking too
505 much CPU time when idle ... */
506 reset_poll_for_quit ();
508 event_stream->next_event_cb (event);
510 init_poll_for_quit ();
512 emacs_is_blocking = 0;
515 /* timeout events have more info set later, so
516 print the event out in next_event_internal(). */
517 if (event->event_type != timeout_event)
518 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
520 maybe_kbd_translate (event_obj);
524 event_stream_handle_magic_event (Lisp_Event *event)
526 check_event_stream_ok (EVENT_STREAM_READ);
527 event_stream->handle_magic_event_cb (event);
531 event_stream_add_timeout (EMACS_TIME timeout)
533 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
534 return event_stream->add_timeout_cb (timeout);
538 event_stream_remove_timeout (int id)
540 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
541 event_stream->remove_timeout_cb (id);
545 event_stream_select_console (struct console *con)
547 check_event_stream_ok (EVENT_STREAM_CONSOLE);
548 if (!con->input_enabled)
550 event_stream->select_console_cb (con);
551 con->input_enabled = 1;
556 event_stream_unselect_console (struct console *con)
558 check_event_stream_ok (EVENT_STREAM_CONSOLE);
559 if (con->input_enabled)
561 event_stream->unselect_console_cb (con);
562 con->input_enabled = 0;
567 event_stream_select_process (Lisp_Process *proc)
569 check_event_stream_ok (EVENT_STREAM_PROCESS);
570 if (!get_process_selected_p (proc))
572 event_stream->select_process_cb (proc);
573 set_process_selected_p (proc, 1);
578 event_stream_unselect_process (Lisp_Process *proc)
580 check_event_stream_ok (EVENT_STREAM_PROCESS);
581 if (get_process_selected_p (proc))
583 event_stream->unselect_process_cb (proc);
584 set_process_selected_p (proc, 0);
589 event_stream_create_stream_pair (void* inhandle, void* outhandle,
590 Lisp_Object* instream, Lisp_Object* outstream, int flags)
592 check_event_stream_ok (EVENT_STREAM_PROCESS);
593 return event_stream->create_stream_pair_cb
594 (inhandle, outhandle, instream, outstream, flags);
598 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
600 check_event_stream_ok (EVENT_STREAM_PROCESS);
601 return event_stream->delete_stream_pair_cb (instream, outstream);
605 event_stream_quit_p (void)
608 event_stream->quit_p_cb ();
613 /**********************************************************************/
614 /* Character prompting */
615 /**********************************************************************/
618 echo_key_event (struct command_builder *command_builder,
621 /* This function can GC */
623 Bytecount buf_index = command_builder->echo_buf_index;
629 buf_index = 0; /* We're echoing now */
630 clear_echo_area (selected_frame (), Qnil, 0);
633 format_event_object (buf, XEVENT (event), 1);
636 if (len + buf_index + 4 > command_builder->echo_buf_length)
638 e = command_builder->echo_buf + buf_index;
639 memcpy (e, buf, len);
647 command_builder->echo_buf_index = buf_index + len + 1;
651 regenerate_echo_keys_from_this_command_keys (struct command_builder *
656 builder->echo_buf_index = 0;
658 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
659 echo_key_event (builder, event);
663 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
665 /* This function can GC */
666 double echo_keystrokes;
667 struct frame *f = selected_frame ();
668 /* Message turns off echoing unless more keystrokes turn it on again. */
669 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
672 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
673 echo_keystrokes = extract_float (Vecho_keystrokes);
677 if (minibuf_level == 0
678 && echo_keystrokes > 0.0
679 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
680 && !x_kludge_lw_menu_active ()
686 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
687 doesn't work. See check_quit. */
688 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
689 /* input came in, so don't echo. */
693 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
694 /* not echo_buf_index. That doesn't include
695 the terminating " - ". */
696 strlen ((char *) command_builder->echo_buf),
702 reset_key_echo (struct command_builder *command_builder,
703 int remove_echo_area_echo)
705 /* This function can GC */
706 struct frame *f = selected_frame ();
708 command_builder->echo_buf_index = -1;
710 if (remove_echo_area_echo)
711 clear_echo_area (f, Qcommand, 0);
715 /**********************************************************************/
717 /**********************************************************************/
720 maybe_kbd_translate (Lisp_Object event)
723 int did_translate = 0;
725 if (XEVENT_TYPE (event) != key_press_event)
727 if (!HASH_TABLEP (Vkeyboard_translate_table))
729 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
732 c = event_to_character (XEVENT (event), 0, 0, 0);
735 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
737 if (!NILP (traduit) && SYMBOLP (traduit))
739 XEVENT (event)->event.key.keysym = traduit;
740 XEVENT (event)->event.key.modifiers = 0;
743 else if (CHARP (traduit))
747 /* This used to call Fcharacter_to_event() directly into EVENT,
748 but that can eradicate timestamps and other such stuff.
749 This way is safer. */
751 character_to_event (XCHAR (traduit), &ev2,
752 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
753 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
754 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
761 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
762 Vkeyboard_translate_table, Qnil);
763 if (!NILP (traduit) && SYMBOLP (traduit))
765 XEVENT (event)->event.key.keysym = traduit;
772 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
776 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
777 keystrokes_since_auto_save is equivalent to the difference between
778 num_nonmacro_input_chars and last_auto_save. */
780 /* When an auto-save happens, record the "time", and don't do again soon. */
783 record_auto_save (void)
785 keystrokes_since_auto_save = 0;
788 /* Make an auto save happen as soon as possible at command level. */
791 force_auto_save_soon (void)
793 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
796 record_asynch_buffer_change ();
801 maybe_do_auto_save (void)
803 /* This function can call lisp */
804 keystrokes_since_auto_save++;
805 if (auto_save_interval > 0 &&
806 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
807 !detect_input_pending ())
809 Fdo_auto_save (Qnil, Qnil);
815 print_help (Lisp_Object object)
817 Fprinc (object, Qnil);
822 execute_help_form (struct command_builder *command_builder,
825 /* This function can GC */
826 Lisp_Object help = Qnil;
827 int speccount = specpdl_depth ();
828 Bytecount buf_index = command_builder->echo_buf_index;
829 Lisp_Object echo = ((buf_index <= 0)
831 : make_string (command_builder->echo_buf,
833 struct gcpro gcpro1, gcpro2;
836 record_unwind_protect (save_window_excursion_unwind,
837 Fcurrent_window_configuration (Qnil));
838 reset_key_echo (command_builder, 1);
840 help = Feval (Vhelp_form);
842 internal_with_output_to_temp_buffer (build_string ("*Help*"),
843 print_help, help, Qnil);
844 Fnext_command_event (event, Qnil);
845 /* Remove the help from the frame */
846 unbind_to (speccount, Qnil);
847 /* Hmmmm. Tricky. The unbind restores an old window configuration,
848 apparently bypassing any setting of windows_structure_changed.
849 So we need to set it so that things get redrawn properly. */
850 /* #### This is massive overkill. Look at doing it better once the
851 new redisplay is fully in place. */
853 Lisp_Object frmcons, devcons, concons;
854 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
856 struct frame *f = XFRAME (XCAR (frmcons));
857 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
862 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
864 /* Discard next key if it is a space */
865 reset_key_echo (command_builder, 1);
866 Fnext_command_event (event, Qnil);
869 command_builder->echo_buf_index = buf_index;
871 memcpy (command_builder->echo_buf,
872 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
877 /**********************************************************************/
879 /**********************************************************************/
882 detect_input_pending (void)
884 /* Always call the event_pending_p hook even if there's an unread
885 character, because that might do some needed ^G detection (on
886 systems without SIGIO, for example).
888 if (event_stream_event_pending_p (1))
890 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
892 if (!NILP (command_event_queue))
896 EVENT_CHAIN_LOOP (event, command_event_queue)
898 if (XEVENT_TYPE (event) != eval_event
899 && XEVENT_TYPE (event) != magic_eval_event)
906 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
907 Return t if command input is currently available with no waiting.
908 Actually, the value is nil only if we can be sure that no input is available.
912 return detect_input_pending () ? Qt : Qnil;
916 /**********************************************************************/
918 /**********************************************************************/
920 /**** Low-level timeout functions. ****
922 These functions maintain a sorted list of one-shot timeouts (where
923 the timeouts are in absolute time). They are intended for use by
924 functions that need to convert a list of absolute timeouts into a
925 series of intervals to wait for. */
927 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
928 used to indicate an absence of a timer. */
929 static int low_level_timeout_id_tick;
931 static struct low_level_timeout_blocktype
933 Blocktype_declare (struct low_level_timeout);
934 } *the_low_level_timeout_blocktype;
936 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
937 a unique ID identifying the timeout. */
940 add_low_level_timeout (struct low_level_timeout **timeout_list,
943 struct low_level_timeout *tm;
944 struct low_level_timeout *t, **tt;
946 /* Allocate a new time struct. */
948 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
950 if (low_level_timeout_id_tick == 0)
951 low_level_timeout_id_tick++;
952 tm->id = low_level_timeout_id_tick++;
955 /* Add it to the queue. */
959 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
970 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
971 If the timeout is not there, do nothing. */
974 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
976 struct low_level_timeout *t, *prev;
980 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
984 return; /* couldn't find it */
987 *timeout_list = t->next;
988 else prev->next = t->next;
990 Blocktype_free (the_low_level_timeout_blocktype, t);
993 /* If there are timeouts on TIMEOUT_LIST, store the relative time
994 interval to the first timeout on the list into INTERVAL and
995 return 1. Otherwise, return 0. */
998 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
999 EMACS_TIME *interval)
1001 if (!timeout_list) /* no timer events; block indefinitely */
1005 EMACS_TIME current_time;
1007 /* The time to block is the difference between the first
1008 (earliest) timer on the queue and the current time.
1009 If that is negative, then the timer will fire immediately
1010 but we still have to call select(), with a zero-valued
1011 timeout: user events must have precedence over timer events. */
1012 EMACS_GET_TIME (current_time);
1013 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1014 EMACS_SUB_TIME (*interval, timeout_list->time,
1017 EMACS_SET_SECS_USECS (*interval, 0, 0);
1022 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1023 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1024 timeout into TIME_OUT. */
1027 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1028 EMACS_TIME *time_out)
1030 struct low_level_timeout *tm = *timeout_list;
1036 *time_out = tm->time;
1037 *timeout_list = tm->next;
1038 Blocktype_free (the_low_level_timeout_blocktype, tm);
1043 /**** High-level timeout functions. ****/
1045 static int timeout_id_tick;
1047 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1049 static Lisp_Object Vtimeout_free_list;
1052 mark_timeout (Lisp_Object obj)
1054 Lisp_Timeout *tm = XTIMEOUT (obj);
1055 mark_object (tm->function);
1059 /* Should never, ever be called. (except by an external debugger) */
1061 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1063 const Lisp_Timeout *t = XTIMEOUT (obj);
1066 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
1068 write_c_string (buf, printcharfun);
1071 static const struct lrecord_description timeout_description[] = {
1072 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1073 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1077 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
1078 mark_timeout, print_timeout,
1079 0, 0, 0, timeout_description, Lisp_Timeout);
1081 /* Generate a timeout and return its ID. */
1084 event_stream_generate_wakeup (unsigned int milliseconds,
1085 unsigned int vanilliseconds,
1086 Lisp_Object function, Lisp_Object object,
1089 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
1090 Lisp_Timeout *timeout = XTIMEOUT (op);
1091 EMACS_TIME current_time;
1092 EMACS_TIME interval;
1094 timeout->id = timeout_id_tick++;
1095 timeout->resignal_msecs = vanilliseconds;
1096 timeout->function = function;
1097 timeout->object = object;
1099 EMACS_GET_TIME (current_time);
1100 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1101 1000 * (milliseconds % 1000));
1102 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1106 timeout->interval_id =
1107 event_stream_add_async_timeout (timeout->next_signal_time);
1108 pending_async_timeout_list = noseeum_cons (op,
1109 pending_async_timeout_list);
1113 timeout->interval_id =
1114 event_stream_add_timeout (timeout->next_signal_time);
1115 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
1120 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1121 as necessary and return the timeout's ID and function and object slots.
1123 This should be called as a result of receiving notice that a timeout
1124 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1125 identifies this particular firing of the timeout. INTERVAL-ID's and
1126 timeout ID's are in separate number spaces and bear no relation to
1127 each other. The INTERVAL-ID is all that the event callback routines
1128 work with: they work only with one-shot intervals, not with timeouts
1129 that may fire repeatedly.
1131 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1135 event_stream_resignal_wakeup (int interval_id, int async_p,
1136 Lisp_Object *function, Lisp_Object *object)
1138 Lisp_Object op = Qnil, rest;
1139 Lisp_Timeout *timeout;
1140 Lisp_Object *timeout_list;
1141 struct gcpro gcpro1;
1144 GCPRO1 (op); /* just in case ... because it's removed from the list
1147 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1149 /* Find the timeout on the list of pending ones. */
1150 LIST_LOOP (rest, *timeout_list)
1152 timeout = XTIMEOUT (XCAR (rest));
1153 if (timeout->interval_id == interval_id)
1157 assert (!NILP (rest));
1159 timeout = XTIMEOUT (op);
1160 /* We make sure to snarf the data out of the timeout object before
1161 we free it with free_managed_lcrecord(). */
1163 *function = timeout->function;
1164 *object = timeout->object;
1166 /* Remove this one from the list of pending timeouts */
1167 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1169 /* If this timeout wants to be resignalled, do it now. */
1170 if (timeout->resignal_msecs)
1172 EMACS_TIME current_time;
1173 EMACS_TIME interval;
1175 /* Determine the time that the next resignalling should occur.
1176 We do that by adding the interval time to the last signalled
1177 time until we get a time that's current.
1179 (This way, it doesn't matter if the timeout was signalled
1180 exactly when we asked for it, or at some time later.)
1182 EMACS_GET_TIME (current_time);
1183 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
1184 1000 * (timeout->resignal_msecs % 1000));
1187 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1189 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1192 timeout->interval_id =
1193 event_stream_add_async_timeout (timeout->next_signal_time);
1195 timeout->interval_id =
1196 event_stream_add_timeout (timeout->next_signal_time);
1197 /* Add back onto the list. Note that the effect of this
1198 is to move frequently-hit timeouts to the front of the
1199 list, which is a good thing. */
1200 *timeout_list = noseeum_cons (op, *timeout_list);
1203 free_managed_lcrecord (Vtimeout_free_list, op);
1210 event_stream_disable_wakeup (int id, int async_p)
1212 Lisp_Timeout *timeout = 0;
1214 Lisp_Object *timeout_list;
1217 timeout_list = &pending_async_timeout_list;
1219 timeout_list = &pending_timeout_list;
1221 /* Find the timeout on the list of pending ones, if it's still there. */
1222 LIST_LOOP (rest, *timeout_list)
1224 timeout = XTIMEOUT (XCAR (rest));
1225 if (timeout->id == id)
1229 /* If we found it, remove it from the list and disable the pending
1233 Lisp_Object op = XCAR (rest);
1235 delq_no_quit_and_free_cons (op, *timeout_list);
1237 event_stream_remove_async_timeout (timeout->interval_id);
1239 event_stream_remove_timeout (timeout->interval_id);
1240 free_managed_lcrecord (Vtimeout_free_list, op);
1245 event_stream_wakeup_pending_p (int id, int async_p)
1247 Lisp_Timeout *timeout;
1249 Lisp_Object timeout_list;
1254 timeout_list = pending_async_timeout_list;
1256 timeout_list = pending_timeout_list;
1258 /* Find the element on the list of pending ones, if it's still there. */
1259 LIST_LOOP (rest, timeout_list)
1261 timeout = XTIMEOUT (XCAR (rest));
1262 if (timeout->id == id)
1273 /**** Asynch. timeout functions (see also signal.c) ****/
1275 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1276 extern int poll_for_quit_id;
1279 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1280 extern int poll_for_sigchld_id;
1284 event_stream_deal_with_async_timeout (int interval_id)
1286 /* This function can GC */
1287 Lisp_Object humpty, dumpty;
1288 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1289 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1292 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1294 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1295 if (id == poll_for_quit_id)
1297 quit_check_signal_happened = 1;
1298 quit_check_signal_tick_count++;
1303 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1304 if (id == poll_for_sigchld_id)
1306 kick_status_notify ();
1311 /* call1 GC-protects its arguments */
1312 call1_trapping_errors ("Error in asynchronous timeout callback",
1317 /**** Lisp-level timeout functions. ****/
1319 static unsigned long
1320 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1322 #ifdef LISP_FLOAT_TYPE
1324 CHECK_INT_OR_FLOAT (secs);
1325 fsecs = XFLOATINT (secs);
1329 fsecs = XINT (secs);
1332 signal_simple_error ("timeout is negative", secs);
1333 if (!allow_0 && fsecs == 0)
1334 signal_simple_error ("timeout is non-positive", secs);
1335 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1337 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1339 return (unsigned long) (1000 * fsecs);
1342 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1343 Add a timeout, to be signaled after the timeout period has elapsed.
1344 SECS is a number of seconds, expressed as an integer or a float.
1345 FUNCTION will be called after that many seconds have elapsed, with one
1346 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1347 then after this timeout expires, `add-timeout' will automatically be called
1348 again with RESIGNAL as the first argument.
1350 This function returns an object which is the id number of this particular
1351 timeout. You can pass that object to `disable-timeout' to turn off the
1352 timeout before it has been signalled.
1354 NOTE: Id numbers as returned by this function are in a distinct namespace
1355 from those returned by `add-async-timeout'. This means that the same id
1356 number could refer to a pending synchronous timeout and a different pending
1357 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1358 to `disable-async-timeout', or vice-versa.
1360 The number of seconds may be expressed as a floating-point number, in which
1361 case some fractional part of a second will be used. Caveat: the usable
1362 timeout granularity will vary from system to system.
1364 Adding a timeout causes a timeout event to be returned by `next-event', and
1365 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1366 loop, the function will not be invoked until the next call to sit-for or
1367 until the return to top-level (the same is true of process filters).
1369 If you need to have a timeout executed even when XEmacs is in the midst of
1370 running Lisp code, use `add-async-timeout'.
1372 WARNING: if you are thinking of calling add-timeout from inside of a
1373 callback function as a way of resignalling a timeout, think again. There
1374 is a race condition. That's why the RESIGNAL argument exists.
1376 (secs, function, object, resignal))
1378 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1379 unsigned long msecs2 = (NILP (resignal) ? 0 :
1380 lisp_number_to_milliseconds (resignal, 0));
1383 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1384 lid = make_int (id);
1385 if (id != XINT (lid)) abort ();
1389 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1390 Disable a timeout from signalling any more.
1391 ID should be a timeout id number as returned by `add-timeout'. If ID
1392 corresponds to a one-shot timeout that has already signalled, nothing
1395 It will not work to call this function on an id number returned by
1396 `add-async-timeout'. Use `disable-async-timeout' for that.
1401 event_stream_disable_wakeup (XINT (id), 0);
1405 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1406 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1407 SECS is a number of seconds, expressed as an integer or a float.
1408 FUNCTION will be called after that many seconds have elapsed, with one
1409 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1410 then after this timeout expires, `add-async-timeout' will automatically be
1411 called again with RESIGNAL as the first argument.
1413 This function returns an object which is the id number of this particular
1414 timeout. You can pass that object to `disable-async-timeout' to turn off
1415 the timeout before it has been signalled.
1417 NOTE: Id numbers as returned by this function are in a distinct namespace
1418 from those returned by `add-timeout'. This means that the same id number
1419 could refer to a pending synchronous timeout and a different pending
1420 asynchronous timeout, and that you cannot pass an id from
1421 `add-async-timeout' to `disable-timeout', or vice-versa.
1423 The number of seconds may be expressed as a floating-point number, in which
1424 case some fractional part of a second will be used. Caveat: the usable
1425 timeout granularity will vary from system to system.
1427 Adding an asynchronous timeout causes the function to be invoked as soon
1428 as the timeout occurs, even if XEmacs is in the midst of executing some
1429 other code. (This is unlike the synchronous timeouts added with
1430 `add-timeout', where the timeout will only be signalled when XEmacs is
1431 waiting for events, i.e. the next return to top-level or invocation of
1432 `sit-for' or related functions.) This means that the function that is
1433 called *must* not signal an error or change any global state (e.g. switch
1434 buffers or windows) except when locking code is in place to make sure
1435 that race conditions don't occur in the interaction between the
1436 asynchronous timeout function and other code.
1438 Under most circumstances, you should use `add-timeout' instead, as it is
1439 much safer. Asynchronous timeouts should only be used when such behavior
1440 is really necessary.
1442 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1443 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1444 asynchronous timeouts will get called immediately. (Multiple occurrences
1445 of the same asynchronous timeout are not queued, however.) While the
1446 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1447 is automatically bound to non-nil, and thus other asynchronous timeouts
1448 will be blocked unless the callback function explicitly sets `inhibit-quit'
1451 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1452 callback function as a way of resignalling a timeout, think again. There
1453 is a race condition. That's why the RESIGNAL argument exists.
1455 (secs, function, object, resignal))
1457 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1458 unsigned long msecs2 = (NILP (resignal) ? 0 :
1459 lisp_number_to_milliseconds (resignal, 0));
1462 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1463 lid = make_int (id);
1464 if (id != XINT (lid)) abort ();
1468 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1469 Disable an asynchronous timeout from signalling any more.
1470 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1471 corresponds to a one-shot timeout that has already signalled, nothing
1474 It will not work to call this function on an id number returned by
1475 `add-timeout'. Use `disable-timeout' for that.
1480 event_stream_disable_wakeup (XINT (id), 1);
1485 /**********************************************************************/
1486 /* enqueuing and dequeuing events */
1487 /**********************************************************************/
1489 /* Add an event to the back of the command-event queue: it will be the next
1490 event read after all pending events. This only works on keyboard,
1491 mouse-click, misc-user, and eval events.
1494 enqueue_command_event (Lisp_Object event)
1496 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1500 dequeue_command_event (void)
1502 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1505 /* put the event on the typeahead queue, unless
1506 the event is the quit char, in which case the `QUIT'
1507 which will occur on the next trip through this loop is
1508 all the processing we should do - leaving it on the queue
1509 would cause the quit to be processed twice.
1512 enqueue_command_event_1 (Lisp_Object event_to_copy)
1514 /* do not call check_quit() here. Vquit_flag was set in
1515 next_event_internal. */
1516 if (NILP (Vquit_flag))
1517 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1521 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1523 Lisp_Object event = Fmake_event (Qnil, Qnil);
1525 XEVENT (event)->event_type = magic_eval_event;
1526 /* channel for magic_eval events is nil */
1527 XEVENT (event)->event.magic_eval.internal_function = fun;
1528 XEVENT (event)->event.magic_eval.object = object;
1529 enqueue_command_event (event);
1532 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1533 Add an eval event to the back of the eval event queue.
1534 When this event is dispatched, FUNCTION (which should be a function
1535 of one argument) will be called with OBJECT as its argument.
1536 See `next-event' for a description of event types and how events
1541 Lisp_Object event = Fmake_event (Qnil, Qnil);
1543 XEVENT (event)->event_type = eval_event;
1544 /* channel for eval events is nil */
1545 XEVENT (event)->event.eval.function = function;
1546 XEVENT (event)->event.eval.object = object;
1547 enqueue_command_event (event);
1553 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1556 Lisp_Object event = Fmake_event (Qnil, Qnil);
1558 XEVENT (event)->event_type = misc_user_event;
1559 XEVENT (event)->channel = channel;
1560 XEVENT (event)->event.misc.function = function;
1561 XEVENT (event)->event.misc.object = object;
1562 XEVENT (event)->event.misc.button = 0;
1563 XEVENT (event)->event.misc.modifiers = 0;
1564 XEVENT (event)->event.misc.x = -1;
1565 XEVENT (event)->event.misc.y = -1;
1566 enqueue_command_event (event);
1572 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1574 int button, int modifiers, int x, int y)
1576 Lisp_Object event = Fmake_event (Qnil, Qnil);
1578 XEVENT (event)->event_type = misc_user_event;
1579 XEVENT (event)->channel = channel;
1580 XEVENT (event)->event.misc.function = function;
1581 XEVENT (event)->event.misc.object = object;
1582 XEVENT (event)->event.misc.button = button;
1583 XEVENT (event)->event.misc.modifiers = modifiers;
1584 XEVENT (event)->event.misc.x = x;
1585 XEVENT (event)->event.misc.y = y;
1586 enqueue_command_event (event);
1592 /**********************************************************************/
1593 /* focus-event handling */
1594 /**********************************************************************/
1598 Ben's capsule lecture on focus:
1600 In FSFmacs `select-frame' never changes the window-manager frame
1601 focus. All it does is change the "selected frame". This is similar
1602 to what happens when we call `select-device' or `select-console'.
1603 Whenever an event comes in (including a keyboard event), its frame is
1604 selected; therefore, evaluating `select-frame' in *scratch* won't
1605 cause any effects because the next received event (in the same frame)
1606 will cause a switch back to the frame displaying *scratch*.
1608 Whenever a focus-change event is received from the window manager, it
1609 generates a `switch-frame' event, which causes the Lisp function
1610 `handle-switch-frame' to get run. This basically just runs
1611 `select-frame' (see below, however).
1613 In FSFmacs, if you want to have an operation run when a frame is
1614 selected, you supply an event binding for `switch-frame' (and then
1615 maybe call `handle-switch-frame', or something ...).
1617 In XEmacs, we *do* change the window-manager frame focus as a result
1618 of `select-frame', but not until the next time an event is received,
1619 so that a function that momentarily changes the selected frame won't
1620 cause WM focus flashing. (#### There's something not quite right here;
1621 this is causing the wrong-cursor-focus problems that you occasionally
1622 see. But the general idea is correct.) This approach is winning for
1623 people who use the explicit-focus model, but is trickier to implement.
1625 We also don't make the `switch-frame' event visible but instead have
1626 `select-frame-hook', which is a better approach.
1628 There is the problem of surrogate minibuffers, where when we enter the
1629 minibuffer, you essentially want to temporarily switch the WM focus to
1630 the frame with the minibuffer, and switch it back when you exit the
1633 FSFmacs solves this with the crockish `redirect-frame-focus', which
1634 says "for keyboard events received from FRAME, act like they're
1635 coming from FOCUS-FRAME". I think what this means is that, when
1636 a keyboard event comes in and the event manager is about to select the
1637 event's frame, if that frame has its focus redirected, the redirected-to
1638 frame is selected instead. That way, if you're in a minibufferless
1639 frame and enter the minibuffer, then all Lisp functions that run see
1640 the selected frame as the minibuffer's frame rather than the minibufferless
1641 frame you came from, so that (e.g.) your typing actually appears in
1642 the minibuffer's frame and things behave sanely.
1644 There's also some weird logic that switches the redirected frame focus
1645 from one frame to another if Lisp code explicitly calls `select-frame'
1646 \(but not if `handle-switch-frame' is called), and saves and restores
1647 the frame focus in window configurations, etc. etc. All of this logic
1648 is heavily #if 0'd, with lots of comments saying "No, this approach
1649 doesn't seem to work, so I'm trying this ... is it reasonable?
1650 Well, I'm not sure ..." that are a red flag indicating crockishness.
1652 Because of our way of doing things, we can avoid all this crock.
1653 Keyboard events never cause a select-frame (who cares what frame
1654 they're associated with? They come from a console, only). We change
1655 the actual WM focus to a surrogate minibuffer frame, so we don't have
1656 to do any internal redirection. In order to get the focus back,
1657 I took the approach in minibuf.el of just checking to see if the
1658 frame we moved to is still the selected frame, and move back to the
1659 old one if so. Conceivably we might have to do the weird "tracking"
1660 that FSFmacs does when `select-frame' is called, but I don't think
1661 so. If the selected frame moved from the minibuffer frame, then
1662 we just leave it there, figuring that someone knows what they're
1663 doing. Because we don't have any redirection recorded anywhere,
1664 it's safe to do this, and we don't end up with unwanted redirection.
1669 run_select_frame_hook (void)
1671 run_hook (Qselect_frame_hook);
1675 run_deselect_frame_hook (void)
1677 #if 0 /* unclean! FSF calls this at all sorts of random places,
1678 including a bunch of places in their mouse.el. If this
1679 is implemented, it has to be done cleanly. */
1680 run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also
1681 called in `call-interactively'.
1682 Does this mean it will be
1683 called twice? Oh well, FSF
1684 bug -- FSF calls it in
1685 `handle-switch-frame',
1686 which is approximately the
1687 same as the caller of this
1690 run_hook (Qdeselect_frame_hook);
1693 /* When select-frame is called and focus_follows_mouse is false, we want
1694 to tell the window system that the focus should be changed to point to
1695 the new frame. However,
1696 sometimes Lisp functions will temporarily change the selected frame
1697 (e.g. to call a function that operates on the selected frame),
1698 and it's annoying if this focus-change happens exactly when
1699 select-frame is called, because then you get some flickering of the
1700 window-manager border and perhaps other undesirable results. We
1701 really only want to change the focus when we're about to retrieve
1702 an event from the user. To do this, we keep track of the frame
1703 where the window-manager focus lies on, and just before waiting
1704 for user events, check the currently selected frame and change
1705 the focus as necessary.
1707 On the other hand, if focus_follows_mouse is true, we need to switch the
1708 selected frame back to the frame with window manager focus just before we
1709 execute the next command in Fcommand_loop_1, just as the selected buffer is
1710 reverted after a set-buffer.
1712 Both cases are handled by this function. It must be called as appropriate
1713 from these two places, depending on the value of focus_follows_mouse. */
1716 investigate_frame_change (void)
1718 Lisp_Object devcons, concons;
1720 /* if the selected frame was changed, change the window-system
1721 focus to the new frame. We don't do it when select-frame was
1722 called, to avoid flickering and other unwanted side effects when
1723 the frame is just changed temporarily. */
1724 DEVICE_LOOP_NO_BREAK (devcons, concons)
1726 struct device *d = XDEVICE (XCAR (devcons));
1727 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1729 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1730 but that can cause us to end up in an infinite loop focusing
1731 between two frames. It seems that since the call to `select-frame'
1732 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1733 value, we need to do so too. */
1734 if (!NILP (sel_frame) &&
1735 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1736 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1737 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1739 /* At this point, we know that the frame has been changed. Now, if
1740 * focus_follows_mouse is not set, we finish off the frame change,
1741 * so that user events will now come from the new frame. Otherwise,
1742 * if focus_follows_mouse is set, no gratuitous frame changing
1743 * should take place. Set the focus back to the frame which was
1744 * originally selected for user input.
1746 if (!focus_follows_mouse)
1748 /* prevent us from issuing the same request more than once */
1749 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1750 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1754 Lisp_Object old_frame = Qnil;
1756 /* #### Do we really want to check OUGHT ??
1757 * It seems to make sense, though I have never seen us
1758 * get here and have it be non-nil.
1760 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1761 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1762 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1763 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1765 /* #### Can old_frame ever be NIL? play it safe.. */
1766 if (!NILP (old_frame))
1768 /* Fselect_frame is not really the right thing: it frobs the
1769 * buffer stack. But there's no easy way to do the right
1770 * thing, and this code already had this problem anyway.
1772 Fselect_frame (old_frame);
1780 cleanup_after_missed_defocusing (Lisp_Object frame)
1782 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1783 Fselect_frame (frame);
1788 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1790 Lisp_Object frame = Fcar (frame_inp_and_dev);
1791 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1792 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1795 if (!DEVICE_LIVE_P (XDEVICE (device)))
1798 d = XDEVICE (device);
1800 /* Any received focus-change notifications render invalid any
1801 pending focus-change requests. */
1802 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1805 Lisp_Object focus_frame;
1807 if (!FRAME_LIVE_P (XFRAME (frame)))
1810 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1812 /* Mark the minibuffer as changed to make sure it gets updated
1813 properly if the echo area is active. */
1815 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1816 MARK_WINDOWS_CHANGED (w);
1819 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1821 /* Oops, we missed a focus-out event. */
1822 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1823 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1825 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1826 if (!EQ (frame, focus_frame))
1828 redisplay_redraw_cursor (XFRAME (frame), 1);
1833 /* We ignore the frame reported in the event. If it's different
1834 from where we think the focus was, oh well -- we messed up.
1835 Nonetheless, we pretend we were right, for sensible behavior. */
1836 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1839 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1841 if (FRAME_LIVE_P (XFRAME (frame)))
1842 redisplay_redraw_cursor (XFRAME (frame), 1);
1847 /* Called from the window-system-specific code when we receive a
1848 notification that the focus lies on a particular frame.
1849 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1853 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1855 Lisp_Object frame = Fcar (frame_inp_and_dev);
1856 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1857 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1861 if (!DEVICE_LIVE_P (XDEVICE (device)))
1864 d = XDEVICE (device);
1868 Lisp_Object focus_frame;
1870 if (!FRAME_LIVE_P (XFRAME (frame)))
1873 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1875 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1876 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1878 /* Oops, we missed a focus-out event. */
1879 Fselect_frame (focus_frame);
1880 /* Do an unwind-protect in case an error occurs in
1881 the deselect-frame-hook */
1882 count = specpdl_depth ();
1883 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1884 run_deselect_frame_hook ();
1885 unbind_to (count, Qnil);
1886 /* the cleanup method changed the focus frame to nil, so
1887 we need to reflect this */
1891 Fselect_frame (frame);
1892 if (!EQ (frame, focus_frame))
1893 run_select_frame_hook ();
1897 /* We ignore the frame reported in the event. If it's different
1898 from where we think the focus was, oh well -- we messed up.
1899 Nonetheless, we pretend we were right, for sensible behavior. */
1900 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1903 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1904 run_deselect_frame_hook ();
1910 /**********************************************************************/
1911 /* retrieving the next event */
1912 /**********************************************************************/
1914 static int in_single_console;
1916 /* #### These functions don't currently do anything. */
1918 single_console_state (void)
1920 in_single_console = 1;
1924 any_console_state (void)
1926 in_single_console = 0;
1930 in_single_console_state (void)
1932 return in_single_console;
1935 /* the number of keyboard characters read. callint.c wants this. */
1936 Charcount num_input_chars;
1939 next_event_internal (Lisp_Object target_event, int allow_queued)
1941 struct gcpro gcpro1;
1942 /* QUIT; This is incorrect - the caller must do this because some
1943 callers (ie, Fnext_event()) do not want to QUIT. */
1945 assert (NILP (XEVENT_NEXT (target_event)));
1947 GCPRO1 (target_event);
1949 /* When focus_follows_mouse is nil, if a frame change took place, we need
1950 * to actually switch window manager focus to the selected window now.
1952 if (!focus_follows_mouse)
1953 investigate_frame_change ();
1955 if (allow_queued && !NILP (command_event_queue))
1957 Lisp_Object event = dequeue_command_event ();
1958 Fcopy_event (event, target_event);
1959 Fdeallocate_event (event);
1960 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
1964 Lisp_Event *e = XEVENT (target_event);
1966 /* The command_event_queue was empty. Wait for an event. */
1967 event_stream_next_event (e);
1968 /* If this was a timeout, then we need to extract some data
1969 out of the returned closure and might need to resignal
1971 if (e->event_type == timeout_event)
1973 Lisp_Object tristan, isolde;
1975 e->event.timeout.id_number =
1976 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
1979 e->event.timeout.function = tristan;
1980 e->event.timeout.object = isolde;
1981 /* next_event_internal() doesn't print out timeout events
1982 because of the extra info we just set. */
1983 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
1986 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1987 The callers of next_event_internal() will do one of two things:
1989 -- set Vquit_flag to Qnil. (next-event does this.) This will
1990 cause the ^G to be treated as a normal keystroke.
1991 -- not change Vquit_flag but attempt to enqueue the ^G, at
1992 which point it will be discarded. The next time QUIT is
1993 called, it will notice that Vquit_flag was set.
1996 if (e->event_type == key_press_event &&
1997 event_matches_key_specifier_p
1998 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2008 run_pre_idle_hook (void)
2010 if (!NILP (Vpre_idle_hook)
2011 && !detect_input_pending ())
2012 safe_run_hook_trapping_errors
2013 ("Error in `pre-idle-hook' (setting hook to nil)",
2017 static void push_this_command_keys (Lisp_Object event);
2018 static void push_recent_keys (Lisp_Object event);
2019 static void dribble_out_event (Lisp_Object event);
2020 static void execute_internal_event (Lisp_Object event);
2022 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2023 Return the next available event.
2024 Pass this object to `dispatch-event' to handle it.
2025 In most cases, you will want to use `next-command-event', which returns
2026 the next available "user" event (i.e. keypress, button-press,
2027 button-release, or menu selection) instead of this function.
2029 If EVENT is non-nil, it should be an event object and will be filled in
2030 and returned; otherwise a new event object will be created and returned.
2031 If PROMPT is non-nil, it should be a string and will be displayed in the
2032 echo area while this function is waiting for an event.
2034 The next available event will be
2036 -- any events in `unread-command-events' or `unread-command-event'; else
2037 -- the next event in the currently executing keyboard macro, if any; else
2038 -- an event queued by `enqueue-eval-event', if any; else
2039 -- the next available event from the window system or terminal driver.
2041 In the last case, this function will block until an event is available.
2043 The returned event will be one of the following types:
2045 -- a key-press event.
2046 -- a button-press or button-release event.
2047 -- a misc-user-event, meaning the user selected an item on a menu or used
2049 -- a process event, meaning that output from a subprocess is available.
2050 -- a timeout event, meaning that a timeout has elapsed.
2051 -- an eval event, which simply causes a function to be executed when the
2052 event is dispatched. Eval events are generated by `enqueue-eval-event'
2053 or by certain other conditions happening.
2054 -- a magic event, indicating that some window-system-specific event
2055 happened (such as a focus-change notification) that must be handled
2056 synchronously with other events. `dispatch-event' knows what to do with
2061 /* This function can call lisp */
2062 /* #### We start out using the selected console before an event
2063 is received, for echoing the partially completed command.
2064 This is most definitely wrong -- there needs to be a separate
2065 echo area for each console! */
2066 struct console *con = XCONSOLE (Vselected_console);
2067 struct command_builder *command_builder =
2068 XCOMMAND_BUILDER (con->command_builder);
2069 int store_this_key = 0;
2070 struct gcpro gcpro1;
2073 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2074 We want to read the ^G as an event. */
2076 #ifdef LWLIB_MENUBARS_LUCID
2078 * #### Fix the menu code so this isn't necessary.
2080 * We cannot allow the lwmenu code to be reentered, because the
2081 * code is not written to be reentrant and will crash. Therefore
2082 * paths from the menu callbacks back into the menu code have to
2083 * be blocked. Fnext_event is the normal path into the menu code,
2084 * so we signal an error here.
2086 if (in_menu_callback)
2087 error ("Attempt to call next-event inside menu callback");
2088 #endif /* LWLIB_MENUBARS_LUCID */
2091 event = Fmake_event (Qnil, Qnil);
2093 CHECK_LIVE_EVENT (event);
2098 CHECK_STRING (prompt);
2100 len = XSTRING_LENGTH (prompt);
2101 if (command_builder->echo_buf_length < len)
2102 len = command_builder->echo_buf_length - 1;
2103 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2104 command_builder->echo_buf[len] = 0;
2105 command_builder->echo_buf_index = len;
2106 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2107 command_builder->echo_buf,
2109 command_builder->echo_buf_index,
2113 start_over_and_avoid_hosage:
2115 /* If there is something in unread-command-events, simply return it.
2116 But do some error checking to make sure the user hasn't put something
2117 in the unread-command-events that they shouldn't have.
2118 This does not update this-command-keys and recent-keys.
2120 if (!NILP (Vunread_command_events))
2122 if (!CONSP (Vunread_command_events))
2124 Vunread_command_events = Qnil;
2125 signal_error (Qwrong_type_argument,
2126 list3 (Qconsp, Vunread_command_events,
2127 Qunread_command_events));
2131 Lisp_Object e = XCAR (Vunread_command_events);
2132 Vunread_command_events = XCDR (Vunread_command_events);
2133 if (!EVENTP (e) || !command_event_p (e))
2134 signal_error (Qwrong_type_argument,
2135 list3 (Qcommand_event_p, e, Qunread_command_events));
2138 Fcopy_event (e, event);
2139 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2143 /* Do similar for unread-command-event (obsoleteness support). */
2144 else if (!NILP (Vunread_command_event))
2146 Lisp_Object e = Vunread_command_event;
2147 Vunread_command_event = Qnil;
2149 if (!EVENTP (e) || !command_event_p (e))
2151 signal_error (Qwrong_type_argument,
2152 list3 (Qeventp, e, Qunread_command_event));
2155 Fcopy_event (e, event);
2157 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2160 /* If we're executing a keyboard macro, take the next event from that,
2161 and update this-command-keys and recent-keys.
2162 Note that the unread-command-events take precedence over kbd macros.
2166 if (!NILP (Vexecuting_macro))
2169 pop_kbd_macro_event (event); /* This throws past us at
2172 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2174 /* Otherwise, read a real event, possibly from the
2175 command_event_queue, and update this-command-keys and
2179 run_pre_idle_hook ();
2181 next_event_internal (event, 1);
2182 Vquit_flag = Qnil; /* Read C-g as an event. */
2187 status_notify (); /* Notice process change */
2190 alloca (0); /* Cause a garbage collection now */
2191 /* Since we can free the most stuff here
2192 * (since this is typically called from
2193 * the command-loop top-level). */
2194 #endif /* C_ALLOCA */
2196 if (object_dead_p (XEVENT (event)->channel))
2197 /* event_console_or_selected may crash if the channel is dead.
2198 Best just to eat it and get the next event. */
2199 goto start_over_and_avoid_hosage;
2201 /* OK, now we can stop the selected-console kludge and use the
2202 actual console from the event. */
2203 con = event_console_or_selected (event);
2204 command_builder = XCOMMAND_BUILDER (con->command_builder);
2206 switch (XEVENT_TYPE (event))
2210 case button_release_event:
2211 case misc_user_event:
2212 /* don't echo menu accelerator keys */
2213 reset_key_echo (command_builder, 1);
2215 case button_press_event: /* key or mouse input can trigger prompting */
2216 goto STORE_AND_EXECUTE_KEY;
2217 case key_press_event: /* any key input can trigger autosave */
2221 maybe_do_auto_save ();
2223 STORE_AND_EXECUTE_KEY:
2226 echo_key_event (command_builder, event);
2230 /* Store the last-input-event. The semantics of this is that it is
2231 the thing most recently returned by next-command-event. It need
2232 not have come from the keyboard or a keyboard macro, it may have
2233 come from unread-command-events. It's always a command-event (a
2234 key, click, or menu selection), never a motion or process event.
2236 if (!EVENTP (Vlast_input_event))
2237 Vlast_input_event = Fmake_event (Qnil, Qnil);
2238 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2240 Vlast_input_event = Fmake_event (Qnil, Qnil);
2241 error ("Someone deallocated last-input-event!");
2243 if (! EQ (event, Vlast_input_event))
2244 Fcopy_event (event, Vlast_input_event);
2246 /* last-input-char and last-input-time are derived from
2248 Note that last-input-char will never have its high-bit set, in an
2249 effort to sidestep the ambiguity between M-x and oslash.
2251 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2256 if (!CONSP (Vlast_input_time))
2257 Vlast_input_time = Fcons (Qnil, Qnil);
2258 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2259 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2260 if (!CONSP (Vlast_command_event_time))
2261 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2262 XCAR (Vlast_command_event_time) =
2263 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2264 XCAR (XCDR (Vlast_command_event_time)) =
2265 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2266 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2267 = make_int (EMACS_USECS (t));
2269 /* If this key came from the keyboard or from a keyboard macro, then
2270 it goes into the recent-keys and this-command-keys vectors.
2271 If this key came from the keyboard, and we're defining a keyboard
2272 macro, then it goes into the macro.
2276 push_this_command_keys (event);
2277 if (!inhibit_input_event_recording)
2278 push_recent_keys (event);
2279 dribble_out_event (event);
2280 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2282 if (!EVENTP (command_builder->current_events))
2283 finalize_kbd_macro_chars (con);
2284 store_kbd_macro_event (event);
2287 /* If this is the help char and there is a help form, then execute the
2288 help form and swallow this character. This is the only place where
2289 calling Fnext_event() can cause arbitrary lisp code to run. Note
2290 that execute_help_form() calls Fnext_command_event(), which calls
2291 this function, as well as Fdispatch_event.
2293 if (!NILP (Vhelp_form) &&
2294 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2295 execute_help_form (command_builder, event);
2302 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2303 Return the next available "user" event.
2304 Pass this object to `dispatch-event' to handle it.
2306 If EVENT is non-nil, it should be an event object and will be filled in
2307 and returned; otherwise a new event object will be created and returned.
2308 If PROMPT is non-nil, it should be a string and will be displayed in the
2309 echo area while this function is waiting for an event.
2311 The event returned will be a keyboard, mouse press, or mouse release event.
2312 If there are non-command events available (mouse motion, sub-process output,
2313 etc) then these will be executed (with `dispatch-event') and discarded. This
2314 function is provided as a convenience; it is roughly equivalent to the lisp code
2317 (next-event event prompt)
2318 (not (or (key-press-event-p event)
2319 (button-press-event-p event)
2320 (button-release-event-p event)
2321 (misc-user-event-p event))))
2322 (dispatch-event event))
2324 but it also makes a provision for displaying keystrokes in the echo area.
2328 /* This function can GC */
2329 struct gcpro gcpro1;
2331 maybe_echo_keys (XCOMMAND_BUILDER
2332 (XCONSOLE (Vselected_console)->
2333 command_builder), 0); /* #### This sucks bigtime */
2336 event = Fnext_event (event, prompt);
2337 if (command_event_p (event))
2340 execute_internal_event (event);
2346 DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2347 Dispatch any pending "magic" events.
2349 This function is useful for forcing the redisplay of native
2350 widgets. Normally these are redisplayed through a native window-system
2351 event encoded as magic event, rather than by the redisplay code. This
2352 function does not call redisplay or do any of the other things that
2357 /* This function can GC */
2358 Lisp_Object event = Qnil;
2359 struct gcpro gcpro1;
2361 event = Fmake_event (Qnil, Qnil);
2363 /* Make sure that there will be something in the native event queue
2364 so that externally managed things (e.g. widgets) get some CPU
2366 event_stream_force_event_pending (selected_frame ());
2368 while (event_stream_event_pending_p (0))
2370 QUIT; /* next_event_internal() does not QUIT. */
2372 /* We're a generator of the command_event_queue, so we can't be a
2373 consumer as well. Also, we have no reason to consult the
2374 command_event_queue; there are only user and eval-events there,
2375 and we'd just have to put them back anyway.
2377 next_event_internal (event, 0); /* blocks */
2378 /* See the comment in accept-process-output about Vquit_flag */
2379 if (XEVENT_TYPE (event) == magic_event ||
2380 XEVENT_TYPE (event) == timeout_event ||
2381 XEVENT_TYPE (event) == process_event ||
2382 XEVENT_TYPE (event) == pointer_motion_event)
2383 execute_internal_event (event);
2386 enqueue_command_event_1 (event);
2391 Fdeallocate_event (event);
2397 reset_current_events (struct command_builder *command_builder)
2399 Lisp_Object event = command_builder->current_events;
2400 reset_command_builder_event_chain (command_builder);
2402 deallocate_event_chain (event);
2405 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2406 Discard any pending "user" events.
2407 Also cancel any kbd macro being defined.
2408 A user event is a key press, button press, button release, or
2409 "misc-user" event (menu selection or scrollbar action).
2413 /* This throws away user-input on the queue, but doesn't process any
2414 events. Calling dispatch_event() here leads to a race condition.
2416 Lisp_Object event = Fmake_event (Qnil, Qnil);
2417 Lisp_Object head = Qnil, tail = Qnil;
2418 Lisp_Object oiq = Vinhibit_quit;
2419 struct gcpro gcpro1, gcpro2;
2420 /* #### not correct here with Vselected_console? Should
2421 discard-input take a console argument, or maybe map over
2423 struct console *con = XCONSOLE (Vselected_console);
2425 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2426 GCPRO2 (event, oiq);
2428 /* If a macro was being defined then we have to mark the modeline
2429 has changed to ensure that it gets updated correctly. */
2430 if (!NILP (con->defining_kbd_macro))
2431 MARK_MODELINE_CHANGED;
2432 con->defining_kbd_macro = Qnil;
2433 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2435 while (!NILP (command_event_queue)
2436 || event_stream_event_pending_p (1))
2438 /* This will take stuff off the command_event_queue, or read it
2439 from the event_stream, but it will not block.
2441 next_event_internal (event, 1);
2442 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2443 It is vitally important that we reset
2444 Vquit_flag here. Otherwise, if we're
2445 reading from a TTY console,
2446 maybe_read_quit_event() will notice
2447 that C-g has been set and send us
2448 another C-g. That will cause us
2449 to get right back here, and read
2450 another C-g, ad infinitum ... */
2452 /* If the event is a user event, ignore it. */
2453 if (!command_event_p (event))
2455 /* Otherwise, chain the event onto our list of events not to ignore,
2456 and keep reading until the queue is empty. This does not mean
2457 that if a subprocess is generating an infinite amount of output,
2458 we will never terminate (*provided* that the behavior of
2459 next_event_cb() is correct -- see the comment in events.h),
2460 because this loop ends as soon as there are no more user events
2461 on the command_event_queue or event_stream.
2463 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2467 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2470 /* Now tack our chain of events back on to the front of the queue.
2471 Actually, since the queue is now drained, we can just replace it.
2472 The effect of this will be that we have deleted all user events
2473 from the input stream without changing the relative ordering of
2474 any other events. (Some events may have been taken from the
2475 event_stream and added to the command_event_queue, however.)
2477 At this time, the command_event_queue will contain only eval_events.
2480 command_event_queue = head;
2481 command_event_queue_tail = tail;
2483 Fdeallocate_event (event);
2486 Vinhibit_quit = oiq;
2491 /**********************************************************************/
2492 /* pausing until an action occurs */
2493 /**********************************************************************/
2495 /* This is used in accept-process-output, sleep-for and sit-for.
2496 Before running any process_events in these routines, we set
2497 recursive_sit_for to Qt, and use this unwind protect to reset it to
2498 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2499 cause it to return immediately.
2501 All of these routines install timeouts, so we clear the installed
2504 Note: It's very easy to break the desired behaviors of these
2505 3 routines. If you make any changes to anything in this area, run
2506 the regression tests at the bottom of the file. -- dmoore */
2510 sit_for_unwind (Lisp_Object timeout_id)
2512 if (!NILP(timeout_id))
2513 Fdisable_timeout (timeout_id);
2515 recursive_sit_for = Qnil;
2519 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2522 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2523 Allow any pending output from subprocesses to be read by Emacs.
2524 It is read into the process' buffers or given to their filter functions.
2525 Non-nil arg PROCESS means do not return until some output has been received
2526 from PROCESS. Nil arg PROCESS means do not return until some output has
2527 been received from any process.
2528 If the second arg is non-nil, it is the maximum number of seconds to wait:
2529 this function will return after that much time even if no input has arrived
2530 from PROCESS. This argument may be a float, meaning wait some fractional
2532 If the third arg is non-nil, it is a number of milliseconds that is added
2533 to the second arg. (This exists only for compatibility.)
2534 Return non-nil iff we received any output before the timeout expired.
2536 (process, timeout_secs, timeout_msecs))
2538 /* This function can GC */
2539 struct gcpro gcpro1, gcpro2;
2540 Lisp_Object event = Qnil;
2541 Lisp_Object result = Qnil;
2542 int timeout_id = -1;
2543 int timeout_enabled = 0;
2545 struct buffer *old_buffer = current_buffer;
2548 /* We preserve the current buffer but nothing else. If a focus
2549 change alters the selected window then the top level event loop
2550 will eventually alter current_buffer to match. In the mean time
2551 we don't want to mess up whatever called this function. */
2553 if (!NILP (process))
2554 CHECK_PROCESS (process);
2556 GCPRO2 (event, process);
2558 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2560 unsigned long msecs = 0;
2561 if (!NILP (timeout_secs))
2562 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2563 if (!NILP (timeout_msecs))
2565 CHECK_NATNUM (timeout_msecs);
2566 msecs += XINT (timeout_msecs);
2570 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2571 timeout_enabled = 1;
2575 event = Fmake_event (Qnil, Qnil);
2577 count = specpdl_depth ();
2578 record_unwind_protect (sit_for_unwind,
2579 timeout_enabled ? make_int (timeout_id) : Qnil);
2580 recursive_sit_for = Qt;
2583 ((NILP (process) && timeout_enabled) ||
2584 (NILP (process) && event_stream_event_pending_p (0)) ||
2586 /* Calling detect_input_pending() is the wrong thing here, because
2587 that considers the Vunread_command_events and command_event_queue.
2588 We don't need to look at the command_event_queue because we are
2589 only interested in process events, which don't go on that. In
2590 fact, we can't read from it anyway, because we put stuff on it.
2592 Note that event_stream->event_pending_p must be called in such
2593 a way that it says whether any events *of any kind* are ready,
2594 not just user events, or (accept-process-output nil) will fail
2595 to dispatch any process events that may be on the queue. It is
2596 not clear to me that this is important, because the top-level
2597 loop will process it, and I don't think that there is ever a
2598 time when one calls accept-process-output with a nil argument
2599 and really need the processes to be handled. */
2601 /* If our timeout has arrived, we move along. */
2602 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2604 timeout_enabled = 0;
2605 done = 1; /* We're done. */
2606 continue; /* Don't call next_event_internal */
2609 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2610 before reading output from the process - this makes it
2611 less likely that the filter will actually be aborted.
2614 next_event_internal (event, 0);
2615 /* If C-g was pressed while we were waiting, Vquit_flag got
2616 set and next_event_internal() also returns C-g. When
2617 we enqueue the C-g below, it will get discarded. The
2618 next time through, QUIT will be called and will signal a quit. */
2619 switch (XEVENT_TYPE (event))
2623 if (NILP (process) ||
2624 EQ (XEVENT (event)->event.process.process, process))
2627 /* RMS's version always returns nil when proc is nil,
2628 and only returns t if input ever arrived on proc. */
2632 execute_internal_event (event);
2636 /* We execute the event even if it's ours, and notice that it's
2638 case pointer_motion_event:
2641 execute_internal_event (event);
2646 enqueue_command_event_1 (event);
2652 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2654 Fdeallocate_event (event);
2656 current_buffer = old_buffer;
2660 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2661 Pause, without updating display, for ARG seconds.
2662 ARG may be a float, meaning pause for some fractional part of a second.
2664 It is recommended that you never call sleep-for from inside of a process
2665 filter function or timer event (either synchronous or asynchronous).
2669 /* This function can GC */
2670 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2672 Lisp_Object event = Qnil;
2674 struct gcpro gcpro1;
2678 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2679 event = Fmake_event (Qnil, Qnil);
2681 count = specpdl_depth ();
2682 record_unwind_protect (sit_for_unwind, make_int (id));
2683 recursive_sit_for = Qt;
2687 /* If our timeout has arrived, we move along. */
2688 if (!event_stream_wakeup_pending_p (id, 0))
2691 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2692 before reading output from the process - this makes it
2693 less likely that the filter will actually be aborted.
2695 /* We're a generator of the command_event_queue, so we can't be a
2696 consumer as well. We don't care about command and eval-events
2699 next_event_internal (event, 0); /* blocks */
2700 /* See the comment in accept-process-output about Vquit_flag */
2701 switch (XEVENT_TYPE (event))
2704 /* We execute the event even if it's ours, and notice that it's
2707 case pointer_motion_event:
2710 execute_internal_event (event);
2715 enqueue_command_event_1 (event);
2721 unbind_to (count, make_int (id));
2722 Fdeallocate_event (event);
2727 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2728 Perform redisplay, then wait ARG seconds or until user input is available.
2729 ARG may be a float, meaning a fractional part of a second.
2730 Optional second arg non-nil means don't redisplay, just wait for input.
2731 Redisplay is preempted as always if user input arrives, and does not
2732 happen if input is available before it starts.
2733 Value is t if waited the full time with no input arriving.
2735 If sit-for is called from within a process filter function or timer
2736 event (either synchronous or asynchronous) it will return immediately.
2738 (seconds, nodisplay))
2740 /* This function can GC */
2741 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2742 Lisp_Object event, result;
2743 struct gcpro gcpro1;
2747 /* The unread-command-events count as pending input */
2748 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2751 /* If the command-builder already has user-input on it (not eval events)
2752 then that means we're done too.
2754 if (!NILP (command_event_queue))
2756 EVENT_CHAIN_LOOP (event, command_event_queue)
2758 if (command_event_p (event))
2763 /* If we're in a macro, or noninteractive, or early in temacs, then
2765 if (noninteractive || !NILP (Vexecuting_macro))
2768 /* Recursive call from a filter function or timeout handler. */
2769 if (!NILP(recursive_sit_for))
2771 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2773 run_pre_idle_hook ();
2780 /* Otherwise, start reading events from the event_stream.
2781 Do this loop at least once even if (sit-for 0) so that we
2782 redisplay when no input pending.
2785 event = Fmake_event (Qnil, Qnil);
2787 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2788 events get processed. The old (pre-19.12) code special-cased this
2789 and didn't generate a wakeup, but the resulting behavior was less than
2790 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2791 the E-Lisp universe. */
2793 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2795 count = specpdl_depth ();
2796 record_unwind_protect (sit_for_unwind, make_int (id));
2797 recursive_sit_for = Qt;
2801 /* If there is no user input pending, then redisplay.
2803 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2805 run_pre_idle_hook ();
2809 /* If our timeout has arrived, we move along. */
2810 if (!event_stream_wakeup_pending_p (id, 0))
2816 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2817 before reading output from the process - this makes it
2818 less likely that the filter will actually be aborted.
2820 /* We're a generator of the command_event_queue, so we can't be a
2821 consumer as well. In fact, we know there's nothing on the
2822 command_event_queue that we didn't just put there.
2824 next_event_internal (event, 0); /* blocks */
2825 /* See the comment in accept-process-output about Vquit_flag */
2827 if (command_event_p (event))
2829 QUIT; /* If the command was C-g check it here
2830 so that we abort out of the sit-for,
2831 not the next command. sleep-for and
2832 accept-process-output continue looping
2833 so they check QUIT again implicitly.*/
2837 switch (XEVENT_TYPE (event))
2841 /* eval-events get delayed until later. */
2842 enqueue_command_event (Fcopy_event (event, Qnil));
2847 /* We execute the event even if it's ours, and notice that it's
2851 execute_internal_event (event);
2858 unbind_to (count, make_int (id));
2860 /* Put back the event (if any) that made Fsit_for() exit before the
2861 timeout. Note that it is being added to the back of the queue, which
2862 would be inappropriate if there were any user events on the queue
2863 already: we would be misordering them. But we know that there are
2864 no user-events on the queue, or else we would not have reached this
2868 enqueue_command_event (event);
2870 Fdeallocate_event (event);
2876 /* This handy little function is used by xselect.c and energize.c to
2877 wait for replies from processes that aren't really processes (that is,
2878 the X server and the Energize server).
2881 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2883 /* This function can GC */
2884 Lisp_Object event = Fmake_event (Qnil, Qnil);
2885 struct gcpro gcpro1;
2888 while (!(*predicate) (predicate_arg))
2890 QUIT; /* next_event_internal() does not QUIT. */
2892 /* We're a generator of the command_event_queue, so we can't be a
2893 consumer as well. Also, we have no reason to consult the
2894 command_event_queue; there are only user and eval-events there,
2895 and we'd just have to put them back anyway.
2897 next_event_internal (event, 0);
2898 /* See the comment in accept-process-output about Vquit_flag */
2899 if (command_event_p (event)
2900 || (XEVENT_TYPE (event) == eval_event)
2901 || (XEVENT_TYPE (event) == magic_eval_event))
2902 enqueue_command_event_1 (event);
2904 execute_internal_event (event);
2910 /**********************************************************************/
2911 /* dispatching events; command builder */
2912 /**********************************************************************/
2915 execute_internal_event (Lisp_Object event)
2917 /* events on dead channels get silently eaten */
2918 if (object_dead_p (XEVENT (event)->channel))
2921 /* This function can GC */
2922 switch (XEVENT_TYPE (event))
2929 call1 (XEVENT (event)->event.eval.function,
2930 XEVENT (event)->event.eval.object);
2934 case magic_eval_event:
2936 (XEVENT (event)->event.magic_eval.internal_function)
2937 (XEVENT (event)->event.magic_eval.object);
2941 case pointer_motion_event:
2943 if (!NILP (Vmouse_motion_handler))
2944 call1 (Vmouse_motion_handler, event);
2950 Lisp_Object p = XEVENT (event)->event.process.process;
2951 Charcount readstatus;
2953 assert (PROCESSP (p));
2954 while ((readstatus = read_process_output (p)) > 0)
2957 ; /* this clauses never gets executed but allows the #ifdefs
2960 else if (readstatus == -1 && errno == EWOULDBLOCK)
2962 #endif /* EWOULDBLOCK */
2964 else if (readstatus == -1 && errno == EAGAIN)
2967 else if ((readstatus == 0 &&
2968 /* Note that we cannot distinguish between no input
2969 available now and a closed pipe.
2970 With luck, a closed pipe will be accompanied by
2971 subprocess termination and SIGCHLD. */
2972 (!network_connection_p (p) ||
2974 When connected to ToolTalk (i.e.
2975 connected_via_filedesc_p()), it's not possible to
2976 reliably determine whether there is a message
2977 waiting for ToolTalk to receive. ToolTalk expects
2978 to have tt_message_receive() called exactly once
2979 every time the file descriptor becomes active, so
2980 the filter function forces this by returning 0.
2981 Emacs must not interpret this as a closed pipe. */
2982 connected_via_filedesc_p (XPROCESS (p))))
2984 /* On some OSs with ptys, when the process on one end of
2985 a pty exits, the other end gets an error reading with
2986 errno = EIO instead of getting an EOF (0 bytes read).
2987 Therefore, if we get an error reading and errno =
2988 EIO, just continue, because the child process has
2989 exited and should clean itself up soon (e.g. when we
2991 || (readstatus == -1 && errno == EIO)
2995 /* Currently, we rely on SIGCHLD to indicate that the
2996 process has terminated. Unfortunately, on some systems
2997 the SIGCHLD gets missed some of the time. So we put an
2998 additional check in status_notify() to see whether a
2999 process has terminated. We must tell status_notify()
3000 to enable that check, and we do so now. */
3001 kick_status_notify ();
3005 /* Deactivate network connection */
3006 Lisp_Object status = Fprocess_status (p);
3007 if (EQ (status, Qopen)
3008 /* In case somebody changes the theory of whether to
3009 return open as opposed to run for network connection
3011 || EQ (status, Qrun))
3012 update_process_status (p, Qexit, 256, 0);
3013 deactivate_process (p);
3016 /* We must call status_notify here to allow the
3017 event_stream->unselect_process_cb to be run if appropriate.
3018 Otherwise, dead fds may be selected for, and we will get a
3019 continuous stream of process events for them. Since we don't
3020 return until all process events have been flushed, we would
3021 get stuck here, processing events on a process whose status
3022 was 'exit. Call this after dispatch-event, or the fds will
3023 have been closed before we read the last data from them.
3024 It's safe for the filter to signal an error because
3025 status_notify() will be called on return to top-level.
3033 Lisp_Event *e = XEVENT (event);
3034 if (!NILP (e->event.timeout.function))
3035 call1 (e->event.timeout.function,
3036 e->event.timeout.object);
3041 event_stream_handle_magic_event (XEVENT (event));
3052 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3054 Lisp_Object first_before_suffix =
3055 event_chain_find_previous (Vthis_command_keys, suffix);
3057 if (NILP (first_before_suffix))
3058 Vthis_command_keys = chain;
3060 XSET_EVENT_NEXT (first_before_suffix, chain);
3061 deallocate_event_chain (suffix);
3062 Vthis_command_keys_tail = event_chain_tail (chain);
3066 command_builder_replace_suffix (struct command_builder *builder,
3067 Lisp_Object suffix, Lisp_Object chain)
3069 Lisp_Object first_before_suffix =
3070 event_chain_find_previous (builder->current_events, suffix);
3072 if (NILP (first_before_suffix))
3073 builder->current_events = chain;
3075 XSET_EVENT_NEXT (first_before_suffix, chain);
3076 deallocate_event_chain (suffix);
3077 builder->most_current_event = event_chain_tail (chain);
3081 command_builder_find_leaf_1 (struct command_builder *builder)
3083 Lisp_Object event0 = builder->current_events;
3088 return event_binding (event0, 1);
3091 /* See if we can do function-key-map or key-translation-map translation
3092 on the current events in the command builder. If so, do this, and
3093 return the resulting binding, if any. */
3096 munge_keymap_translate (struct command_builder *builder,
3097 enum munge_me_out_the_door munge,
3098 int has_normal_binding_p)
3102 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3104 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3109 if (KEYMAPP (result))
3111 if (NILP (builder->last_non_munged_event)
3112 && !has_normal_binding_p)
3113 builder->last_non_munged_event = builder->most_current_event;
3116 builder->last_non_munged_event = Qnil;
3118 if (!KEYMAPP (result) &&
3119 !VECTORP (result) &&
3122 struct gcpro gcpro1;
3124 result = call1 (result, Qnil);
3130 if (KEYMAPP (result))
3133 if (VECTORP (result) || STRINGP (result))
3135 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3139 /* If the first_mungeable_event of the other munger is
3140 within the events we're munging, then it will point to
3141 deallocated events afterwards, which is bad -- so make it
3142 point at the beginning of the munged events. */
3143 EVENT_CHAIN_LOOP (tempev, suffix)
3145 Lisp_Object *mungeable_event =
3146 &builder->munge_me[1 - munge].first_mungeable_event;
3147 if (EQ (tempev, *mungeable_event))
3149 *mungeable_event = new_chain;
3154 n = event_chain_count (suffix);
3155 command_builder_replace_suffix (builder, suffix, new_chain);
3156 builder->munge_me[munge].first_mungeable_event = Qnil;
3157 /* Now hork this-command-keys as well. */
3159 /* We just assume that the events we just replaced are
3160 sitting in copied form at the end of this-command-keys.
3161 If the user did weird things with `dispatch-event' this
3162 may not be the case, but at least we make sure we won't
3164 new_chain = copy_event_chain (new_chain);
3165 tckn = event_chain_count (Vthis_command_keys);
3168 this_command_keys_replace_suffix
3169 (event_chain_nth (Vthis_command_keys, tckn - n),
3173 result = command_builder_find_leaf_1 (builder);
3177 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3178 "Invalid binding in function-key-map" :
3179 "Invalid binding in key-translation-map"),
3186 /* Compare the current state of the command builder against the local and
3187 global keymaps, and return the binding. If there is no match, try again,
3188 case-insensitively. The return value will be one of:
3189 -- nil (there is no binding)
3190 -- a keymap (part of a command has been specified)
3191 -- a command (anything that satisfies `commandp'; this includes
3192 some symbols, lists, subrs, strings, vectors, and
3193 compiled-function objects)
3196 command_builder_find_leaf (struct command_builder *builder,
3197 int allow_misc_user_events_p)
3199 /* This function can GC */
3201 Lisp_Object evee = builder->current_events;
3203 if (XEVENT_TYPE (evee) == misc_user_event)
3205 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3206 return list2 (XEVENT (evee)->event.eval.function,
3207 XEVENT (evee)->event.eval.object);
3212 /* if we're currently in a menu accelerator, check there for further
3214 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
3215 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3216 if (x_kludge_lw_menu_active ())
3218 return command_builder_operate_menu_accelerator (builder);
3223 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3224 result = command_builder_find_menu_accelerator (builder);
3227 result = command_builder_find_leaf_1 (builder);
3228 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3230 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3231 result = command_builder_find_menu_accelerator (builder);
3235 /* Check to see if we have a potential function-key-map match. */
3238 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3239 regenerate_echo_keys_from_this_command_keys (builder);
3241 /* Check to see if we have a potential key-translation-map match. */
3243 Lisp_Object key_translate_result =
3244 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3246 if (!NILP (key_translate_result))
3248 result = key_translate_result;
3249 regenerate_echo_keys_from_this_command_keys (builder);
3256 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3258 /* If we didn't find a binding, and the last event in the sequence is
3259 a shifted character, then try again with the lowercase version. */
3261 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3262 && !NILP (Vretry_undefined_key_binding_unshifted))
3264 Lisp_Object terminal = builder->most_current_event;
3265 struct key_data* key = & XEVENT (terminal)->event.key;
3267 if ((key->modifiers & XEMACS_MOD_SHIFT)
3268 || (CHAR_OR_CHAR_INTP (key->keysym)
3269 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3271 Lisp_Event terminal_copy = *XEVENT (terminal);
3273 if (key->modifiers & XEMACS_MOD_SHIFT)
3274 key->modifiers &= (~ XEMACS_MOD_SHIFT);
3276 key->keysym = make_char (c + 'a' - 'A');
3278 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3281 /* If there was no match with the lower-case version either,
3282 then put back the upper-case event for the error
3283 message. But make sure that function-key-map didn't
3284 change things out from under us. */
3285 if (EQ (terminal, builder->most_current_event))
3286 *XEVENT (terminal) = terminal_copy;
3290 /* help-char is `auto-bound' in every keymap */
3291 if (!NILP (Vprefix_help_command) &&
3292 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3294 return Vprefix_help_command;
3297 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3298 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3299 && !NILP (Vcomposed_character_default_binding))
3301 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3302 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3303 return Vcomposed_character_default_binding;
3305 #endif /* HAVE_XIM */
3307 /* If we read extra events attempting to match a function key but end
3308 up failing, then we release those events back to the command loop
3309 and fail on the original lookup. The released events will then be
3310 reprocessed in the context of the first part having failed. */
3311 if (!NILP (builder->last_non_munged_event))
3313 Lisp_Object event0 = builder->last_non_munged_event;
3315 /* Put the commands back on the event queue. */
3316 enqueue_event_chain (XEVENT_NEXT (event0),
3317 &command_event_queue,
3318 &command_event_queue_tail);
3320 /* Then remove them from the command builder. */
3321 XSET_EVENT_NEXT (event0, Qnil);
3322 builder->most_current_event = event0;
3323 builder->last_non_munged_event = Qnil;
3330 /* Every time a command-event (a key, button, or menu selection) is read by
3331 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3332 and in Vthis_command_keys. (Eval-events are not stored there.)
3334 Every time a command is invoked, Vlast_command_event is set to the last
3335 event in the sequence.
3337 This means that Vthis_command_keys is really about "input read since the
3338 last command was executed" rather than about "what keys invoked this
3339 command." This is a little counterintuitive, but that's the way it
3342 As an extra kink, the function read-key-sequence resets/updates the
3343 last-command-event and this-command-keys. It doesn't append to the
3344 command-keys as read-char does. Such are the pitfalls of having to
3345 maintain compatibility with a program for which the only specification
3348 (We could implement recent_keys_ring and Vthis_command_keys as the same
3352 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3353 Return a vector of recent keyboard or mouse button events read.
3354 If NUMBER is non-nil, not more than NUMBER events will be returned.
3355 Change number of events stored using `set-recent-keys-ring-size'.
3357 This copies the event objects into a new vector; it is safe to keep and
3362 struct gcpro gcpro1;
3363 Lisp_Object val = Qnil;
3365 int start, nkeys, i, j;
3369 nwanted = recent_keys_ring_size;
3372 CHECK_NATNUM (number);
3373 nwanted = XINT (number);
3376 /* Create the keys ring vector, if none present. */
3377 if (NILP (Vrecent_keys_ring))
3379 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3380 /* And return nothing in particular. */
3381 return make_vector (0, Qnil);
3384 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3385 /* This means the vector has not yet wrapped */
3387 nkeys = recent_keys_ring_index;
3392 nkeys = recent_keys_ring_size;
3393 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3396 if (nwanted < nkeys)
3398 start += nkeys - nwanted;
3399 if (start >= recent_keys_ring_size)
3400 start -= recent_keys_ring_size;
3406 val = make_vector (nwanted, Qnil);
3408 for (i = 0, j = start; i < nkeys; i++)
3410 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3414 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3415 if (++j >= recent_keys_ring_size)
3423 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3424 The maximum number of events `recent-keys' can return.
3428 return make_int (recent_keys_ring_size);
3431 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3432 Set the maximum number of events to be stored internally.
3436 Lisp_Object new_vector = Qnil;
3437 int i, j, nkeys, start, min;
3438 struct gcpro gcpro1;
3439 GCPRO1 (new_vector);
3442 if (XINT (size) <= 0)
3443 error ("Recent keys ring size must be positive");
3444 if (XINT (size) == recent_keys_ring_size)
3447 new_vector = make_vector (XINT (size), Qnil);
3449 if (NILP (Vrecent_keys_ring))
3451 Vrecent_keys_ring = new_vector;
3455 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3456 /* This means the vector has not yet wrapped */
3458 nkeys = recent_keys_ring_index;
3463 nkeys = recent_keys_ring_size;
3464 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3467 if (XINT (size) > nkeys)
3472 for (i = 0, j = start; i < min; i++)
3474 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3475 if (++j >= recent_keys_ring_size)
3478 recent_keys_ring_size = XINT (size);
3479 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3481 Vrecent_keys_ring = new_vector;
3487 /* Vthis_command_keys having value Qnil means that the next time
3488 push_this_command_keys is called, it should start over.
3489 The times at which the command-keys are reset
3490 (instead of merely being augmented) are pretty counterintuitive.
3493 -- We do not reset this-command-keys when we finish reading a
3494 command. This is because some commands (e.g. C-u) act
3495 like command prefixes; they signal this by setting prefix-arg
3497 -- Therefore, we reset this-command-keys when we finish
3498 executing a command, unless prefix-arg is set.
3499 -- However, if we ever do a non-local exit out of a command
3500 loop (e.g. an error in a command), we need to reset
3501 this-command-keys. We do this by calling reset_this_command_keys()
3502 from cmdloop.c, whenever an error causes an invocation of the
3503 default error handler, and whenever there's a throw to top-level.)
3507 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
3509 struct command_builder *command_builder =
3510 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
3512 reset_key_echo (command_builder, clear_echo_area_p);
3514 deallocate_event_chain (Vthis_command_keys);
3515 Vthis_command_keys = Qnil;
3516 Vthis_command_keys_tail = Qnil;
3518 reset_current_events (command_builder);
3522 push_this_command_keys (Lisp_Object event)
3524 Lisp_Object new = Fmake_event (Qnil, Qnil);
3526 Fcopy_event (event, new);
3527 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
3530 /* The following two functions are used in call-interactively,
3531 for the @ and e specifications. We used to just use
3532 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3533 but FSF does it more generally so we follow their lead. */
3536 extract_this_command_keys_nth_mouse_event (int n)
3540 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3543 && (XEVENT_TYPE (event) == button_press_event
3544 || XEVENT_TYPE (event) == button_release_event
3545 || XEVENT_TYPE (event) == misc_user_event))
3549 /* must copy to avoid an abort() in next_event_internal() */
3550 if (!NILP (XEVENT_NEXT (event)))
3551 return Fcopy_event (event, Qnil);
3563 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
3566 int len = XVECTOR_LENGTH (vector);
3568 for (i = 0; i < len; i++)
3570 Lisp_Object event = XVECTOR_DATA (vector)[i];
3572 switch (XEVENT_TYPE (event))
3574 case button_press_event :
3575 case button_release_event :
3576 case misc_user_event :
3590 push_recent_keys (Lisp_Object event)
3594 if (NILP (Vrecent_keys_ring))
3595 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3597 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
3601 e = Fmake_event (Qnil, Qnil);
3602 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
3604 Fcopy_event (event, e);
3605 if (++recent_keys_ring_index == recent_keys_ring_size)
3606 recent_keys_ring_index = 0;
3611 current_events_into_vector (struct command_builder *command_builder)
3615 int n = event_chain_count (command_builder->current_events);
3617 /* Copy the vector and the events in it. */
3618 /* No need to copy the events, since they're already copies, and
3619 nobody other than the command-builder has pointers to them */
3620 vector = make_vector (n, Qnil);
3622 EVENT_CHAIN_LOOP (event, command_builder->current_events)
3623 XVECTOR_DATA (vector)[n++] = event;
3624 reset_command_builder_event_chain (command_builder);
3630 Given the current state of the command builder and a new command event
3631 that has just been dispatched:
3633 -- add the event to the event chain forming the current command
3634 (doing meta-translation as necessary)
3635 -- return the binding of this event chain; this will be one of:
3636 -- nil (there is no binding)
3637 -- a keymap (part of a command has been specified)
3638 -- a command (anything that satisfies `commandp'; this includes
3639 some symbols, lists, subrs, strings, vectors, and
3640 compiled-function objects)
3643 lookup_command_event (struct command_builder *command_builder,
3644 Lisp_Object event, int allow_misc_user_events_p)
3646 /* This function can GC */
3647 struct frame *f = selected_frame ();
3648 /* Clear output from previous command execution */
3649 if (!EQ (Qcommand, echo_area_status (f))
3650 /* but don't let mouse-up clear what mouse-down just printed */
3651 && (XEVENT (event)->event_type != button_release_event))
3652 clear_echo_area (f, Qnil, 0);
3654 /* Add the given event to the command builder.
3655 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3656 vectors to translate "ESC x" to "M-x" (for any "x" of course).
3659 Lisp_Object recent = command_builder->most_current_event;
3662 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
3665 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3666 DoubleThink the recent-keys and this-command-keys as well. */
3668 /* Modify the previous most-recently-pushed event on the command
3669 builder to be a copy of this one with the meta-bit set instead of
3670 pushing a new event.
3672 Fcopy_event (event, recent);
3673 e = XEVENT (recent);
3674 if (e->event_type == key_press_event)
3675 e->event.key.modifiers |= XEMACS_MOD_META;
3676 else if (e->event_type == button_press_event
3677 || e->event_type == button_release_event)
3678 e->event.button.modifiers |= XEMACS_MOD_META;
3683 int tckn = event_chain_count (Vthis_command_keys);
3685 /* ??? very strange if it's < 2. */
3686 this_command_keys_replace_suffix
3687 (event_chain_nth (Vthis_command_keys, tckn - 2),
3688 Fcopy_event (recent, Qnil));
3691 regenerate_echo_keys_from_this_command_keys (command_builder);
3695 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
3697 command_builder_append_event (command_builder, event);
3702 Lisp_Object leaf = command_builder_find_leaf (command_builder,
3703 allow_misc_user_events_p);
3704 struct gcpro gcpro1;
3709 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3710 if (!x_kludge_lw_menu_active ())
3715 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
3716 if (STRINGP (prompt))
3718 /* Append keymap prompt to key echo buffer */
3719 int buf_index = command_builder->echo_buf_index;
3720 Bytecount len = XSTRING_LENGTH (prompt);
3722 if (len + buf_index + 1 <= command_builder->echo_buf_length)
3724 Bufbyte *echo = command_builder->echo_buf + buf_index;
3725 memcpy (echo, XSTRING_DATA (prompt), len);
3728 maybe_echo_keys (command_builder, 1);
3731 maybe_echo_keys (command_builder, 0);
3733 else if (!NILP (Vquit_flag))
3735 Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
3736 Lisp_Event *e = XEVENT (quit_event);
3737 /* if quit happened during menu acceleration, pretend we read it */
3738 struct console *con = XCONSOLE (Fselected_console ());
3739 int ch = CONSOLE_QUIT_CHAR (con);
3741 character_to_event (ch, e, con, 1, 1);
3742 e->channel = make_console (con);
3744 enqueue_command_event (quit_event);
3748 else if (!NILP (leaf))
3750 if (EQ (Qcommand, echo_area_status (f))
3751 && command_builder->echo_buf_index > 0)
3753 /* If we had been echoing keys, echo the last one (without
3754 the trailing dash) and redisplay before executing the
3756 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
3757 maybe_echo_keys (command_builder, 1);
3758 Fsit_for (Qzero, Qt);
3761 RETURN_UNGCPRO (leaf);
3766 execute_command_event (struct command_builder *command_builder,
3769 /* This function can GC */
3770 struct console *con = XCONSOLE (command_builder->console);
3771 struct gcpro gcpro1;
3773 GCPRO1 (event); /* event may be freshly created */
3774 reset_current_events (command_builder);
3776 switch (XEVENT (event)->event_type)
3778 case key_press_event:
3779 Vcurrent_mouse_event = Qnil;
3781 case button_press_event:
3782 case button_release_event:
3783 case misc_user_event:
3784 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
3789 /* Store the last-command-event. The semantics of this is that it
3790 is the last event most recently involved in command-lookup. */
3791 if (!EVENTP (Vlast_command_event))
3792 Vlast_command_event = Fmake_event (Qnil, Qnil);
3793 if (XEVENT (Vlast_command_event)->event_type == dead_event)
3795 Vlast_command_event = Fmake_event (Qnil, Qnil);
3796 error ("Someone deallocated the last-command-event!");
3799 if (! EQ (event, Vlast_command_event))
3800 Fcopy_event (event, Vlast_command_event);
3802 /* Note that last-command-char will never have its high-bit set, in
3803 an effort to sidestep the ambiguity between M-x and oslash. */
3804 Vlast_command_char = Fevent_to_character (Vlast_command_event,
3807 /* Actually call the command, with all sorts of hair to preserve or clear
3808 the echo-area and region as appropriate and call the pre- and post-
3811 int old_kbd_macro = con->kbd_macro_end;
3812 struct window *w = XWINDOW (Fselected_window (Qnil));
3814 /* We're executing a new command, so the old value is irrelevant. */
3815 zmacs_region_stays = 0;
3817 /* If the previous command tried to force a specific window-start,
3818 reset the flag in case this command moves point far away from
3819 that position. Also, reset the window's buffer's change
3820 information so that we don't trigger an incremental update. */
3824 buffer_reset_changes (XBUFFER (w->buffer));
3827 pre_command_hook ();
3829 if (XEVENT (event)->event_type == misc_user_event)
3831 call1 (XEVENT (event)->event.eval.function,
3832 XEVENT (event)->event.eval.object);
3836 Fcommand_execute (Vthis_command, Qnil, Qnil);
3839 post_command_hook ();
3841 #if 0 /* #### here was an attempted fix that didn't work */
3842 if (XEVENT (event)->event_type == misc_user_event)
3846 if (!NILP (con->prefix_arg))
3848 /* Commands that set the prefix arg don't update last-command, don't
3849 reset the echoing state, and don't go into keyboard macros unless
3850 followed by another command. */
3851 maybe_echo_keys (command_builder, 0);
3853 /* If we're recording a keyboard macro, and the last command
3854 executed set a prefix argument, then decrement the pointer to
3855 the "last character really in the macro" to be just before this
3856 command. This is so that the ^U in "^U ^X )" doesn't go onto
3857 the end of macro. */
3858 if (!NILP (con->defining_kbd_macro))
3859 con->kbd_macro_end = old_kbd_macro;
3863 /* Start a new command next time */
3864 Vlast_command = Vthis_command;
3865 Vlast_command_properties = Vthis_command_properties;
3866 Vthis_command_properties = Qnil;
3868 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
3869 so we don't either */
3870 reset_this_command_keys (make_console (con), 0);
3877 /* Run the pre command hook. */
3880 pre_command_hook (void)
3882 last_point_position = BUF_PT (current_buffer);
3883 XSETBUFFER (last_point_position_buffer, current_buffer);
3884 /* This function can GC */
3885 safe_run_hook_trapping_errors
3886 ("Error in `pre-command-hook' (setting hook to nil)",
3887 Qpre_command_hook, 1);
3889 /* This is a kludge, but necessary; see simple.el */
3890 call0 (Qhandle_pre_motion_command);
3893 /* Run the post command hook. */
3896 post_command_hook (void)
3898 /* This function can GC */
3899 /* Turn off region highlighting unless this command requested that
3900 it be left on, or we're in the minibuffer. We don't turn it off
3901 when we're in the minibuffer so that things like M-x write-region
3904 This could be done via a function on the post-command-hook, but
3905 we don't want the user to accidentally remove it.
3908 Lisp_Object win = Fselected_window (Qnil);
3910 /* If the last command deleted the frame, `win' might be nil.
3911 It seems safest to do nothing in this case. */
3912 /* Note: Someone added the following comment and put #if 0's around
3913 this code, not realizing that doing this invites a crash in the
3915 /* #### This doesn't really fix the problem,
3916 if delete-frame is called by some hook */
3920 /* This is a kludge, but necessary; see simple.el */
3921 call0 (Qhandle_post_motion_command);
3923 if (! zmacs_region_stays
3924 && (!MINI_WINDOW_P (XWINDOW (win))
3925 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
3926 zmacs_deactivate_region ();
3928 zmacs_update_region ();
3930 safe_run_hook_trapping_errors
3931 ("Error in `post-command-hook' (setting hook to nil)",
3932 Qpost_command_hook, 1);
3934 #if 0 /* FSF Emacs crap */
3935 if (!NILP (Vdeferred_action_list))
3936 call0 (Vdeferred_action_function);
3938 if (NILP (Vunread_command_events)
3939 && NILP (Vexecuting_macro)
3940 && !NILP (Vpost_command_idle_hook)
3941 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
3943 safe_run_hook_trapping_errors
3944 ("Error in `post-command-idle-hook' (setting hook to nil)",
3945 Qpost_command_idle_hook, 1);
3946 #endif /* FSF Emacs crap */
3948 #if 0 /* FSF Emacs */
3949 if (!NILP (current_buffer->mark_active))
3951 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
3953 current_buffer->mark_active = Qnil;
3954 run_hook (intern ("deactivate-mark-hook"));
3956 else if (current_buffer != prev_buffer ||
3957 BUF_MODIFF (current_buffer) != prev_modiff)
3958 run_hook (intern ("activate-mark-hook"));
3960 #endif /* FSF Emacs */
3962 /* #### Kludge!!! This is necessary to make sure that things
3963 are properly positioned even if post-command-hook moves point.
3964 #### There should be a cleaner way of handling this. */
3965 call0 (Qauto_show_make_point_visible);
3969 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
3970 Given an event object as returned by `next-event', execute it.
3972 Key-press, button-press, and button-release events get accumulated
3973 until a complete key sequence (see `read-key-sequence') is reached,
3974 at which point the sequence is looked up in the current keymaps and
3977 Mouse motion events cause the low-level handling function stored in
3978 `mouse-motion-handler' to be called. (There are very few circumstances
3979 under which you should change this handler. Use `mode-motion-hook'
3982 Menu, timeout, and eval events cause the associated function or handler
3985 Process events cause the subprocess's output to be read and acted upon
3986 appropriately (see `start-process').
3988 Magic events are handled as necessary.
3992 /* This function can GC */
3993 struct command_builder *command_builder;
3995 Lisp_Object console;
3996 Lisp_Object channel;
3998 CHECK_LIVE_EVENT (event);
3999 ev = XEVENT (event);
4001 /* events on dead channels get silently eaten */
4002 channel = EVENT_CHANNEL (ev);
4003 if (object_dead_p (channel))
4006 /* Some events don't have channels (e.g. eval events). */
4007 console = CDFW_CONSOLE (channel);
4009 console = Vselected_console;
4010 else if (!EQ (console, Vselected_console))
4011 Fselect_console (console);
4013 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4014 switch (XEVENT (event)->event_type)
4016 case button_press_event:
4017 case button_release_event:
4018 case key_press_event:
4020 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4023 /* Incomplete key sequence */
4027 /* At this point, we know that the sequence is not bound to a
4028 command. Normally, we beep and print a message informing the
4029 user of this. But we do not beep or print a message when:
4031 o the last event in this sequence is a mouse-up event; or
4032 o the last event in this sequence is a mouse-down event and
4033 there is a binding for the mouse-up version.
4035 That is, if the sequence ``C-x button1'' is typed, and is not
4036 bound to a command, but the sequence ``C-x button1up'' is bound
4037 to a command, we do not complain about the ``C-x button1''
4038 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4039 bound to a command, then we complain about the ``C-x button1''
4040 sequence, but later will *not* complain about the
4041 ``C-x button1up'' sequence, which would be redundant.
4043 This is pretty hairy, but I think it's the most intuitive
4046 Lisp_Object terminal = command_builder->most_current_event;
4048 if (XEVENT_TYPE (terminal) == button_press_event)
4051 /* Temporarily pretend the last event was an "up" instead of a
4052 "down", and look up its binding. */
4053 XEVENT_TYPE (terminal) = button_release_event;
4054 /* If the "up" version is bound, don't complain. */
4056 = !NILP (command_builder_find_leaf (command_builder, 0));
4057 /* Undo the temporary changes we just made. */
4058 XEVENT_TYPE (terminal) = button_press_event;
4061 /* Pretend this press was not seen (treat as a prefix) */
4062 if (EQ (command_builder->current_events, terminal))
4064 reset_current_events (command_builder);
4070 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4071 if (EQ (XEVENT_NEXT (eve), terminal))
4074 Fdeallocate_event (command_builder->
4075 most_current_event);
4076 XSET_EVENT_NEXT (eve, Qnil);
4077 command_builder->most_current_event = eve;
4079 maybe_echo_keys (command_builder, 1);
4084 /* Complain that the typed sequence is not defined, if this is the
4085 kind of sequence that warrants a complaint. */
4086 XCONSOLE (console)->defining_kbd_macro = Qnil;
4087 XCONSOLE (console)->prefix_arg = Qnil;
4088 /* Don't complain about undefined button-release events */
4089 if (XEVENT_TYPE (terminal) != button_release_event)
4091 Lisp_Object keys = current_events_into_vector (command_builder);
4092 struct gcpro gcpro1;
4094 /* Run the pre-command-hook before barfing about an undefined
4096 Vthis_command = Qnil;
4098 pre_command_hook ();
4100 /* The post-command-hook doesn't run. */
4101 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4103 /* Reset the command builder for reading the next sequence. */
4104 reset_this_command_keys (console, 1);
4106 else /* key sequence is bound to a command */
4109 int magic_undo_count = 20;
4111 Vthis_command = leaf;
4113 /* Don't push an undo boundary if the command set the prefix arg,
4114 or if we are executing a keyboard macro, or if in the
4115 minibuffer. If the command we are about to execute is
4116 self-insert, it's tricky: up to 20 consecutive self-inserts may
4117 be done without an undo boundary. This counter is reset as
4118 soon as a command other than self-insert-command is executed.
4120 Programmers can also use the `self-insert-defer-undo'
4121 property to install that behaviour on functions other
4122 than `self-insert-command', or to change the magic
4123 number 20 to something else. #### DOCUMENT THIS! */
4127 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
4129 magic_undo = 1, magic_undo_count = XINT (prop);
4130 else if (!NILP (prop))
4132 else if (EQ (leaf, Qself_insert_command))
4137 command_builder->self_insert_countdown = 0;
4138 if (NILP (XCONSOLE (console)->prefix_arg)
4139 && NILP (Vexecuting_macro)
4141 /* This was done in the days when there was no undo
4142 in the minibuffer. If we don't disable this code,
4143 then each instance of "undo" undoes everything in
4145 && !EQ (minibuf_window, Fselected_window (Qnil))
4147 && command_builder->self_insert_countdown == 0)
4152 if (--command_builder->self_insert_countdown < 0)
4153 command_builder->self_insert_countdown = magic_undo_count;
4155 execute_command_event
4157 internal_equal (event, command_builder-> most_current_event, 0)
4159 /* Use the translated event that was most recently seen.
4160 This way, last-command-event becomes f1 instead of
4161 the P from ESC O P. But we must copy it, else we'll
4162 lose when the command-builder events are deallocated. */
4163 : Fcopy_event (command_builder-> most_current_event, Qnil));
4167 case misc_user_event:
4171 We could just always use the menu item entry, whatever it is, but
4172 this might break some Lisp code that expects `this-command' to
4173 always contain a symbol. So only store it if this is a simple
4174 `call-interactively' sort of menu item.
4176 But this is bogus. `this-command' could be a string or vector
4177 anyway (for keyboard macros). There's even one instance
4178 (in pending-del.el) of `this-command' getting set to a cons
4179 (a lambda expression). So in the `eval' case I'll just
4180 convert it into a lambda expression.
4182 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4183 && SYMBOLP (XEVENT (event)->event.eval.object))
4184 Vthis_command = XEVENT (event)->event.eval.object;
4185 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4187 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4188 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4189 /* A scrollbar command or the like. */
4190 Vthis_command = XEVENT (event)->event.eval.function;
4193 Vthis_command = Qnil;
4195 /* clear the echo area */
4196 reset_key_echo (command_builder, 1);
4198 command_builder->self_insert_countdown = 0;
4199 if (NILP (XCONSOLE (console)->prefix_arg)
4200 && NILP (Vexecuting_macro)
4201 && !EQ (minibuf_window, Fselected_window (Qnil)))
4203 execute_command_event (command_builder, event);
4208 execute_internal_event (event);
4215 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4216 Read a sequence of keystrokes or mouse clicks.
4217 Returns a vector of the event objects read. The vector and the event
4218 objects it contains are freshly created (and will not be side-effected
4219 by subsequent calls to this function).
4221 The sequence read is sufficient to specify a non-prefix command starting
4222 from the current local and global keymaps. A C-g typed while in this
4223 function is treated like any other character, and `quit-flag' is not set.
4225 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4226 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4227 as a continuation of the previous key.
4229 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4230 convert the last event to lower case. (Normally any upper case event
4231 is converted to lower case if the original event is undefined and the lower
4232 case equivalent is defined.) This argument is provided mostly for
4233 FSF compatibility; the equivalent effect can be achieved more generally
4234 by binding `retry-undefined-key-binding-unshifted' to nil around the
4235 call to `read-key-sequence'.
4237 A C-g typed while in this function is treated like any other character,
4238 and `quit-flag' is not set.
4240 If the user selects a menu item while we are prompting for a key-sequence,
4241 the returned value will be a vector of a single menu-selection event.
4242 An error will be signalled if you pass this value to `lookup-key' or a
4245 `read-key-sequence' checks `function-key-map' for function key
4246 sequences, where they wouldn't conflict with ordinary bindings. See
4247 `function-key-map' for more details.
4249 (prompt, continue_echo, dont_downcase_last))
4251 /* This function can GC */
4252 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4256 struct command_builder *command_builder =
4257 XCOMMAND_BUILDER (con->command_builder);
4259 Lisp_Object event = Fmake_event (Qnil, Qnil);
4260 int speccount = specpdl_depth ();
4261 struct gcpro gcpro1;
4265 CHECK_STRING (prompt);
4266 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4269 if (NILP (continue_echo))
4270 reset_this_command_keys (make_console (con), 1);
4272 specbind (Qinhibit_quit, Qt);
4274 if (!NILP (dont_downcase_last))
4275 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4279 Fnext_event (event, prompt);
4280 /* restore the selected-console damage */
4281 con = event_console_or_selected (event);
4282 command_builder = XCOMMAND_BUILDER (con->command_builder);
4283 if (! command_event_p (event))
4284 execute_internal_event (event);
4287 if (XEVENT (event)->event_type == misc_user_event)
4288 reset_current_events (command_builder);
4289 result = lookup_command_event (command_builder, event, 1);
4290 if (!KEYMAPP (result))
4292 result = current_events_into_vector (command_builder);
4293 reset_key_echo (command_builder, 0);
4300 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4301 Fdeallocate_event (event);
4302 RETURN_UNGCPRO (unbind_to (speccount, result));
4305 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4306 Return a vector of the keyboard or mouse button events that were used
4307 to invoke this command. This copies the vector and the events; it is safe
4308 to keep and modify them.
4316 if (NILP (Vthis_command_keys))
4317 return make_vector (0, Qnil);
4319 len = event_chain_count (Vthis_command_keys);
4321 result = make_vector (len, Qnil);
4323 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4324 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4328 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4329 Used for complicated reasons in `universal-argument-other-key'.
4331 `universal-argument-other-key' rereads the event just typed.
4332 It then gets translated through `function-key-map'.
4333 The translated event gets included in the echo area and in
4334 the value of `this-command-keys' in addition to the raw original event.
4337 Calling this function directs the translated event to replace
4338 the original event, so that only one version of the event actually
4339 appears in the echo area and in the value of `this-command-keys'.
4343 /* #### I don't understand this at all, so currently it does nothing.
4344 If there is ever a problem, maybe someone should investigate. */
4350 dribble_out_event (Lisp_Object event)
4352 if (NILP (Vdribble_file))
4355 if (XEVENT (event)->event_type == key_press_event &&
4356 !XEVENT (event)->event.key.modifiers)
4358 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4359 if (CHARP (XEVENT (event)->event.key.keysym))
4361 Emchar ch = XCHAR (keysym);
4362 Bufbyte str[MAX_EMCHAR_LEN];
4363 Bytecount len = set_charptr_emchar (str, ch);
4364 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4366 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4367 /* one-char key events are printed with just the key name */
4368 Fprinc (keysym, Vdribble_file);
4369 else if (EQ (keysym, Qreturn))
4370 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4371 else if (EQ (keysym, Qspace))
4372 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4374 Fprinc (event, Vdribble_file);
4377 Fprinc (event, Vdribble_file);
4378 Lstream_flush (XLSTREAM (Vdribble_file));
4381 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4382 "FOpen dribble file: ", /*
4383 Start writing all keyboard characters to a dribble file called FILE.
4384 If FILE is nil, close any open dribble file.
4388 /* This function can GC */
4389 /* XEmacs change: always close existing dribble file. */
4390 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4391 if (!NILP (Vdribble_file))
4393 Lstream_close (XLSTREAM (Vdribble_file));
4394 Vdribble_file = Qnil;
4400 file = Fexpand_file_name (file, Qnil);
4401 fd = open ((char*) XSTRING_DATA (file),
4402 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4405 error ("Unable to create dribble file");
4406 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4409 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4410 Fget_coding_system (Qescape_quoted));
4417 /************************************************************************/
4418 /* initialization */
4419 /************************************************************************/
4422 syms_of_event_stream (void)
4424 INIT_LRECORD_IMPLEMENTATION (command_builder);
4425 INIT_LRECORD_IMPLEMENTATION (timeout);
4427 defsymbol (&Qdisabled, "disabled");
4428 defsymbol (&Qcommand_event_p, "command-event-p");
4430 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
4431 "Undefined keystroke sequence", Qerror);
4433 DEFSUBR (Frecent_keys);
4434 DEFSUBR (Frecent_keys_ring_size);
4435 DEFSUBR (Fset_recent_keys_ring_size);
4436 DEFSUBR (Finput_pending_p);
4437 DEFSUBR (Fenqueue_eval_event);
4438 DEFSUBR (Fnext_event);
4439 DEFSUBR (Fnext_command_event);
4440 DEFSUBR (Fdiscard_input);
4442 DEFSUBR (Fsleep_for);
4443 DEFSUBR (Faccept_process_output);
4444 DEFSUBR (Fadd_timeout);
4445 DEFSUBR (Fdisable_timeout);
4446 DEFSUBR (Fadd_async_timeout);
4447 DEFSUBR (Fdisable_async_timeout);
4448 DEFSUBR (Fdispatch_event);
4449 DEFSUBR (Fdispatch_non_command_events);
4450 DEFSUBR (Fread_key_sequence);
4451 DEFSUBR (Fthis_command_keys);
4452 DEFSUBR (Freset_this_command_lengths);
4453 DEFSUBR (Fopen_dribble_file);
4455 defsymbol (&Qpre_command_hook, "pre-command-hook");
4456 defsymbol (&Qpost_command_hook, "post-command-hook");
4457 defsymbol (&Qunread_command_events, "unread-command-events");
4458 defsymbol (&Qunread_command_event, "unread-command-event");
4459 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4460 defsymbol (&Qhandle_pre_motion_command, "handle-pre-motion-command");
4461 defsymbol (&Qhandle_post_motion_command, "handle-post-motion-command");
4462 #if 0 /* FSF Emacs crap */
4463 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4464 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4466 defsymbol (&Qretry_undefined_key_binding_unshifted,
4467 "retry-undefined-key-binding-unshifted");
4468 defsymbol (&Qauto_show_make_point_visible,
4469 "auto-show-make-point-visible");
4471 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
4472 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4476 reinit_vars_of_event_stream (void)
4478 recent_keys_ring_index = 0;
4479 recent_keys_ring_size = 100;
4480 num_input_chars = 0;
4481 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4483 staticpro_nodump (&Vtimeout_free_list);
4484 the_low_level_timeout_blocktype =
4485 Blocktype_new (struct low_level_timeout_blocktype);
4486 something_happened = 0;
4487 recursive_sit_for = Qnil;
4491 vars_of_event_stream (void)
4493 reinit_vars_of_event_stream ();
4494 Vrecent_keys_ring = Qnil;
4495 staticpro (&Vrecent_keys_ring);
4497 Vthis_command_keys = Qnil;
4498 staticpro (&Vthis_command_keys);
4499 Vthis_command_keys_tail = Qnil;
4500 pdump_wire (&Vthis_command_keys_tail);
4502 command_event_queue = Qnil;
4503 staticpro (&command_event_queue);
4504 command_event_queue_tail = Qnil;
4505 pdump_wire (&command_event_queue_tail);
4507 Vlast_selected_frame = Qnil;
4508 staticpro (&Vlast_selected_frame);
4510 pending_timeout_list = Qnil;
4511 staticpro (&pending_timeout_list);
4513 pending_async_timeout_list = Qnil;
4514 staticpro (&pending_async_timeout_list);
4516 last_point_position_buffer = Qnil;
4517 staticpro (&last_point_position_buffer);
4519 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
4520 *Nonzero means echo unfinished commands after this many seconds of pause.
4522 Vecho_keystrokes = make_int (1);
4524 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
4525 *Number of keyboard input characters between auto-saves.
4526 Zero means disable autosaving due to number of characters typed.
4527 See also the variable `auto-save-timeout'.
4529 auto_save_interval = 300;
4531 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
4532 Function or functions to run before every command.
4533 This may examine the `this-command' variable to find out what command
4534 is about to be run, or may change it to cause a different command to run.
4535 Function on this hook must be careful to avoid signalling errors!
4537 Vpre_command_hook = Qnil;
4539 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
4540 Function or functions to run after every command.
4541 This may examine the `this-command' variable to find out what command
4544 Vpost_command_hook = Qnil;
4546 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
4547 Normal hook run when XEmacs it about to be idle.
4548 This occurs whenever it is going to block, waiting for an event.
4549 This generally happens as a result of a call to `next-event',
4550 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4551 `x-get-selection', or various Energize-specific commands.
4552 Errors running the hook are caught and ignored.
4554 Vpre_idle_hook = Qnil;
4556 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
4557 *Variable to control XEmacs behavior with respect to focus changing.
4558 If this variable is set to t, then XEmacs will not gratuitously change
4559 the keyboard focus. XEmacs cannot in general detect when this mode is
4560 used by the window manager, so it is up to the user to set it.
4562 focus_follows_mouse = 0;
4564 #if 0 /* FSF Emacs crap */
4565 /* Ill-conceived because it's not run in all sorts of cases
4566 where XEmacs is blocking. That's what `pre-idle-hook'
4567 is designed to solve. */
4568 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
4569 Normal hook run after each command is executed, if idle.
4570 `post-command-idle-delay' specifies a time in microseconds that XEmacs
4571 must be idle for in order for the functions on this hook to be called.
4572 Errors running the hook are caught and ignored.
4574 Vpost_command_idle_hook = Qnil;
4576 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
4577 Delay time before running `post-command-idle-hook'.
4578 This is measured in microseconds.
4580 post_command_idle_delay = 5000;
4582 /* Random FSFmacs crap. There is absolutely nothing to gain,
4583 and a great deal to lose, in using this in place of just
4584 setting `post-command-hook'. */
4585 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
4586 List of deferred actions to be performed at a later time.
4587 The precise format isn't relevant here; we just check whether it is nil.
4589 Vdeferred_action_list = Qnil;
4591 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
4592 Function to call to handle deferred actions, after each command.
4593 This function is called with no arguments after each command
4594 whenever `deferred-action-list' is non-nil.
4596 Vdeferred_action_function = Qnil;
4597 #endif /* FSF Emacs crap */
4599 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
4600 Last keyboard or mouse button event that was part of a command. This
4601 variable is off limits: you may not set its value or modify the event that
4602 is its value, as it is destructively modified by `read-key-sequence'. If
4603 you want to keep a pointer to this value, you must use `copy-event'.
4605 Vlast_command_event = Qnil;
4607 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
4608 If the value of `last-command-event' is a keyboard event, then
4609 this is the nearest ASCII equivalent to it. This is the value that
4610 `self-insert-command' will put in the buffer. Remember that there is
4611 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4612 of keyboard events is much larger, so writing code that examines this
4613 variable to determine what key has been typed is bad practice, unless
4614 you are certain that it will be one of a small set of characters.
4616 Vlast_command_char = Qnil;
4618 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
4619 Last keyboard or mouse button event received. This variable is off
4620 limits: you may not set its value or modify the event that is its value, as
4621 it is destructively modified by `next-event'. If you want to keep a pointer
4622 to this value, you must use `copy-event'.
4624 Vlast_input_event = Qnil;
4626 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
4627 The mouse-button event which invoked this command, or nil.
4628 This is usually what `(interactive "e")' returns.
4630 Vcurrent_mouse_event = Qnil;
4632 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
4633 If the value of `last-input-event' is a keyboard event, then
4634 this is the nearest ASCII equivalent to it. Remember that there is
4635 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4636 of keyboard events is much larger, so writing code that examines this
4637 variable to determine what key has been typed is bad practice, unless
4638 you are certain that it will be one of a small set of characters.
4640 Vlast_input_char = Qnil;
4642 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
4643 The time (in seconds since Jan 1, 1970) of the last-command-event,
4644 represented as a cons of two 16-bit integers. This is destructively
4645 modified, so copy it if you want to keep it.
4647 Vlast_input_time = Qnil;
4649 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
4650 The time (in seconds since Jan 1, 1970) of the last-command-event,
4651 represented as a list of three integers. The first integer contains
4652 the most significant 16 bits of the number of seconds, and the second
4653 integer contains the least significant 16 bits. The third integer
4654 contains the remainder number of microseconds, if the current system
4655 supports microsecond clock resolution. This list is destructively
4656 modified, so copy it if you want to keep it.
4658 Vlast_command_event_time = Qnil;
4660 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
4661 List of event objects to be read as next command input events.
4662 This can be used to simulate the receipt of events from the user.
4663 Normally this is nil.
4664 Events are removed from the front of this list.
4666 Vunread_command_events = Qnil;
4668 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
4669 Obsolete. Use `unread-command-events' instead.
4671 Vunread_command_event = Qnil;
4673 DEFVAR_LISP ("last-command", &Vlast_command /*
4674 The last command executed. Normally a symbol with a function definition,
4675 but can be whatever was found in the keymap, or whatever the variable
4676 `this-command' was set to by that command.
4678 Vlast_command = Qnil;
4680 DEFVAR_LISP ("this-command", &Vthis_command /*
4681 The command now being executed.
4682 The command can set this variable; whatever is put here
4683 will be in `last-command' during the following command.
4685 Vthis_command = Qnil;
4687 DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /*
4688 Value of `this-command-properties' for the last command.
4689 Used by commands to help synchronize consecutive commands, in preference
4690 to looking at `last-command' directly.
4692 Vlast_command_properties = Qnil;
4694 DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /*
4695 Properties set by the current command.
4696 At the beginning of each command, the current value of this variable is
4697 copied to `last-command-properties', and then it is set to nil. Use `putf'
4698 to add properties to this variable. Commands should use this to communicate
4699 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4700 in preference to looking at and/or setting `this-command'.
4702 Vthis_command_properties = Qnil;
4704 DEFVAR_LISP ("help-char", &Vhelp_char /*
4705 Character to recognize as meaning Help.
4706 When it is read, do `(eval help-form)', and display result if it's a string.
4707 If the value of `help-form' is nil, this char can be read normally.
4708 This can be any form recognized as a single key specifier.
4709 The help-char cannot be a negative number in XEmacs.
4711 Vhelp_char = make_char (8); /* C-h */
4713 DEFVAR_LISP ("help-form", &Vhelp_form /*
4714 Form to execute when character help-char is read.
4715 If the form returns a string, that string is displayed.
4716 If `help-form' is nil, the help char is not recognized.
4720 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
4721 Command to run when `help-char' character follows a prefix key.
4722 This command is used only when there is no actual binding
4723 for that character after that prefix key.
4725 Vprefix_help_command = Qnil;
4727 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
4728 Hash table used as translate table for keyboard input.
4729 Use `keyboard-translate' to portably add entries to this table.
4730 Each key-press event is looked up in this table as follows:
4732 -- If an entry maps a symbol to a symbol, then a key-press event whose
4733 keysym is the former symbol (with any modifiers at all) gets its
4734 keysym changed and its modifiers left alone. This is useful for
4735 dealing with non-standard X keyboards, such as the grievous damage
4736 that Sun has inflicted upon the world.
4737 -- If an entry maps a character to a character, then a key-press event
4738 matching the former character gets converted to a key-press event
4739 matching the latter character. This is useful on ASCII terminals
4740 for (e.g.) making C-\\ look like C-s, to get around flow-control
4742 -- If an entry maps a character to a symbol, then a key-press event
4743 matching the character gets converted to a key-press event whose
4744 keysym is the given symbol and which has no modifiers.
4747 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
4748 &Vretry_undefined_key_binding_unshifted /*
4749 If a key-sequence which ends with a shifted keystroke is undefined
4750 and this variable is non-nil then the command lookup is retried again
4751 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
4752 If lookup still fails, a normal error is signalled. In general,
4753 you should *bind* this, not set it.
4755 Vretry_undefined_key_binding_unshifted = Qt;
4758 DEFVAR_LISP ("composed-character-default-binding",
4759 &Vcomposed_character_default_binding /*
4760 The default keybinding to use for key events from composed input.
4761 Window systems frequently have ways to allow the user to compose
4762 single characters in a language using multiple keystrokes.
4763 XEmacs sees these as single character keypress events.
4765 Vcomposed_character_default_binding = Qself_insert_command;
4766 #endif /* HAVE_XIM */
4768 Vcontrolling_terminal = Qnil;
4769 staticpro (&Vcontrolling_terminal);
4771 Vdribble_file = Qnil;
4772 staticpro (&Vdribble_file);
4775 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
4776 If non-zero, display debug information about Emacs events that XEmacs sees.
4777 Information is displayed on stderr.
4779 Before the event, the source of the event is displayed in parentheses,
4780 and is one of the following:
4782 \(real) A real event from the window system or
4783 terminal driver, as far as XEmacs can tell.
4785 \(keyboard macro) An event generated from a keyboard macro.
4787 \(unread-command-events) An event taken from `unread-command-events'.
4789 \(unread-command-event) An event taken from `unread-command-event'.
4791 \(command event queue) An event taken from an internal queue.
4792 Events end up on this queue when
4793 `enqueue-eval-event' is called or when
4794 user or eval events are received while
4795 XEmacs is blocking (e.g. in `sit-for',
4796 `sleep-for', or `accept-process-output',
4797 or while waiting for the reply to an
4800 \(->keyboard-translate-table) The result of an event translated through
4801 keyboard-translate-table. Note that in
4802 this case, two events are printed even
4803 though only one is really generated.
4805 \(SIGINT) A faked C-g resulting when XEmacs receives
4806 a SIGINT (e.g. C-c was pressed in XEmacs'
4807 controlling terminal or the signal was
4808 explicitly sent to the XEmacs process).
4810 debug_emacs_events = 0;
4813 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
4814 Non-nil inhibits recording of input-events to recent-keys ring.
4816 inhibit_input_event_recording = 0;
4820 complex_vars_of_event_stream (void)
4822 Vkeyboard_translate_table =
4823 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4827 init_event_stream (void)
4831 #ifdef HAVE_UNIXOID_EVENT_LOOP
4832 init_event_unixoid ();
4834 #ifdef HAVE_X_WINDOWS
4835 if (!strcmp (display_use, "x"))
4836 init_event_Xt_late ();
4839 #ifdef HAVE_MS_WINDOWS
4840 if (!strcmp (display_use, "mswindows"))
4841 init_event_mswindows_late ();
4845 /* For TTY's, use the Xt event loop if we can; it allows
4846 us to later open an X connection. */
4847 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
4848 || (defined (HAVE_MSG_SELECT) \
4849 && !defined (DEBUG_TTY_EVENT_STREAM)))
4850 init_event_mswindows_late ();
4851 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
4852 init_event_Xt_late ();
4853 #elif defined (HAVE_TTY)
4854 init_event_tty_late ();
4857 init_interrupts_late ();
4863 useful testcases for v18/v19 compatibility:
4867 (setq unread-command-event (character-to-event ?A (allocate-event)))
4868 (setq x (list (read-char)
4869 ; (read-key-sequence "") ; try it with and without this
4870 last-command-char last-input-char
4871 (recent-keys) (this-command-keys))))
4872 (global-set-key "\^Q" 'foo)
4874 without the read-key-sequence:
4875 ^Q ==> (65 17 65 [... ^Q] [^Q])
4876 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
4877 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
4879 with the read-key-sequence:
4880 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
4881 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
4882 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
4884 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
4886 ;(setq x (list (read-char) quit-flag))^J^G
4887 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
4888 ;for BOTH, x should get set to (7 t), but no result should be printed.
4890 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
4891 ;in *scratch*, type (sit-for 20)^J
4892 ;wait a couple of seconds, move cursor to foo, type "a"
4893 ;a should be inserted in foo. Cursor highlighting should not change in
4896 ;do it with sleep-for. move cursor into foo, then back into *scratch*
4898 ;repeat also with (accept-process-output nil 20)
4900 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
4903 (list (condition-case c
4908 (tst)^Ja^G ==> ((quit) 97) with no signal
4909 (tst)^J^Ga ==> ((quit) 97) with no signal
4910 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
4912 ; with sit-for only do the 2nd test.
4913 ; Do all 3 tests with (accept-process-output nil 20)
4916 (setq enable-recursive-minibuffers t
4917 minibuffer-max-depth nil)
4918 ESC ESC ESC ESC - there are now two minibuffers active
4919 C-g C-g C-g - there should be active 0, not 1
4921 C-x C-f ~ / ? - wait for "Making completion list..." to display
4922 C-g - wait for "Quit" to display
4923 C-g - minibuffer should not be active
4924 however C-g before "Quit" is displayed should leave minibuffer active.
4926 ;do it all in both v18 and v19 and make sure all results are the same.
4927 ;all of these cases matter a lot, but some in quite subtle ways.
4931 Additional test cases for accept-process-output, sleep-for, sit-for.
4932 Be sure you do all of the above checking for C-g and focus, too!
4934 ; Make sure that timer handlers are run during, not after sit-for:
4935 (defun timer-check ()
4936 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
4938 (message "after sit-for"))
4940 ; The first message should appear after 2 seconds, and the final message
4941 ; 3 seconds after that.
4942 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
4946 ; Make sure that process filters are run during, not after sit-for.
4948 (message "sit-for = %s" (sit-for 30)))
4949 (add-hook 'post-command-hook 'fubar)
4951 ; Now type M-x shell RET
4952 ; wait for the shell prompt then send: ls RET
4953 ; the output of ls should fill immediately, and not wait 30 seconds.
4955 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
4959 ; Make sure that recursive invocations return immediately:
4960 (defmacro test-diff-time (start end)
4961 `(+ (* (- (car ,end) (car ,start)) 65536.0)
4962 (- (cadr ,end) (cadr ,start))
4963 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
4965 (defun testee (ignore)
4969 (let ((start (current-time))
4971 (add-timeout 2 'testee nil)
4973 (add-timeout 2 'testee nil)
4975 (add-timeout 2 'testee nil)
4976 (accept-process-output nil 5)
4977 (setq end (current-time))
4978 (test-diff-time start end)))
4980 (test-them) should sit for 15 seconds.
4981 Repeat with testee set to sleep-for and accept-process-output.
4982 These should each delay 36 seconds.