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 int modifier_keys_are_sticky;
126 #if 0 /* FSF Emacs crap */
127 /* Hook run after a command if there's no more input soon. */
128 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
130 /* Delay time in microseconds before running post-command-idle-hook. */
131 int post_command_idle_delay;
133 /* List of deferred actions to be performed at a later time.
134 The precise format isn't relevant here; we just check whether it is nil. */
135 Lisp_Object Vdeferred_action_list;
137 /* Function to call to handle deferred actions, when there are any. */
138 Lisp_Object Vdeferred_action_function;
139 Lisp_Object Qdeferred_action_function;
140 #endif /* FSF Emacs crap */
142 /* Non-nil disable property on a command means
143 do not execute it; call disabled-command-hook's value instead. */
144 Lisp_Object Qdisabled, Vdisabled_command_hook;
146 EXFUN (Fnext_command_event, 2);
148 static void pre_command_hook (void);
149 static void post_command_hook (void);
151 /* Last keyboard or mouse input event read as a command. */
152 Lisp_Object Vlast_command_event;
154 /* The nearest ASCII equivalent of the above. */
155 Lisp_Object Vlast_command_char;
157 /* Last keyboard or mouse event read for any purpose. */
158 Lisp_Object Vlast_input_event;
160 /* The nearest ASCII equivalent of the above. */
161 Lisp_Object Vlast_input_char;
163 Lisp_Object Vcurrent_mouse_event;
165 /* This is fbound in cmdloop.el, see the commentary there */
166 Lisp_Object Qcancel_mode_internal;
168 /* If not Qnil, event objects to be read as the next command input */
169 Lisp_Object Vunread_command_events;
170 Lisp_Object Vunread_command_event; /* obsoleteness support */
172 static Lisp_Object Qunread_command_events, Qunread_command_event;
174 /* Previous command, represented by a Lisp object.
175 Does not include prefix commands and arg setting commands. */
176 Lisp_Object Vlast_command;
178 /* Contents of this-command-properties for the last command. */
179 Lisp_Object Vlast_command_properties;
181 /* If a command sets this, the value goes into
182 last-command for the next command. */
183 Lisp_Object Vthis_command;
185 /* If a command sets this, the value goes into
186 last-command-properties for the next command. */
187 Lisp_Object Vthis_command_properties;
189 /* The value of point when the last command was executed. */
190 Bufpos last_point_position;
192 /* The frame that was current when the last command was started. */
193 Lisp_Object Vlast_selected_frame;
195 /* The buffer that was current when the last command was started. */
196 Lisp_Object last_point_position_buffer;
198 /* A (16bit . 16bit) representation of the time of the last-command-event. */
199 Lisp_Object Vlast_input_time;
201 /* A (16bit 16bit usec) representation of the time
202 of the last-command-event. */
203 Lisp_Object Vlast_command_event_time;
205 /* Character to recognize as the help char. */
206 Lisp_Object Vhelp_char;
208 /* Form to execute when help char is typed. */
209 Lisp_Object Vhelp_form;
211 /* Command to run when the help character follows a prefix key. */
212 Lisp_Object Vprefix_help_command;
214 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
215 may have happened. */
216 volatile int something_happened;
218 /* Hash table to translate keysyms through */
219 Lisp_Object Vkeyboard_translate_table;
221 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
222 Lisp_Object Vretry_undefined_key_binding_unshifted;
223 Lisp_Object Qretry_undefined_key_binding_unshifted;
226 /* If composed input is undefined, use self-insert-char */
227 Lisp_Object Vcomposed_character_default_binding;
228 #endif /* HAVE_XIM */
230 /* Console that corresponds to our controlling terminal */
231 Lisp_Object Vcontrolling_terminal;
233 /* An event (actually an event chain linked through event_next) or Qnil.
235 Lisp_Object Vthis_command_keys;
236 Lisp_Object Vthis_command_keys_tail;
239 Lisp_Object Qauto_show_make_point_visible;
241 /* File in which we write all commands we read; an lstream */
242 static Lisp_Object Vdribble_file;
244 /* Recent keys ring location; a vector of events or nil-s */
245 Lisp_Object Vrecent_keys_ring;
246 int recent_keys_ring_size;
247 int recent_keys_ring_index;
249 /* Boolean specifying whether keystrokes should be added to
251 int inhibit_input_event_recording;
253 Lisp_Object Qself_insert_defer_undo;
255 /* this is in keymap.c */
256 extern Lisp_Object Fmake_keymap (Lisp_Object name);
259 int debug_emacs_events;
262 external_debugging_print_event (char *event_description, Lisp_Object event)
264 write_c_string ("(", Qexternal_debugging_output);
265 write_c_string (event_description, Qexternal_debugging_output);
266 write_c_string (") ", Qexternal_debugging_output);
267 print_internal (event, Qexternal_debugging_output, 1);
268 write_c_string ("\n", Qexternal_debugging_output);
270 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
271 if (debug_emacs_events) \
272 external_debugging_print_event (event_description, event); \
275 #define DEBUG_PRINT_EMACS_EVENT(string, event)
279 /* The callback routines for the window system or terminal driver */
280 struct event_stream *event_stream;
282 static void echo_key_event (struct command_builder *, Lisp_Object event);
283 static void maybe_kbd_translate (Lisp_Object event);
285 /* This structure is basically a typeahead queue: things like
286 wait-reading-process-output will delay the execution of
287 keyboard and mouse events by pushing them here.
289 Chained through event_next()
290 command_event_queue_tail is a pointer to the last-added element.
292 static Lisp_Object command_event_queue;
293 static Lisp_Object command_event_queue_tail;
295 /* Nonzero means echo unfinished commands after this many seconds of pause. */
296 static Lisp_Object Vecho_keystrokes;
298 /* The number of keystrokes since the last auto-save. */
299 static int keystrokes_since_auto_save;
301 /* Used by the C-g signal handler so that it will never "hard quit"
302 when waiting for an event. Otherwise holding down C-g could
303 cause a suspension back to the shell, which is generally
304 undesirable. (#### This doesn't fully work.) */
306 int emacs_is_blocking;
308 /* Handlers which run during sit-for, sleep-for and accept-process-output
309 are not allowed to recursively call these routines. We record here
310 if we are in that situation. */
312 static Lisp_Object recursive_sit_for;
316 /**********************************************************************/
317 /* Command-builder object */
318 /**********************************************************************/
320 #define XCOMMAND_BUILDER(x) \
321 XRECORD (x, command_builder, struct command_builder)
322 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
323 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
324 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
327 mark_command_builder (Lisp_Object obj)
329 struct command_builder *builder = XCOMMAND_BUILDER (obj);
330 mark_object (builder->prefix_events);
331 mark_object (builder->current_events);
332 mark_object (builder->most_current_event);
333 mark_object (builder->last_non_munged_event);
334 mark_object (builder->munge_me[0].first_mungeable_event);
335 mark_object (builder->munge_me[1].first_mungeable_event);
336 return builder->console;
340 finalize_command_builder (void *header, int for_disksave)
344 xfree (((struct command_builder *) header)->echo_buf);
345 ((struct command_builder *) header)->echo_buf = 0;
349 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
350 mark_command_builder, internal_object_printer,
351 finalize_command_builder, 0, 0, 0,
352 struct command_builder);
355 reset_command_builder_event_chain (struct command_builder *builder)
357 builder->prefix_events = Qnil;
358 builder->current_events = Qnil;
359 builder->most_current_event = Qnil;
360 builder->last_non_munged_event = Qnil;
361 builder->munge_me[0].first_mungeable_event = Qnil;
362 builder->munge_me[1].first_mungeable_event = Qnil;
366 allocate_command_builder (Lisp_Object console)
368 Lisp_Object builder_obj;
369 struct command_builder *builder =
370 alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
372 builder->console = console;
373 reset_command_builder_event_chain (builder);
374 builder->echo_buf_length = 300; /* #### Kludge */
375 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
376 builder->echo_buf[0] = 0;
377 builder->echo_buf_index = -1;
378 builder->echo_buf_index = -1;
379 builder->self_insert_countdown = 0;
381 XSETCOMMAND_BUILDER (builder_obj, builder);
386 command_builder_append_event (struct command_builder *builder,
389 assert (EVENTP (event));
391 if (EVENTP (builder->most_current_event))
392 XSET_EVENT_NEXT (builder->most_current_event, event);
394 builder->current_events = event;
396 builder->most_current_event = event;
397 if (NILP (builder->munge_me[0].first_mungeable_event))
398 builder->munge_me[0].first_mungeable_event = event;
399 if (NILP (builder->munge_me[1].first_mungeable_event))
400 builder->munge_me[1].first_mungeable_event = event;
404 /**********************************************************************/
405 /* Low-level interfaces onto event methods */
406 /**********************************************************************/
408 enum event_stream_operation
410 EVENT_STREAM_PROCESS,
411 EVENT_STREAM_TIMEOUT,
412 EVENT_STREAM_CONSOLE,
417 check_event_stream_ok (enum event_stream_operation op)
419 if (!event_stream && noninteractive)
423 case EVENT_STREAM_PROCESS:
424 error ("Can't start subprocesses in -batch mode");
425 case EVENT_STREAM_TIMEOUT:
426 error ("Can't add timeouts in -batch mode");
427 case EVENT_STREAM_CONSOLE:
428 error ("Can't add consoles in -batch mode");
429 case EVENT_STREAM_READ:
430 error ("Can't read events in -batch mode");
435 else if (!event_stream)
437 error ("event-stream callbacks not initialized (internal error?)");
442 event_stream_event_pending_p (int user)
444 return event_stream && event_stream->event_pending_p (user);
448 event_stream_force_event_pending (struct frame* f)
450 if (event_stream->force_event_pending)
451 event_stream->force_event_pending (f);
455 maybe_read_quit_event (Lisp_Event *event)
457 /* A C-g that came from `sigint_happened' will always come from the
458 controlling terminal. If that doesn't exist, however, then the
459 user manually sent us a SIGINT, and we pretend the C-g came from
460 the selected console. */
463 if (CONSOLEP (Vcontrolling_terminal) &&
464 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
465 con = XCONSOLE (Vcontrolling_terminal);
467 con = XCONSOLE (Fselected_console ());
471 int ch = CONSOLE_QUIT_CHAR (con);
474 character_to_event (ch, event, con, 1, 1);
475 event->channel = make_console (con);
482 event_stream_next_event (Lisp_Event *event)
484 Lisp_Object event_obj;
486 check_event_stream_ok (EVENT_STREAM_READ);
488 XSETEVENT (event_obj, event);
490 /* If C-g was pressed, treat it as a character to be read.
491 Note that if C-g was pressed while we were blocking,
492 the SIGINT signal handler will be called. It will
493 set Vquit_flag and write a byte on our "fake pipe",
494 which will unblock us. */
495 if (maybe_read_quit_event (event))
497 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
501 /* If a longjmp() happens in the callback, we're screwed.
502 Let's hope it doesn't. I think the code here is fairly
503 clean and doesn't do this. */
504 emacs_is_blocking = 1;
506 /* Do this if the poll-for-quit timer seems to be taking too
507 much CPU time when idle ... */
508 reset_poll_for_quit ();
510 event_stream->next_event_cb (event);
512 init_poll_for_quit ();
514 emacs_is_blocking = 0;
517 /* timeout events have more info set later, so
518 print the event out in next_event_internal(). */
519 if (event->event_type != timeout_event)
520 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
522 maybe_kbd_translate (event_obj);
526 event_stream_handle_magic_event (Lisp_Event *event)
528 check_event_stream_ok (EVENT_STREAM_READ);
529 event_stream->handle_magic_event_cb (event);
533 event_stream_add_timeout (EMACS_TIME timeout)
535 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
536 return event_stream->add_timeout_cb (timeout);
540 event_stream_remove_timeout (int id)
542 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
543 event_stream->remove_timeout_cb (id);
547 event_stream_select_console (struct console *con)
549 check_event_stream_ok (EVENT_STREAM_CONSOLE);
550 if (!con->input_enabled)
552 event_stream->select_console_cb (con);
553 con->input_enabled = 1;
558 event_stream_unselect_console (struct console *con)
560 check_event_stream_ok (EVENT_STREAM_CONSOLE);
561 if (con->input_enabled)
563 event_stream->unselect_console_cb (con);
564 con->input_enabled = 0;
569 event_stream_select_process (Lisp_Process *proc)
571 check_event_stream_ok (EVENT_STREAM_PROCESS);
572 if (!get_process_selected_p (proc))
574 event_stream->select_process_cb (proc);
575 set_process_selected_p (proc, 1);
580 event_stream_unselect_process (Lisp_Process *proc)
582 check_event_stream_ok (EVENT_STREAM_PROCESS);
583 if (get_process_selected_p (proc))
585 event_stream->unselect_process_cb (proc);
586 set_process_selected_p (proc, 0);
591 event_stream_create_stream_pair (void* inhandle, void* outhandle,
592 Lisp_Object* instream, Lisp_Object* outstream, int flags)
594 check_event_stream_ok (EVENT_STREAM_PROCESS);
595 return event_stream->create_stream_pair_cb
596 (inhandle, outhandle, instream, outstream, flags);
600 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
602 check_event_stream_ok (EVENT_STREAM_PROCESS);
603 return event_stream->delete_stream_pair_cb (instream, outstream);
607 event_stream_quit_p (void)
610 event_stream->quit_p_cb ();
615 /**********************************************************************/
616 /* Character prompting */
617 /**********************************************************************/
620 echo_key_event (struct command_builder *command_builder,
623 /* This function can GC */
625 Bytecount buf_index = command_builder->echo_buf_index;
631 buf_index = 0; /* We're echoing now */
632 clear_echo_area (selected_frame (), Qnil, 0);
635 format_event_object (buf, XEVENT (event), 1);
638 if (len + buf_index + 4 > command_builder->echo_buf_length)
640 e = command_builder->echo_buf + buf_index;
641 memcpy (e, buf, len);
649 command_builder->echo_buf_index = buf_index + len + 1;
653 regenerate_echo_keys_from_this_command_keys (struct command_builder *
658 builder->echo_buf_index = 0;
660 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
661 echo_key_event (builder, event);
665 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
667 /* This function can GC */
668 double echo_keystrokes;
669 struct frame *f = selected_frame ();
670 /* Message turns off echoing unless more keystrokes turn it on again. */
671 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
674 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
675 echo_keystrokes = extract_float (Vecho_keystrokes);
679 if (minibuf_level == 0
680 && echo_keystrokes > 0.0
681 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
682 && !x_kludge_lw_menu_active ()
688 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
689 doesn't work. See check_quit. */
690 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
691 /* input came in, so don't echo. */
695 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
696 /* not echo_buf_index. That doesn't include
697 the terminating " - ". */
698 strlen ((char *) command_builder->echo_buf),
704 reset_key_echo (struct command_builder *command_builder,
705 int remove_echo_area_echo)
707 /* This function can GC */
708 struct frame *f = selected_frame ();
710 command_builder->echo_buf_index = -1;
712 if (remove_echo_area_echo)
713 clear_echo_area (f, Qcommand, 0);
717 /**********************************************************************/
719 /**********************************************************************/
722 maybe_kbd_translate (Lisp_Object event)
725 int did_translate = 0;
727 if (XEVENT_TYPE (event) != key_press_event)
729 if (!HASH_TABLEP (Vkeyboard_translate_table))
731 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
734 c = event_to_character (XEVENT (event), 0, 0, 0);
737 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
739 if (!NILP (traduit) && SYMBOLP (traduit))
741 XEVENT (event)->event.key.keysym = traduit;
742 XEVENT (event)->event.key.modifiers = 0;
745 else if (CHARP (traduit))
749 /* This used to call Fcharacter_to_event() directly into EVENT,
750 but that can eradicate timestamps and other such stuff.
751 This way is safer. */
753 character_to_event (XCHAR (traduit), &ev2,
754 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
755 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
756 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
763 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
764 Vkeyboard_translate_table, Qnil);
765 if (!NILP (traduit) && SYMBOLP (traduit))
767 XEVENT (event)->event.key.keysym = traduit;
774 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
778 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
779 keystrokes_since_auto_save is equivalent to the difference between
780 num_nonmacro_input_chars and last_auto_save. */
782 /* When an auto-save happens, record the "time", and don't do again soon. */
785 record_auto_save (void)
787 keystrokes_since_auto_save = 0;
790 /* Make an auto save happen as soon as possible at command level. */
793 force_auto_save_soon (void)
795 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
798 record_asynch_buffer_change ();
803 maybe_do_auto_save (void)
805 /* This function can call lisp */
806 keystrokes_since_auto_save++;
807 if (auto_save_interval > 0 &&
808 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
809 !detect_input_pending ())
811 Fdo_auto_save (Qnil, Qnil);
817 print_help (Lisp_Object object)
819 Fprinc (object, Qnil);
824 execute_help_form (struct command_builder *command_builder,
827 /* This function can GC */
828 Lisp_Object help = Qnil;
829 int speccount = specpdl_depth ();
830 Bytecount buf_index = command_builder->echo_buf_index;
831 Lisp_Object echo = ((buf_index <= 0)
833 : make_string (command_builder->echo_buf,
835 struct gcpro gcpro1, gcpro2;
838 record_unwind_protect (save_window_excursion_unwind,
839 Fcurrent_window_configuration (Qnil));
840 reset_key_echo (command_builder, 1);
842 help = Feval (Vhelp_form);
844 internal_with_output_to_temp_buffer (build_string ("*Help*"),
845 print_help, help, Qnil);
846 Fnext_command_event (event, Qnil);
847 /* Remove the help from the frame */
848 unbind_to (speccount, Qnil);
849 /* Hmmmm. Tricky. The unbind restores an old window configuration,
850 apparently bypassing any setting of windows_structure_changed.
851 So we need to set it so that things get redrawn properly. */
852 /* #### This is massive overkill. Look at doing it better once the
853 new redisplay is fully in place. */
855 Lisp_Object frmcons, devcons, concons;
856 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
858 struct frame *f = XFRAME (XCAR (frmcons));
859 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
864 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
866 /* Discard next key if it is a space */
867 reset_key_echo (command_builder, 1);
868 Fnext_command_event (event, Qnil);
871 command_builder->echo_buf_index = buf_index;
873 memcpy (command_builder->echo_buf,
874 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
879 /**********************************************************************/
881 /**********************************************************************/
884 detect_input_pending (void)
886 /* Always call the event_pending_p hook even if there's an unread
887 character, because that might do some needed ^G detection (on
888 systems without SIGIO, for example).
890 if (event_stream_event_pending_p (1))
892 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
894 if (!NILP (command_event_queue))
898 EVENT_CHAIN_LOOP (event, command_event_queue)
900 if (XEVENT_TYPE (event) != eval_event
901 && XEVENT_TYPE (event) != magic_eval_event)
908 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
909 Return t if command input is currently available with no waiting.
910 Actually, the value is nil only if we can be sure that no input is available.
914 return detect_input_pending () ? Qt : Qnil;
918 /**********************************************************************/
920 /**********************************************************************/
922 /**** Low-level timeout functions. ****
924 These functions maintain a sorted list of one-shot timeouts (where
925 the timeouts are in absolute time). They are intended for use by
926 functions that need to convert a list of absolute timeouts into a
927 series of intervals to wait for. */
929 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
930 used to indicate an absence of a timer. */
931 static int low_level_timeout_id_tick;
933 static struct low_level_timeout_blocktype
935 Blocktype_declare (struct low_level_timeout);
936 } *the_low_level_timeout_blocktype;
938 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
939 a unique ID identifying the timeout. */
942 add_low_level_timeout (struct low_level_timeout **timeout_list,
945 struct low_level_timeout *tm;
946 struct low_level_timeout *t, **tt;
948 /* Allocate a new time struct. */
950 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
952 if (low_level_timeout_id_tick == 0)
953 low_level_timeout_id_tick++;
954 tm->id = low_level_timeout_id_tick++;
957 /* Add it to the queue. */
961 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
972 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
973 If the timeout is not there, do nothing. */
976 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
978 struct low_level_timeout *t, *prev;
982 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
986 return; /* couldn't find it */
989 *timeout_list = t->next;
990 else prev->next = t->next;
992 Blocktype_free (the_low_level_timeout_blocktype, t);
995 /* If there are timeouts on TIMEOUT_LIST, store the relative time
996 interval to the first timeout on the list into INTERVAL and
997 return 1. Otherwise, return 0. */
1000 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
1001 EMACS_TIME *interval)
1003 if (!timeout_list) /* no timer events; block indefinitely */
1007 EMACS_TIME current_time;
1009 /* The time to block is the difference between the first
1010 (earliest) timer on the queue and the current time.
1011 If that is negative, then the timer will fire immediately
1012 but we still have to call select(), with a zero-valued
1013 timeout: user events must have precedence over timer events. */
1014 EMACS_GET_TIME (current_time);
1015 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1016 EMACS_SUB_TIME (*interval, timeout_list->time,
1019 EMACS_SET_SECS_USECS (*interval, 0, 0);
1024 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1025 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1026 timeout into TIME_OUT. */
1029 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1030 EMACS_TIME *time_out)
1032 struct low_level_timeout *tm = *timeout_list;
1038 *time_out = tm->time;
1039 *timeout_list = tm->next;
1040 Blocktype_free (the_low_level_timeout_blocktype, tm);
1045 /**** High-level timeout functions. ****/
1047 static int timeout_id_tick;
1049 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1051 static Lisp_Object Vtimeout_free_list;
1054 mark_timeout (Lisp_Object obj)
1056 Lisp_Timeout *tm = XTIMEOUT (obj);
1057 mark_object (tm->function);
1061 /* Should never, ever be called. (except by an external debugger) */
1063 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1065 const Lisp_Timeout *t = XTIMEOUT (obj);
1068 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
1070 write_c_string (buf, printcharfun);
1073 static const struct lrecord_description timeout_description[] = {
1074 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1075 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1079 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
1080 mark_timeout, print_timeout,
1081 0, 0, 0, timeout_description, Lisp_Timeout);
1083 /* Generate a timeout and return its ID. */
1086 event_stream_generate_wakeup (unsigned int milliseconds,
1087 unsigned int vanilliseconds,
1088 Lisp_Object function, Lisp_Object object,
1091 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
1092 Lisp_Timeout *timeout = XTIMEOUT (op);
1093 EMACS_TIME current_time;
1094 EMACS_TIME interval;
1096 timeout->id = timeout_id_tick++;
1097 timeout->resignal_msecs = vanilliseconds;
1098 timeout->function = function;
1099 timeout->object = object;
1101 EMACS_GET_TIME (current_time);
1102 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1103 1000 * (milliseconds % 1000));
1104 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1108 timeout->interval_id =
1109 event_stream_add_async_timeout (timeout->next_signal_time);
1110 pending_async_timeout_list = noseeum_cons (op,
1111 pending_async_timeout_list);
1115 timeout->interval_id =
1116 event_stream_add_timeout (timeout->next_signal_time);
1117 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
1122 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1123 as necessary and return the timeout's ID and function and object slots.
1125 This should be called as a result of receiving notice that a timeout
1126 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1127 identifies this particular firing of the timeout. INTERVAL-ID's and
1128 timeout ID's are in separate number spaces and bear no relation to
1129 each other. The INTERVAL-ID is all that the event callback routines
1130 work with: they work only with one-shot intervals, not with timeouts
1131 that may fire repeatedly.
1133 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1137 event_stream_resignal_wakeup (int interval_id, int async_p,
1138 Lisp_Object *function, Lisp_Object *object)
1140 Lisp_Object op = Qnil, rest;
1141 Lisp_Timeout *timeout;
1142 Lisp_Object *timeout_list;
1143 struct gcpro gcpro1;
1146 GCPRO1 (op); /* just in case ... because it's removed from the list
1149 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1151 /* Find the timeout on the list of pending ones. */
1152 LIST_LOOP (rest, *timeout_list)
1154 timeout = XTIMEOUT (XCAR (rest));
1155 if (timeout->interval_id == interval_id)
1159 assert (!NILP (rest));
1161 timeout = XTIMEOUT (op);
1162 /* We make sure to snarf the data out of the timeout object before
1163 we free it with free_managed_lcrecord(). */
1165 *function = timeout->function;
1166 *object = timeout->object;
1168 /* Remove this one from the list of pending timeouts */
1169 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1171 /* If this timeout wants to be resignalled, do it now. */
1172 if (timeout->resignal_msecs)
1174 EMACS_TIME current_time;
1175 EMACS_TIME interval;
1177 /* Determine the time that the next resignalling should occur.
1178 We do that by adding the interval time to the last signalled
1179 time until we get a time that's current.
1181 (This way, it doesn't matter if the timeout was signalled
1182 exactly when we asked for it, or at some time later.)
1184 EMACS_GET_TIME (current_time);
1185 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
1186 1000 * (timeout->resignal_msecs % 1000));
1189 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1191 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1194 timeout->interval_id =
1195 event_stream_add_async_timeout (timeout->next_signal_time);
1197 timeout->interval_id =
1198 event_stream_add_timeout (timeout->next_signal_time);
1199 /* Add back onto the list. Note that the effect of this
1200 is to move frequently-hit timeouts to the front of the
1201 list, which is a good thing. */
1202 *timeout_list = noseeum_cons (op, *timeout_list);
1205 free_managed_lcrecord (Vtimeout_free_list, op);
1212 event_stream_disable_wakeup (int id, int async_p)
1214 Lisp_Timeout *timeout = 0;
1216 Lisp_Object *timeout_list;
1219 timeout_list = &pending_async_timeout_list;
1221 timeout_list = &pending_timeout_list;
1223 /* Find the timeout on the list of pending ones, if it's still there. */
1224 LIST_LOOP (rest, *timeout_list)
1226 timeout = XTIMEOUT (XCAR (rest));
1227 if (timeout->id == id)
1231 /* If we found it, remove it from the list and disable the pending
1235 Lisp_Object op = XCAR (rest);
1237 delq_no_quit_and_free_cons (op, *timeout_list);
1239 event_stream_remove_async_timeout (timeout->interval_id);
1241 event_stream_remove_timeout (timeout->interval_id);
1242 free_managed_lcrecord (Vtimeout_free_list, op);
1247 event_stream_wakeup_pending_p (int id, int async_p)
1249 Lisp_Timeout *timeout;
1251 Lisp_Object timeout_list;
1256 timeout_list = pending_async_timeout_list;
1258 timeout_list = pending_timeout_list;
1260 /* Find the element on the list of pending ones, if it's still there. */
1261 LIST_LOOP (rest, timeout_list)
1263 timeout = XTIMEOUT (XCAR (rest));
1264 if (timeout->id == id)
1275 /**** Asynch. timeout functions (see also signal.c) ****/
1277 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1278 extern int poll_for_quit_id;
1281 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1282 extern int poll_for_sigchld_id;
1286 event_stream_deal_with_async_timeout (int interval_id)
1288 /* This function can GC */
1289 Lisp_Object humpty, dumpty;
1290 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1291 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1294 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1296 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1297 if (id == poll_for_quit_id)
1299 quit_check_signal_happened = 1;
1300 quit_check_signal_tick_count++;
1305 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1306 if (id == poll_for_sigchld_id)
1308 kick_status_notify ();
1313 /* call1 GC-protects its arguments */
1314 call1_trapping_errors ("Error in asynchronous timeout callback",
1319 /**** Lisp-level timeout functions. ****/
1321 static unsigned long
1322 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1324 #ifdef LISP_FLOAT_TYPE
1326 CHECK_INT_OR_FLOAT (secs);
1327 fsecs = XFLOATINT (secs);
1331 fsecs = XINT (secs);
1334 signal_simple_error ("timeout is negative", secs);
1335 if (!allow_0 && fsecs == 0)
1336 signal_simple_error ("timeout is non-positive", secs);
1337 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1339 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1341 return (unsigned long) (1000 * fsecs);
1344 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1345 Add a timeout, to be signaled after the timeout period has elapsed.
1346 SECS is a number of seconds, expressed as an integer or a float.
1347 FUNCTION will be called after that many seconds have elapsed, with one
1348 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1349 then after this timeout expires, `add-timeout' will automatically be called
1350 again with RESIGNAL as the first argument.
1352 This function returns an object which is the id number of this particular
1353 timeout. You can pass that object to `disable-timeout' to turn off the
1354 timeout before it has been signalled.
1356 NOTE: Id numbers as returned by this function are in a distinct namespace
1357 from those returned by `add-async-timeout'. This means that the same id
1358 number could refer to a pending synchronous timeout and a different pending
1359 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1360 to `disable-async-timeout', or vice-versa.
1362 The number of seconds may be expressed as a floating-point number, in which
1363 case some fractional part of a second will be used. Caveat: the usable
1364 timeout granularity will vary from system to system.
1366 Adding a timeout causes a timeout event to be returned by `next-event', and
1367 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1368 loop, the function will not be invoked until the next call to sit-for or
1369 until the return to top-level (the same is true of process filters).
1371 If you need to have a timeout executed even when XEmacs is in the midst of
1372 running Lisp code, use `add-async-timeout'.
1374 WARNING: if you are thinking of calling add-timeout from inside of a
1375 callback function as a way of resignalling a timeout, think again. There
1376 is a race condition. That's why the RESIGNAL argument exists.
1378 (secs, function, object, resignal))
1380 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1381 unsigned long msecs2 = (NILP (resignal) ? 0 :
1382 lisp_number_to_milliseconds (resignal, 0));
1385 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1386 lid = make_int (id);
1387 if (id != XINT (lid)) abort ();
1391 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1392 Disable a timeout from signalling any more.
1393 ID should be a timeout id number as returned by `add-timeout'. If ID
1394 corresponds to a one-shot timeout that has already signalled, nothing
1397 It will not work to call this function on an id number returned by
1398 `add-async-timeout'. Use `disable-async-timeout' for that.
1403 event_stream_disable_wakeup (XINT (id), 0);
1407 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1408 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1409 SECS is a number of seconds, expressed as an integer or a float.
1410 FUNCTION will be called after that many seconds have elapsed, with one
1411 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1412 then after this timeout expires, `add-async-timeout' will automatically be
1413 called again with RESIGNAL as the first argument.
1415 This function returns an object which is the id number of this particular
1416 timeout. You can pass that object to `disable-async-timeout' to turn off
1417 the timeout before it has been signalled.
1419 NOTE: Id numbers as returned by this function are in a distinct namespace
1420 from those returned by `add-timeout'. This means that the same id number
1421 could refer to a pending synchronous timeout and a different pending
1422 asynchronous timeout, and that you cannot pass an id from
1423 `add-async-timeout' to `disable-timeout', or vice-versa.
1425 The number of seconds may be expressed as a floating-point number, in which
1426 case some fractional part of a second will be used. Caveat: the usable
1427 timeout granularity will vary from system to system.
1429 Adding an asynchronous timeout causes the function to be invoked as soon
1430 as the timeout occurs, even if XEmacs is in the midst of executing some
1431 other code. (This is unlike the synchronous timeouts added with
1432 `add-timeout', where the timeout will only be signalled when XEmacs is
1433 waiting for events, i.e. the next return to top-level or invocation of
1434 `sit-for' or related functions.) This means that the function that is
1435 called *must* not signal an error or change any global state (e.g. switch
1436 buffers or windows) except when locking code is in place to make sure
1437 that race conditions don't occur in the interaction between the
1438 asynchronous timeout function and other code.
1440 Under most circumstances, you should use `add-timeout' instead, as it is
1441 much safer. Asynchronous timeouts should only be used when such behavior
1442 is really necessary.
1444 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1445 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1446 asynchronous timeouts will get called immediately. (Multiple occurrences
1447 of the same asynchronous timeout are not queued, however.) While the
1448 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1449 is automatically bound to non-nil, and thus other asynchronous timeouts
1450 will be blocked unless the callback function explicitly sets `inhibit-quit'
1453 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1454 callback function as a way of resignalling a timeout, think again. There
1455 is a race condition. That's why the RESIGNAL argument exists.
1457 (secs, function, object, resignal))
1459 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1460 unsigned long msecs2 = (NILP (resignal) ? 0 :
1461 lisp_number_to_milliseconds (resignal, 0));
1464 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1465 lid = make_int (id);
1466 if (id != XINT (lid)) abort ();
1470 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1471 Disable an asynchronous timeout from signalling any more.
1472 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1473 corresponds to a one-shot timeout that has already signalled, nothing
1476 It will not work to call this function on an id number returned by
1477 `add-timeout'. Use `disable-timeout' for that.
1482 event_stream_disable_wakeup (XINT (id), 1);
1487 /**********************************************************************/
1488 /* enqueuing and dequeuing events */
1489 /**********************************************************************/
1491 /* Add an event to the back of the command-event queue: it will be the next
1492 event read after all pending events. This only works on keyboard,
1493 mouse-click, misc-user, and eval events.
1496 enqueue_command_event (Lisp_Object event)
1498 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1502 dequeue_command_event (void)
1504 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1507 /* put the event on the typeahead queue, unless
1508 the event is the quit char, in which case the `QUIT'
1509 which will occur on the next trip through this loop is
1510 all the processing we should do - leaving it on the queue
1511 would cause the quit to be processed twice.
1514 enqueue_command_event_1 (Lisp_Object event_to_copy)
1516 /* do not call check_quit() here. Vquit_flag was set in
1517 next_event_internal. */
1518 if (NILP (Vquit_flag))
1519 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1523 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1525 Lisp_Object event = Fmake_event (Qnil, Qnil);
1527 XEVENT (event)->event_type = magic_eval_event;
1528 /* channel for magic_eval events is nil */
1529 XEVENT (event)->event.magic_eval.internal_function = fun;
1530 XEVENT (event)->event.magic_eval.object = object;
1531 enqueue_command_event (event);
1534 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1535 Add an eval event to the back of the eval event queue.
1536 When this event is dispatched, FUNCTION (which should be a function
1537 of one argument) will be called with OBJECT as its argument.
1538 See `next-event' for a description of event types and how events
1543 Lisp_Object event = Fmake_event (Qnil, Qnil);
1545 XEVENT (event)->event_type = eval_event;
1546 /* channel for eval events is nil */
1547 XEVENT (event)->event.eval.function = function;
1548 XEVENT (event)->event.eval.object = object;
1549 enqueue_command_event (event);
1555 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1558 Lisp_Object event = Fmake_event (Qnil, Qnil);
1560 XEVENT (event)->event_type = misc_user_event;
1561 XEVENT (event)->channel = channel;
1562 XEVENT (event)->event.misc.function = function;
1563 XEVENT (event)->event.misc.object = object;
1564 XEVENT (event)->event.misc.button = 0;
1565 XEVENT (event)->event.misc.modifiers = 0;
1566 XEVENT (event)->event.misc.x = -1;
1567 XEVENT (event)->event.misc.y = -1;
1568 enqueue_command_event (event);
1574 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1576 int button, int modifiers, int x, int y)
1578 Lisp_Object event = Fmake_event (Qnil, Qnil);
1580 XEVENT (event)->event_type = misc_user_event;
1581 XEVENT (event)->channel = channel;
1582 XEVENT (event)->event.misc.function = function;
1583 XEVENT (event)->event.misc.object = object;
1584 XEVENT (event)->event.misc.button = button;
1585 XEVENT (event)->event.misc.modifiers = modifiers;
1586 XEVENT (event)->event.misc.x = x;
1587 XEVENT (event)->event.misc.y = y;
1588 enqueue_command_event (event);
1594 /**********************************************************************/
1595 /* focus-event handling */
1596 /**********************************************************************/
1600 Ben's capsule lecture on focus:
1602 In FSFmacs `select-frame' never changes the window-manager frame
1603 focus. All it does is change the "selected frame". This is similar
1604 to what happens when we call `select-device' or `select-console'.
1605 Whenever an event comes in (including a keyboard event), its frame is
1606 selected; therefore, evaluating `select-frame' in *scratch* won't
1607 cause any effects because the next received event (in the same frame)
1608 will cause a switch back to the frame displaying *scratch*.
1610 Whenever a focus-change event is received from the window manager, it
1611 generates a `switch-frame' event, which causes the Lisp function
1612 `handle-switch-frame' to get run. This basically just runs
1613 `select-frame' (see below, however).
1615 In FSFmacs, if you want to have an operation run when a frame is
1616 selected, you supply an event binding for `switch-frame' (and then
1617 maybe call `handle-switch-frame', or something ...).
1619 In XEmacs, we *do* change the window-manager frame focus as a result
1620 of `select-frame', but not until the next time an event is received,
1621 so that a function that momentarily changes the selected frame won't
1622 cause WM focus flashing. (#### There's something not quite right here;
1623 this is causing the wrong-cursor-focus problems that you occasionally
1624 see. But the general idea is correct.) This approach is winning for
1625 people who use the explicit-focus model, but is trickier to implement.
1627 We also don't make the `switch-frame' event visible but instead have
1628 `select-frame-hook', which is a better approach.
1630 There is the problem of surrogate minibuffers, where when we enter the
1631 minibuffer, you essentially want to temporarily switch the WM focus to
1632 the frame with the minibuffer, and switch it back when you exit the
1635 FSFmacs solves this with the crockish `redirect-frame-focus', which
1636 says "for keyboard events received from FRAME, act like they're
1637 coming from FOCUS-FRAME". I think what this means is that, when
1638 a keyboard event comes in and the event manager is about to select the
1639 event's frame, if that frame has its focus redirected, the redirected-to
1640 frame is selected instead. That way, if you're in a minibufferless
1641 frame and enter the minibuffer, then all Lisp functions that run see
1642 the selected frame as the minibuffer's frame rather than the minibufferless
1643 frame you came from, so that (e.g.) your typing actually appears in
1644 the minibuffer's frame and things behave sanely.
1646 There's also some weird logic that switches the redirected frame focus
1647 from one frame to another if Lisp code explicitly calls `select-frame'
1648 \(but not if `handle-switch-frame' is called), and saves and restores
1649 the frame focus in window configurations, etc. etc. All of this logic
1650 is heavily #if 0'd, with lots of comments saying "No, this approach
1651 doesn't seem to work, so I'm trying this ... is it reasonable?
1652 Well, I'm not sure ..." that are a red flag indicating crockishness.
1654 Because of our way of doing things, we can avoid all this crock.
1655 Keyboard events never cause a select-frame (who cares what frame
1656 they're associated with? They come from a console, only). We change
1657 the actual WM focus to a surrogate minibuffer frame, so we don't have
1658 to do any internal redirection. In order to get the focus back,
1659 I took the approach in minibuf.el of just checking to see if the
1660 frame we moved to is still the selected frame, and move back to the
1661 old one if so. Conceivably we might have to do the weird "tracking"
1662 that FSFmacs does when `select-frame' is called, but I don't think
1663 so. If the selected frame moved from the minibuffer frame, then
1664 we just leave it there, figuring that someone knows what they're
1665 doing. Because we don't have any redirection recorded anywhere,
1666 it's safe to do this, and we don't end up with unwanted redirection.
1671 run_select_frame_hook (void)
1673 run_hook (Qselect_frame_hook);
1677 run_deselect_frame_hook (void)
1679 #if 0 /* unclean! FSF calls this at all sorts of random places,
1680 including a bunch of places in their mouse.el. If this
1681 is implemented, it has to be done cleanly. */
1682 run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also
1683 called in `call-interactively'.
1684 Does this mean it will be
1685 called twice? Oh well, FSF
1686 bug -- FSF calls it in
1687 `handle-switch-frame',
1688 which is approximately the
1689 same as the caller of this
1692 run_hook (Qdeselect_frame_hook);
1695 /* When select-frame is called and focus_follows_mouse is false, we want
1696 to tell the window system that the focus should be changed to point to
1697 the new frame. However,
1698 sometimes Lisp functions will temporarily change the selected frame
1699 (e.g. to call a function that operates on the selected frame),
1700 and it's annoying if this focus-change happens exactly when
1701 select-frame is called, because then you get some flickering of the
1702 window-manager border and perhaps other undesirable results. We
1703 really only want to change the focus when we're about to retrieve
1704 an event from the user. To do this, we keep track of the frame
1705 where the window-manager focus lies on, and just before waiting
1706 for user events, check the currently selected frame and change
1707 the focus as necessary.
1709 On the other hand, if focus_follows_mouse is true, we need to switch the
1710 selected frame back to the frame with window manager focus just before we
1711 execute the next command in Fcommand_loop_1, just as the selected buffer is
1712 reverted after a set-buffer.
1714 Both cases are handled by this function. It must be called as appropriate
1715 from these two places, depending on the value of focus_follows_mouse. */
1718 investigate_frame_change (void)
1720 Lisp_Object devcons, concons;
1722 /* if the selected frame was changed, change the window-system
1723 focus to the new frame. We don't do it when select-frame was
1724 called, to avoid flickering and other unwanted side effects when
1725 the frame is just changed temporarily. */
1726 DEVICE_LOOP_NO_BREAK (devcons, concons)
1728 struct device *d = XDEVICE (XCAR (devcons));
1729 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1731 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1732 but that can cause us to end up in an infinite loop focusing
1733 between two frames. It seems that since the call to `select-frame'
1734 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1735 value, we need to do so too. */
1736 if (!NILP (sel_frame) &&
1737 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1738 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1739 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1741 /* At this point, we know that the frame has been changed. Now, if
1742 * focus_follows_mouse is not set, we finish off the frame change,
1743 * so that user events will now come from the new frame. Otherwise,
1744 * if focus_follows_mouse is set, no gratuitous frame changing
1745 * should take place. Set the focus back to the frame which was
1746 * originally selected for user input.
1748 if (!focus_follows_mouse)
1750 /* prevent us from issuing the same request more than once */
1751 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1752 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1756 Lisp_Object old_frame = Qnil;
1758 /* #### Do we really want to check OUGHT ??
1759 * It seems to make sense, though I have never seen us
1760 * get here and have it be non-nil.
1762 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1763 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1764 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1765 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1767 /* #### Can old_frame ever be NIL? play it safe.. */
1768 if (!NILP (old_frame))
1770 /* Fselect_frame is not really the right thing: it frobs the
1771 * buffer stack. But there's no easy way to do the right
1772 * thing, and this code already had this problem anyway.
1774 Fselect_frame (old_frame);
1782 cleanup_after_missed_defocusing (Lisp_Object frame)
1784 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1785 Fselect_frame (frame);
1790 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1792 Lisp_Object frame = Fcar (frame_inp_and_dev);
1793 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1794 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1797 if (!DEVICE_LIVE_P (XDEVICE (device)))
1800 d = XDEVICE (device);
1802 /* Any received focus-change notifications render invalid any
1803 pending focus-change requests. */
1804 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1807 Lisp_Object focus_frame;
1809 if (!FRAME_LIVE_P (XFRAME (frame)))
1812 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1814 /* Mark the minibuffer as changed to make sure it gets updated
1815 properly if the echo area is active. */
1817 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1818 MARK_WINDOWS_CHANGED (w);
1821 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1823 /* Oops, we missed a focus-out event. */
1824 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1825 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1827 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1828 if (!EQ (frame, focus_frame))
1830 redisplay_redraw_cursor (XFRAME (frame), 1);
1835 /* We ignore the frame reported in the event. If it's different
1836 from where we think the focus was, oh well -- we messed up.
1837 Nonetheless, we pretend we were right, for sensible behavior. */
1838 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1841 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1843 if (FRAME_LIVE_P (XFRAME (frame)))
1844 redisplay_redraw_cursor (XFRAME (frame), 1);
1849 /* Called from the window-system-specific code when we receive a
1850 notification that the focus lies on a particular frame.
1851 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1855 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1857 Lisp_Object frame = Fcar (frame_inp_and_dev);
1858 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1859 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1863 if (!DEVICE_LIVE_P (XDEVICE (device)))
1866 d = XDEVICE (device);
1870 Lisp_Object focus_frame;
1872 if (!FRAME_LIVE_P (XFRAME (frame)))
1875 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1877 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1878 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1880 /* Oops, we missed a focus-out event. */
1881 Fselect_frame (focus_frame);
1882 /* Do an unwind-protect in case an error occurs in
1883 the deselect-frame-hook */
1884 count = specpdl_depth ();
1885 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1886 run_deselect_frame_hook ();
1887 unbind_to (count, Qnil);
1888 /* the cleanup method changed the focus frame to nil, so
1889 we need to reflect this */
1893 Fselect_frame (frame);
1894 if (!EQ (frame, focus_frame))
1895 run_select_frame_hook ();
1899 /* We ignore the frame reported in the event. If it's different
1900 from where we think the focus was, oh well -- we messed up.
1901 Nonetheless, we pretend we were right, for sensible behavior. */
1902 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1905 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1906 run_deselect_frame_hook ();
1912 /**********************************************************************/
1913 /* retrieving the next event */
1914 /**********************************************************************/
1916 static int in_single_console;
1918 /* #### These functions don't currently do anything. */
1920 single_console_state (void)
1922 in_single_console = 1;
1926 any_console_state (void)
1928 in_single_console = 0;
1932 in_single_console_state (void)
1934 return in_single_console;
1937 /* the number of keyboard characters read. callint.c wants this. */
1938 Charcount num_input_chars;
1941 next_event_internal (Lisp_Object target_event, int allow_queued)
1943 struct gcpro gcpro1;
1944 /* QUIT; This is incorrect - the caller must do this because some
1945 callers (ie, Fnext_event()) do not want to QUIT. */
1947 assert (NILP (XEVENT_NEXT (target_event)));
1949 GCPRO1 (target_event);
1951 /* When focus_follows_mouse is nil, if a frame change took place, we need
1952 * to actually switch window manager focus to the selected window now.
1954 if (!focus_follows_mouse)
1955 investigate_frame_change ();
1957 if (allow_queued && !NILP (command_event_queue))
1959 Lisp_Object event = dequeue_command_event ();
1960 Fcopy_event (event, target_event);
1961 Fdeallocate_event (event);
1962 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
1966 Lisp_Event *e = XEVENT (target_event);
1968 /* The command_event_queue was empty. Wait for an event. */
1969 event_stream_next_event (e);
1970 /* If this was a timeout, then we need to extract some data
1971 out of the returned closure and might need to resignal
1973 if (e->event_type == timeout_event)
1975 Lisp_Object tristan, isolde;
1977 e->event.timeout.id_number =
1978 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
1981 e->event.timeout.function = tristan;
1982 e->event.timeout.object = isolde;
1983 /* next_event_internal() doesn't print out timeout events
1984 because of the extra info we just set. */
1985 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
1988 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1989 The callers of next_event_internal() will do one of two things:
1991 -- set Vquit_flag to Qnil. (next-event does this.) This will
1992 cause the ^G to be treated as a normal keystroke.
1993 -- not change Vquit_flag but attempt to enqueue the ^G, at
1994 which point it will be discarded. The next time QUIT is
1995 called, it will notice that Vquit_flag was set.
1998 if (e->event_type == key_press_event &&
1999 event_matches_key_specifier_p
2000 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2010 run_pre_idle_hook (void)
2012 if (!NILP (Vpre_idle_hook)
2013 && !detect_input_pending ())
2014 safe_run_hook_trapping_errors
2015 ("Error in `pre-idle-hook' (setting hook to nil)",
2019 static void push_this_command_keys (Lisp_Object event);
2020 static void push_recent_keys (Lisp_Object event);
2021 static void dribble_out_event (Lisp_Object event);
2022 static void execute_internal_event (Lisp_Object event);
2024 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2025 Return the next available event.
2026 Pass this object to `dispatch-event' to handle it.
2027 In most cases, you will want to use `next-command-event', which returns
2028 the next available "user" event (i.e. keypress, button-press,
2029 button-release, or menu selection) instead of this function.
2031 If EVENT is non-nil, it should be an event object and will be filled in
2032 and returned; otherwise a new event object will be created and returned.
2033 If PROMPT is non-nil, it should be a string and will be displayed in the
2034 echo area while this function is waiting for an event.
2036 The next available event will be
2038 -- any events in `unread-command-events' or `unread-command-event'; else
2039 -- the next event in the currently executing keyboard macro, if any; else
2040 -- an event queued by `enqueue-eval-event', if any; else
2041 -- the next available event from the window system or terminal driver.
2043 In the last case, this function will block until an event is available.
2045 The returned event will be one of the following types:
2047 -- a key-press event.
2048 -- a button-press or button-release event.
2049 -- a misc-user-event, meaning the user selected an item on a menu or used
2051 -- a process event, meaning that output from a subprocess is available.
2052 -- a timeout event, meaning that a timeout has elapsed.
2053 -- an eval event, which simply causes a function to be executed when the
2054 event is dispatched. Eval events are generated by `enqueue-eval-event'
2055 or by certain other conditions happening.
2056 -- a magic event, indicating that some window-system-specific event
2057 happened (such as a focus-change notification) that must be handled
2058 synchronously with other events. `dispatch-event' knows what to do with
2063 /* This function can call lisp */
2064 /* #### We start out using the selected console before an event
2065 is received, for echoing the partially completed command.
2066 This is most definitely wrong -- there needs to be a separate
2067 echo area for each console! */
2068 struct console *con = XCONSOLE (Vselected_console);
2069 struct command_builder *command_builder =
2070 XCOMMAND_BUILDER (con->command_builder);
2071 int store_this_key = 0;
2072 struct gcpro gcpro1;
2075 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2076 We want to read the ^G as an event. */
2078 #ifdef LWLIB_MENUBARS_LUCID
2080 * #### Fix the menu code so this isn't necessary.
2082 * We cannot allow the lwmenu code to be reentered, because the
2083 * code is not written to be reentrant and will crash. Therefore
2084 * paths from the menu callbacks back into the menu code have to
2085 * be blocked. Fnext_event is the normal path into the menu code,
2086 * so we signal an error here.
2088 if (in_menu_callback)
2089 error ("Attempt to call next-event inside menu callback");
2090 #endif /* LWLIB_MENUBARS_LUCID */
2093 event = Fmake_event (Qnil, Qnil);
2095 CHECK_LIVE_EVENT (event);
2100 CHECK_STRING (prompt);
2102 len = XSTRING_LENGTH (prompt);
2103 if (command_builder->echo_buf_length < len)
2104 len = command_builder->echo_buf_length - 1;
2105 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2106 command_builder->echo_buf[len] = 0;
2107 command_builder->echo_buf_index = len;
2108 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2109 command_builder->echo_buf,
2111 command_builder->echo_buf_index,
2115 start_over_and_avoid_hosage:
2117 /* If there is something in unread-command-events, simply return it.
2118 But do some error checking to make sure the user hasn't put something
2119 in the unread-command-events that they shouldn't have.
2120 This does not update this-command-keys and recent-keys.
2122 if (!NILP (Vunread_command_events))
2124 if (!CONSP (Vunread_command_events))
2126 Vunread_command_events = Qnil;
2127 signal_error (Qwrong_type_argument,
2128 list3 (Qconsp, Vunread_command_events,
2129 Qunread_command_events));
2133 Lisp_Object e = XCAR (Vunread_command_events);
2134 Vunread_command_events = XCDR (Vunread_command_events);
2135 if (!EVENTP (e) || !command_event_p (e))
2136 signal_error (Qwrong_type_argument,
2137 list3 (Qcommand_event_p, e, Qunread_command_events));
2140 Fcopy_event (e, event);
2141 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2145 /* Do similar for unread-command-event (obsoleteness support). */
2146 else if (!NILP (Vunread_command_event))
2148 Lisp_Object e = Vunread_command_event;
2149 Vunread_command_event = Qnil;
2151 if (!EVENTP (e) || !command_event_p (e))
2153 signal_error (Qwrong_type_argument,
2154 list3 (Qeventp, e, Qunread_command_event));
2157 Fcopy_event (e, event);
2159 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2162 /* If we're executing a keyboard macro, take the next event from that,
2163 and update this-command-keys and recent-keys.
2164 Note that the unread-command-events take precedence over kbd macros.
2168 if (!NILP (Vexecuting_macro))
2171 pop_kbd_macro_event (event); /* This throws past us at
2174 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2176 /* Otherwise, read a real event, possibly from the
2177 command_event_queue, and update this-command-keys and
2181 run_pre_idle_hook ();
2183 next_event_internal (event, 1);
2184 Vquit_flag = Qnil; /* Read C-g as an event. */
2189 status_notify (); /* Notice process change */
2192 alloca (0); /* Cause a garbage collection now */
2193 /* Since we can free the most stuff here
2194 * (since this is typically called from
2195 * the command-loop top-level). */
2196 #endif /* C_ALLOCA */
2198 if (object_dead_p (XEVENT (event)->channel))
2199 /* event_console_or_selected may crash if the channel is dead.
2200 Best just to eat it and get the next event. */
2201 goto start_over_and_avoid_hosage;
2203 /* OK, now we can stop the selected-console kludge and use the
2204 actual console from the event. */
2205 con = event_console_or_selected (event);
2206 command_builder = XCOMMAND_BUILDER (con->command_builder);
2208 switch (XEVENT_TYPE (event))
2212 case button_release_event:
2213 case misc_user_event:
2214 /* don't echo menu accelerator keys */
2215 reset_key_echo (command_builder, 1);
2217 case button_press_event: /* key or mouse input can trigger prompting */
2218 goto STORE_AND_EXECUTE_KEY;
2219 case key_press_event: /* any key input can trigger autosave */
2223 maybe_do_auto_save ();
2225 STORE_AND_EXECUTE_KEY:
2228 echo_key_event (command_builder, event);
2232 /* Store the last-input-event. The semantics of this is that it is
2233 the thing most recently returned by next-command-event. It need
2234 not have come from the keyboard or a keyboard macro, it may have
2235 come from unread-command-events. It's always a command-event (a
2236 key, click, or menu selection), never a motion or process event.
2238 if (!EVENTP (Vlast_input_event))
2239 Vlast_input_event = Fmake_event (Qnil, Qnil);
2240 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2242 Vlast_input_event = Fmake_event (Qnil, Qnil);
2243 error ("Someone deallocated last-input-event!");
2245 if (! EQ (event, Vlast_input_event))
2246 Fcopy_event (event, Vlast_input_event);
2248 /* last-input-char and last-input-time are derived from
2250 Note that last-input-char will never have its high-bit set, in an
2251 effort to sidestep the ambiguity between M-x and oslash.
2253 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2258 if (!CONSP (Vlast_input_time))
2259 Vlast_input_time = Fcons (Qnil, Qnil);
2260 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2261 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2262 if (!CONSP (Vlast_command_event_time))
2263 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2264 XCAR (Vlast_command_event_time) =
2265 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2266 XCAR (XCDR (Vlast_command_event_time)) =
2267 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2268 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2269 = make_int (EMACS_USECS (t));
2271 /* If this key came from the keyboard or from a keyboard macro, then
2272 it goes into the recent-keys and this-command-keys vectors.
2273 If this key came from the keyboard, and we're defining a keyboard
2274 macro, then it goes into the macro.
2278 push_this_command_keys (event);
2279 if (!inhibit_input_event_recording)
2280 push_recent_keys (event);
2281 dribble_out_event (event);
2282 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2284 if (!EVENTP (command_builder->current_events))
2285 finalize_kbd_macro_chars (con);
2286 store_kbd_macro_event (event);
2289 /* If this is the help char and there is a help form, then execute the
2290 help form and swallow this character. This is the only place where
2291 calling Fnext_event() can cause arbitrary lisp code to run. Note
2292 that execute_help_form() calls Fnext_command_event(), which calls
2293 this function, as well as Fdispatch_event.
2295 if (!NILP (Vhelp_form) &&
2296 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2297 execute_help_form (command_builder, event);
2304 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2305 Return the next available "user" event.
2306 Pass this object to `dispatch-event' to handle it.
2308 If EVENT is non-nil, it should be an event object and will be filled in
2309 and returned; otherwise a new event object will be created and returned.
2310 If PROMPT is non-nil, it should be a string and will be displayed in the
2311 echo area while this function is waiting for an event.
2313 The event returned will be a keyboard, mouse press, or mouse release event.
2314 If there are non-command events available (mouse motion, sub-process output,
2315 etc) then these will be executed (with `dispatch-event') and discarded. This
2316 function is provided as a convenience; it is roughly equivalent to the lisp code
2319 (next-event event prompt)
2320 (not (or (key-press-event-p event)
2321 (button-press-event-p event)
2322 (button-release-event-p event)
2323 (misc-user-event-p event))))
2324 (dispatch-event event))
2326 but it also makes a provision for displaying keystrokes in the echo area.
2330 /* This function can GC */
2331 struct gcpro gcpro1;
2333 maybe_echo_keys (XCOMMAND_BUILDER
2334 (XCONSOLE (Vselected_console)->
2335 command_builder), 0); /* #### This sucks bigtime */
2338 event = Fnext_event (event, prompt);
2339 if (command_event_p (event))
2342 execute_internal_event (event);
2348 DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2349 Dispatch any pending "magic" events.
2351 This function is useful for forcing the redisplay of native
2352 widgets. Normally these are redisplayed through a native window-system
2353 event encoded as magic event, rather than by the redisplay code. This
2354 function does not call redisplay or do any of the other things that
2359 /* This function can GC */
2360 Lisp_Object event = Qnil;
2361 struct gcpro gcpro1;
2363 event = Fmake_event (Qnil, Qnil);
2365 /* Make sure that there will be something in the native event queue
2366 so that externally managed things (e.g. widgets) get some CPU
2368 event_stream_force_event_pending (selected_frame ());
2370 while (event_stream_event_pending_p (0))
2372 QUIT; /* next_event_internal() does not QUIT. */
2374 /* We're a generator of the command_event_queue, so we can't be a
2375 consumer as well. Also, we have no reason to consult the
2376 command_event_queue; there are only user and eval-events there,
2377 and we'd just have to put them back anyway.
2379 next_event_internal (event, 0); /* blocks */
2380 /* See the comment in accept-process-output about Vquit_flag */
2381 if (XEVENT_TYPE (event) == magic_event ||
2382 XEVENT_TYPE (event) == timeout_event ||
2383 XEVENT_TYPE (event) == process_event ||
2384 XEVENT_TYPE (event) == pointer_motion_event)
2385 execute_internal_event (event);
2388 enqueue_command_event_1 (event);
2393 Fdeallocate_event (event);
2399 reset_current_events (struct command_builder *command_builder)
2401 Lisp_Object event = command_builder->current_events;
2402 reset_command_builder_event_chain (command_builder);
2404 deallocate_event_chain (event);
2407 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2408 Discard any pending "user" events.
2409 Also cancel any kbd macro being defined.
2410 A user event is a key press, button press, button release, or
2411 "misc-user" event (menu selection or scrollbar action).
2415 /* This throws away user-input on the queue, but doesn't process any
2416 events. Calling dispatch_event() here leads to a race condition.
2418 Lisp_Object event = Fmake_event (Qnil, Qnil);
2419 Lisp_Object head = Qnil, tail = Qnil;
2420 Lisp_Object oiq = Vinhibit_quit;
2421 struct gcpro gcpro1, gcpro2;
2422 /* #### not correct here with Vselected_console? Should
2423 discard-input take a console argument, or maybe map over
2425 struct console *con = XCONSOLE (Vselected_console);
2427 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2428 GCPRO2 (event, oiq);
2430 /* If a macro was being defined then we have to mark the modeline
2431 has changed to ensure that it gets updated correctly. */
2432 if (!NILP (con->defining_kbd_macro))
2433 MARK_MODELINE_CHANGED;
2434 con->defining_kbd_macro = Qnil;
2435 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2437 while (!NILP (command_event_queue)
2438 || event_stream_event_pending_p (1))
2440 /* This will take stuff off the command_event_queue, or read it
2441 from the event_stream, but it will not block.
2443 next_event_internal (event, 1);
2444 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2445 It is vitally important that we reset
2446 Vquit_flag here. Otherwise, if we're
2447 reading from a TTY console,
2448 maybe_read_quit_event() will notice
2449 that C-g has been set and send us
2450 another C-g. That will cause us
2451 to get right back here, and read
2452 another C-g, ad infinitum ... */
2454 /* If the event is a user event, ignore it. */
2455 if (!command_event_p (event))
2457 /* Otherwise, chain the event onto our list of events not to ignore,
2458 and keep reading until the queue is empty. This does not mean
2459 that if a subprocess is generating an infinite amount of output,
2460 we will never terminate (*provided* that the behavior of
2461 next_event_cb() is correct -- see the comment in events.h),
2462 because this loop ends as soon as there are no more user events
2463 on the command_event_queue or event_stream.
2465 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2469 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2472 /* Now tack our chain of events back on to the front of the queue.
2473 Actually, since the queue is now drained, we can just replace it.
2474 The effect of this will be that we have deleted all user events
2475 from the input stream without changing the relative ordering of
2476 any other events. (Some events may have been taken from the
2477 event_stream and added to the command_event_queue, however.)
2479 At this time, the command_event_queue will contain only eval_events.
2482 command_event_queue = head;
2483 command_event_queue_tail = tail;
2485 Fdeallocate_event (event);
2488 Vinhibit_quit = oiq;
2493 /**********************************************************************/
2494 /* pausing until an action occurs */
2495 /**********************************************************************/
2497 /* This is used in accept-process-output, sleep-for and sit-for.
2498 Before running any process_events in these routines, we set
2499 recursive_sit_for to Qt, and use this unwind protect to reset it to
2500 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2501 cause it to return immediately.
2503 All of these routines install timeouts, so we clear the installed
2506 Note: It's very easy to break the desired behaviors of these
2507 3 routines. If you make any changes to anything in this area, run
2508 the regression tests at the bottom of the file. -- dmoore */
2512 sit_for_unwind (Lisp_Object timeout_id)
2514 if (!NILP(timeout_id))
2515 Fdisable_timeout (timeout_id);
2517 recursive_sit_for = Qnil;
2521 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2524 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2525 Allow any pending output from subprocesses to be read by Emacs.
2526 It is read into the process' buffers or given to their filter functions.
2527 Non-nil arg PROCESS means do not return until some output has been received
2528 from PROCESS. Nil arg PROCESS means do not return until some output has
2529 been received from any process.
2530 If the second arg is non-nil, it is the maximum number of seconds to wait:
2531 this function will return after that much time even if no input has arrived
2532 from PROCESS. This argument may be a float, meaning wait some fractional
2534 If the third arg is non-nil, it is a number of milliseconds that is added
2535 to the second arg. (This exists only for compatibility.)
2536 Return non-nil iff we received any output before the timeout expired.
2538 (process, timeout_secs, timeout_msecs))
2540 /* This function can GC */
2541 struct gcpro gcpro1, gcpro2;
2542 Lisp_Object event = Qnil;
2543 Lisp_Object result = Qnil;
2544 int timeout_id = -1;
2545 int timeout_enabled = 0;
2547 struct buffer *old_buffer = current_buffer;
2550 /* We preserve the current buffer but nothing else. If a focus
2551 change alters the selected window then the top level event loop
2552 will eventually alter current_buffer to match. In the mean time
2553 we don't want to mess up whatever called this function. */
2555 if (!NILP (process))
2556 CHECK_PROCESS (process);
2558 GCPRO2 (event, process);
2560 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2562 unsigned long msecs = 0;
2563 if (!NILP (timeout_secs))
2564 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2565 if (!NILP (timeout_msecs))
2567 CHECK_NATNUM (timeout_msecs);
2568 msecs += XINT (timeout_msecs);
2572 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2573 timeout_enabled = 1;
2577 event = Fmake_event (Qnil, Qnil);
2579 count = specpdl_depth ();
2580 record_unwind_protect (sit_for_unwind,
2581 timeout_enabled ? make_int (timeout_id) : Qnil);
2582 recursive_sit_for = Qt;
2585 ((NILP (process) && timeout_enabled) ||
2586 (NILP (process) && event_stream_event_pending_p (0)) ||
2588 /* Calling detect_input_pending() is the wrong thing here, because
2589 that considers the Vunread_command_events and command_event_queue.
2590 We don't need to look at the command_event_queue because we are
2591 only interested in process events, which don't go on that. In
2592 fact, we can't read from it anyway, because we put stuff on it.
2594 Note that event_stream->event_pending_p must be called in such
2595 a way that it says whether any events *of any kind* are ready,
2596 not just user events, or (accept-process-output nil) will fail
2597 to dispatch any process events that may be on the queue. It is
2598 not clear to me that this is important, because the top-level
2599 loop will process it, and I don't think that there is ever a
2600 time when one calls accept-process-output with a nil argument
2601 and really need the processes to be handled. */
2603 /* If our timeout has arrived, we move along. */
2604 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2606 timeout_enabled = 0;
2607 done = 1; /* We're done. */
2608 continue; /* Don't call next_event_internal */
2611 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2612 before reading output from the process - this makes it
2613 less likely that the filter will actually be aborted.
2616 next_event_internal (event, 0);
2617 /* If C-g was pressed while we were waiting, Vquit_flag got
2618 set and next_event_internal() also returns C-g. When
2619 we enqueue the C-g below, it will get discarded. The
2620 next time through, QUIT will be called and will signal a quit. */
2621 switch (XEVENT_TYPE (event))
2625 if (NILP (process) ||
2626 EQ (XEVENT (event)->event.process.process, process))
2629 /* RMS's version always returns nil when proc is nil,
2630 and only returns t if input ever arrived on proc. */
2634 execute_internal_event (event);
2638 /* We execute the event even if it's ours, and notice that it's
2640 case pointer_motion_event:
2643 execute_internal_event (event);
2648 enqueue_command_event_1 (event);
2654 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2656 Fdeallocate_event (event);
2658 current_buffer = old_buffer;
2662 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2663 Pause, without updating display, for ARG seconds.
2664 ARG may be a float, meaning pause for some fractional part of a second.
2666 It is recommended that you never call sleep-for from inside of a process
2667 filter function or timer event (either synchronous or asynchronous).
2671 /* This function can GC */
2672 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2674 Lisp_Object event = Qnil;
2676 struct gcpro gcpro1;
2680 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2681 event = Fmake_event (Qnil, Qnil);
2683 count = specpdl_depth ();
2684 record_unwind_protect (sit_for_unwind, make_int (id));
2685 recursive_sit_for = Qt;
2689 /* If our timeout has arrived, we move along. */
2690 if (!event_stream_wakeup_pending_p (id, 0))
2693 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2694 before reading output from the process - this makes it
2695 less likely that the filter will actually be aborted.
2697 /* We're a generator of the command_event_queue, so we can't be a
2698 consumer as well. We don't care about command and eval-events
2701 next_event_internal (event, 0); /* blocks */
2702 /* See the comment in accept-process-output about Vquit_flag */
2703 switch (XEVENT_TYPE (event))
2706 /* We execute the event even if it's ours, and notice that it's
2709 case pointer_motion_event:
2712 execute_internal_event (event);
2717 enqueue_command_event_1 (event);
2723 unbind_to (count, make_int (id));
2724 Fdeallocate_event (event);
2729 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2730 Perform redisplay, then wait ARG seconds or until user input is available.
2731 ARG may be a float, meaning a fractional part of a second.
2732 Optional second arg non-nil means don't redisplay, just wait for input.
2733 Redisplay is preempted as always if user input arrives, and does not
2734 happen if input is available before it starts.
2735 Value is t if waited the full time with no input arriving.
2737 If sit-for is called from within a process filter function or timer
2738 event (either synchronous or asynchronous) it will return immediately.
2740 (seconds, nodisplay))
2742 /* This function can GC */
2743 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2744 Lisp_Object event, result;
2745 struct gcpro gcpro1;
2749 /* The unread-command-events count as pending input */
2750 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2753 /* If the command-builder already has user-input on it (not eval events)
2754 then that means we're done too.
2756 if (!NILP (command_event_queue))
2758 EVENT_CHAIN_LOOP (event, command_event_queue)
2760 if (command_event_p (event))
2765 /* If we're in a macro, or noninteractive, or early in temacs, then
2767 if (noninteractive || !NILP (Vexecuting_macro))
2770 /* Recursive call from a filter function or timeout handler. */
2771 if (!NILP(recursive_sit_for))
2773 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2775 run_pre_idle_hook ();
2782 /* Otherwise, start reading events from the event_stream.
2783 Do this loop at least once even if (sit-for 0) so that we
2784 redisplay when no input pending.
2787 event = Fmake_event (Qnil, Qnil);
2789 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2790 events get processed. The old (pre-19.12) code special-cased this
2791 and didn't generate a wakeup, but the resulting behavior was less than
2792 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2793 the E-Lisp universe. */
2795 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2797 count = specpdl_depth ();
2798 record_unwind_protect (sit_for_unwind, make_int (id));
2799 recursive_sit_for = Qt;
2803 /* If there is no user input pending, then redisplay.
2805 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2807 run_pre_idle_hook ();
2811 /* If our timeout has arrived, we move along. */
2812 if (!event_stream_wakeup_pending_p (id, 0))
2818 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2819 before reading output from the process - this makes it
2820 less likely that the filter will actually be aborted.
2822 /* We're a generator of the command_event_queue, so we can't be a
2823 consumer as well. In fact, we know there's nothing on the
2824 command_event_queue that we didn't just put there.
2826 next_event_internal (event, 0); /* blocks */
2827 /* See the comment in accept-process-output about Vquit_flag */
2829 if (command_event_p (event))
2831 QUIT; /* If the command was C-g check it here
2832 so that we abort out of the sit-for,
2833 not the next command. sleep-for and
2834 accept-process-output continue looping
2835 so they check QUIT again implicitly.*/
2839 switch (XEVENT_TYPE (event))
2843 /* eval-events get delayed until later. */
2844 enqueue_command_event (Fcopy_event (event, Qnil));
2849 /* We execute the event even if it's ours, and notice that it's
2853 execute_internal_event (event);
2860 unbind_to (count, make_int (id));
2862 /* Put back the event (if any) that made Fsit_for() exit before the
2863 timeout. Note that it is being added to the back of the queue, which
2864 would be inappropriate if there were any user events on the queue
2865 already: we would be misordering them. But we know that there are
2866 no user-events on the queue, or else we would not have reached this
2870 enqueue_command_event (event);
2872 Fdeallocate_event (event);
2878 /* This handy little function is used by xselect.c and energize.c to
2879 wait for replies from processes that aren't really processes (that is,
2880 the X server and the Energize server).
2883 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2885 /* This function can GC */
2886 Lisp_Object event = Fmake_event (Qnil, Qnil);
2887 struct gcpro gcpro1;
2890 while (!(*predicate) (predicate_arg))
2892 QUIT; /* next_event_internal() does not QUIT. */
2894 /* We're a generator of the command_event_queue, so we can't be a
2895 consumer as well. Also, we have no reason to consult the
2896 command_event_queue; there are only user and eval-events there,
2897 and we'd just have to put them back anyway.
2899 next_event_internal (event, 0);
2900 /* See the comment in accept-process-output about Vquit_flag */
2901 if (command_event_p (event)
2902 || (XEVENT_TYPE (event) == eval_event)
2903 || (XEVENT_TYPE (event) == magic_eval_event))
2904 enqueue_command_event_1 (event);
2906 execute_internal_event (event);
2912 /**********************************************************************/
2913 /* dispatching events; command builder */
2914 /**********************************************************************/
2917 execute_internal_event (Lisp_Object event)
2919 /* events on dead channels get silently eaten */
2920 if (object_dead_p (XEVENT (event)->channel))
2923 /* This function can GC */
2924 switch (XEVENT_TYPE (event))
2931 call1 (XEVENT (event)->event.eval.function,
2932 XEVENT (event)->event.eval.object);
2936 case magic_eval_event:
2938 (XEVENT (event)->event.magic_eval.internal_function)
2939 (XEVENT (event)->event.magic_eval.object);
2943 case pointer_motion_event:
2945 if (!NILP (Vmouse_motion_handler))
2946 call1 (Vmouse_motion_handler, event);
2952 Lisp_Object p = XEVENT (event)->event.process.process;
2953 Charcount readstatus;
2955 assert (PROCESSP (p));
2956 while ((readstatus = read_process_output (p)) > 0)
2959 ; /* this clauses never gets executed but allows the #ifdefs
2962 else if (readstatus == -1 && errno == EWOULDBLOCK)
2964 #endif /* EWOULDBLOCK */
2966 else if (readstatus == -1 && errno == EAGAIN)
2969 else if ((readstatus == 0 &&
2970 /* Note that we cannot distinguish between no input
2971 available now and a closed pipe.
2972 With luck, a closed pipe will be accompanied by
2973 subprocess termination and SIGCHLD. */
2974 (!network_connection_p (p) ||
2976 When connected to ToolTalk (i.e.
2977 connected_via_filedesc_p()), it's not possible to
2978 reliably determine whether there is a message
2979 waiting for ToolTalk to receive. ToolTalk expects
2980 to have tt_message_receive() called exactly once
2981 every time the file descriptor becomes active, so
2982 the filter function forces this by returning 0.
2983 Emacs must not interpret this as a closed pipe. */
2984 connected_via_filedesc_p (XPROCESS (p))))
2986 /* On some OSs with ptys, when the process on one end of
2987 a pty exits, the other end gets an error reading with
2988 errno = EIO instead of getting an EOF (0 bytes read).
2989 Therefore, if we get an error reading and errno =
2990 EIO, just continue, because the child process has
2991 exited and should clean itself up soon (e.g. when we
2993 || (readstatus == -1 && errno == EIO)
2997 /* Currently, we rely on SIGCHLD to indicate that the
2998 process has terminated. Unfortunately, on some systems
2999 the SIGCHLD gets missed some of the time. So we put an
3000 additional check in status_notify() to see whether a
3001 process has terminated. We must tell status_notify()
3002 to enable that check, and we do so now. */
3003 kick_status_notify ();
3007 /* Deactivate network connection */
3008 Lisp_Object status = Fprocess_status (p);
3009 if (EQ (status, Qopen)
3010 /* In case somebody changes the theory of whether to
3011 return open as opposed to run for network connection
3013 || EQ (status, Qrun))
3014 update_process_status (p, Qexit, 256, 0);
3015 deactivate_process (p);
3018 /* We must call status_notify here to allow the
3019 event_stream->unselect_process_cb to be run if appropriate.
3020 Otherwise, dead fds may be selected for, and we will get a
3021 continuous stream of process events for them. Since we don't
3022 return until all process events have been flushed, we would
3023 get stuck here, processing events on a process whose status
3024 was 'exit. Call this after dispatch-event, or the fds will
3025 have been closed before we read the last data from them.
3026 It's safe for the filter to signal an error because
3027 status_notify() will be called on return to top-level.
3035 Lisp_Event *e = XEVENT (event);
3036 if (!NILP (e->event.timeout.function))
3037 call1 (e->event.timeout.function,
3038 e->event.timeout.object);
3043 event_stream_handle_magic_event (XEVENT (event));
3054 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3056 Lisp_Object first_before_suffix =
3057 event_chain_find_previous (Vthis_command_keys, suffix);
3059 if (NILP (first_before_suffix))
3060 Vthis_command_keys = chain;
3062 XSET_EVENT_NEXT (first_before_suffix, chain);
3063 deallocate_event_chain (suffix);
3064 Vthis_command_keys_tail = event_chain_tail (chain);
3068 command_builder_replace_suffix (struct command_builder *builder,
3069 Lisp_Object suffix, Lisp_Object chain)
3071 Lisp_Object first_before_suffix =
3072 event_chain_find_previous (builder->current_events, suffix);
3074 if (NILP (first_before_suffix))
3075 builder->current_events = chain;
3077 XSET_EVENT_NEXT (first_before_suffix, chain);
3078 deallocate_event_chain (suffix);
3079 builder->most_current_event = event_chain_tail (chain);
3083 command_builder_find_leaf_1 (struct command_builder *builder)
3085 Lisp_Object event0 = builder->current_events;
3090 return event_binding (event0, 1);
3093 /* See if we can do function-key-map or key-translation-map translation
3094 on the current events in the command builder. If so, do this, and
3095 return the resulting binding, if any. */
3098 munge_keymap_translate (struct command_builder *builder,
3099 enum munge_me_out_the_door munge,
3100 int has_normal_binding_p)
3104 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3106 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3111 if (KEYMAPP (result))
3113 if (NILP (builder->last_non_munged_event)
3114 && !has_normal_binding_p)
3115 builder->last_non_munged_event = builder->most_current_event;
3118 builder->last_non_munged_event = Qnil;
3120 if (!KEYMAPP (result) &&
3121 !VECTORP (result) &&
3124 struct gcpro gcpro1;
3126 result = call1 (result, Qnil);
3132 if (KEYMAPP (result))
3135 if (VECTORP (result) || STRINGP (result))
3137 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3141 /* If the first_mungeable_event of the other munger is
3142 within the events we're munging, then it will point to
3143 deallocated events afterwards, which is bad -- so make it
3144 point at the beginning of the munged events. */
3145 EVENT_CHAIN_LOOP (tempev, suffix)
3147 Lisp_Object *mungeable_event =
3148 &builder->munge_me[1 - munge].first_mungeable_event;
3149 if (EQ (tempev, *mungeable_event))
3151 *mungeable_event = new_chain;
3156 n = event_chain_count (suffix);
3157 command_builder_replace_suffix (builder, suffix, new_chain);
3158 builder->munge_me[munge].first_mungeable_event = Qnil;
3159 /* Now hork this-command-keys as well. */
3161 /* We just assume that the events we just replaced are
3162 sitting in copied form at the end of this-command-keys.
3163 If the user did weird things with `dispatch-event' this
3164 may not be the case, but at least we make sure we won't
3166 new_chain = copy_event_chain (new_chain);
3167 tckn = event_chain_count (Vthis_command_keys);
3170 this_command_keys_replace_suffix
3171 (event_chain_nth (Vthis_command_keys, tckn - n),
3175 result = command_builder_find_leaf_1 (builder);
3179 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3180 "Invalid binding in function-key-map" :
3181 "Invalid binding in key-translation-map"),
3188 /* Compare the current state of the command builder against the local and
3189 global keymaps, and return the binding. If there is no match, try again,
3190 case-insensitively. The return value will be one of:
3191 -- nil (there is no binding)
3192 -- a keymap (part of a command has been specified)
3193 -- a command (anything that satisfies `commandp'; this includes
3194 some symbols, lists, subrs, strings, vectors, and
3195 compiled-function objects)
3198 command_builder_find_leaf (struct command_builder *builder,
3199 int allow_misc_user_events_p)
3201 /* This function can GC */
3203 Lisp_Object evee = builder->current_events;
3205 if (XEVENT_TYPE (evee) == misc_user_event)
3207 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3208 return list2 (XEVENT (evee)->event.eval.function,
3209 XEVENT (evee)->event.eval.object);
3214 /* if we're currently in a menu accelerator, check there for further
3216 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
3217 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3218 if (x_kludge_lw_menu_active ())
3220 return command_builder_operate_menu_accelerator (builder);
3225 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3226 result = command_builder_find_menu_accelerator (builder);
3229 result = command_builder_find_leaf_1 (builder);
3230 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3232 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3233 result = command_builder_find_menu_accelerator (builder);
3237 /* Check to see if we have a potential function-key-map match. */
3240 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3241 regenerate_echo_keys_from_this_command_keys (builder);
3243 /* Check to see if we have a potential key-translation-map match. */
3245 Lisp_Object key_translate_result =
3246 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3248 if (!NILP (key_translate_result))
3250 result = key_translate_result;
3251 regenerate_echo_keys_from_this_command_keys (builder);
3258 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3260 /* If we didn't find a binding, and the last event in the sequence is
3261 a shifted character, then try again with the lowercase version. */
3263 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3264 && !NILP (Vretry_undefined_key_binding_unshifted))
3266 Lisp_Object terminal = builder->most_current_event;
3267 struct key_data* key = & XEVENT (terminal)->event.key;
3269 if ((key->modifiers & XEMACS_MOD_SHIFT)
3270 || (CHAR_OR_CHAR_INTP (key->keysym)
3271 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3273 Lisp_Event terminal_copy = *XEVENT (terminal);
3275 if (key->modifiers & XEMACS_MOD_SHIFT)
3276 key->modifiers &= (~ XEMACS_MOD_SHIFT);
3278 key->keysym = make_char (c + 'a' - 'A');
3280 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3283 /* If there was no match with the lower-case version either,
3284 then put back the upper-case event for the error
3285 message. But make sure that function-key-map didn't
3286 change things out from under us. */
3287 if (EQ (terminal, builder->most_current_event))
3288 *XEVENT (terminal) = terminal_copy;
3292 /* help-char is `auto-bound' in every keymap */
3293 if (!NILP (Vprefix_help_command) &&
3294 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3296 return Vprefix_help_command;
3299 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3300 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3301 && !NILP (Vcomposed_character_default_binding))
3303 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3304 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3305 return Vcomposed_character_default_binding;
3307 #endif /* HAVE_XIM */
3309 /* If we read extra events attempting to match a function key but end
3310 up failing, then we release those events back to the command loop
3311 and fail on the original lookup. The released events will then be
3312 reprocessed in the context of the first part having failed. */
3313 if (!NILP (builder->last_non_munged_event))
3315 Lisp_Object event0 = builder->last_non_munged_event;
3317 /* Put the commands back on the event queue. */
3318 enqueue_event_chain (XEVENT_NEXT (event0),
3319 &command_event_queue,
3320 &command_event_queue_tail);
3322 /* Then remove them from the command builder. */
3323 XSET_EVENT_NEXT (event0, Qnil);
3324 builder->most_current_event = event0;
3325 builder->last_non_munged_event = Qnil;
3332 /* Every time a command-event (a key, button, or menu selection) is read by
3333 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3334 and in Vthis_command_keys. (Eval-events are not stored there.)
3336 Every time a command is invoked, Vlast_command_event is set to the last
3337 event in the sequence.
3339 This means that Vthis_command_keys is really about "input read since the
3340 last command was executed" rather than about "what keys invoked this
3341 command." This is a little counterintuitive, but that's the way it
3344 As an extra kink, the function read-key-sequence resets/updates the
3345 last-command-event and this-command-keys. It doesn't append to the
3346 command-keys as read-char does. Such are the pitfalls of having to
3347 maintain compatibility with a program for which the only specification
3350 (We could implement recent_keys_ring and Vthis_command_keys as the same
3354 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3355 Return a vector of recent keyboard or mouse button events read.
3356 If NUMBER is non-nil, not more than NUMBER events will be returned.
3357 Change number of events stored using `set-recent-keys-ring-size'.
3359 This copies the event objects into a new vector; it is safe to keep and
3364 struct gcpro gcpro1;
3365 Lisp_Object val = Qnil;
3367 int start, nkeys, i, j;
3371 nwanted = recent_keys_ring_size;
3374 CHECK_NATNUM (number);
3375 nwanted = XINT (number);
3378 /* Create the keys ring vector, if none present. */
3379 if (NILP (Vrecent_keys_ring))
3381 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3382 /* And return nothing in particular. */
3383 return make_vector (0, Qnil);
3386 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3387 /* This means the vector has not yet wrapped */
3389 nkeys = recent_keys_ring_index;
3394 nkeys = recent_keys_ring_size;
3395 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3398 if (nwanted < nkeys)
3400 start += nkeys - nwanted;
3401 if (start >= recent_keys_ring_size)
3402 start -= recent_keys_ring_size;
3408 val = make_vector (nwanted, Qnil);
3410 for (i = 0, j = start; i < nkeys; i++)
3412 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3416 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3417 if (++j >= recent_keys_ring_size)
3425 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3426 The maximum number of events `recent-keys' can return.
3430 return make_int (recent_keys_ring_size);
3433 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3434 Set the maximum number of events to be stored internally.
3438 Lisp_Object new_vector = Qnil;
3439 int i, j, nkeys, start, min;
3440 struct gcpro gcpro1;
3441 GCPRO1 (new_vector);
3444 if (XINT (size) <= 0)
3445 error ("Recent keys ring size must be positive");
3446 if (XINT (size) == recent_keys_ring_size)
3449 new_vector = make_vector (XINT (size), Qnil);
3451 if (NILP (Vrecent_keys_ring))
3453 Vrecent_keys_ring = new_vector;
3457 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3458 /* This means the vector has not yet wrapped */
3460 nkeys = recent_keys_ring_index;
3465 nkeys = recent_keys_ring_size;
3466 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3469 if (XINT (size) > nkeys)
3474 for (i = 0, j = start; i < min; i++)
3476 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3477 if (++j >= recent_keys_ring_size)
3480 recent_keys_ring_size = XINT (size);
3481 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3483 Vrecent_keys_ring = new_vector;
3489 /* Vthis_command_keys having value Qnil means that the next time
3490 push_this_command_keys is called, it should start over.
3491 The times at which the command-keys are reset
3492 (instead of merely being augmented) are pretty counterintuitive.
3495 -- We do not reset this-command-keys when we finish reading a
3496 command. This is because some commands (e.g. C-u) act
3497 like command prefixes; they signal this by setting prefix-arg
3499 -- Therefore, we reset this-command-keys when we finish
3500 executing a command, unless prefix-arg is set.
3501 -- However, if we ever do a non-local exit out of a command
3502 loop (e.g. an error in a command), we need to reset
3503 this-command-keys. We do this by calling reset_this_command_keys()
3504 from cmdloop.c, whenever an error causes an invocation of the
3505 default error handler, and whenever there's a throw to top-level.)
3509 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
3511 struct command_builder *command_builder =
3512 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
3514 reset_key_echo (command_builder, clear_echo_area_p);
3516 deallocate_event_chain (Vthis_command_keys);
3517 Vthis_command_keys = Qnil;
3518 Vthis_command_keys_tail = Qnil;
3520 reset_current_events (command_builder);
3524 push_this_command_keys (Lisp_Object event)
3526 Lisp_Object new = Fmake_event (Qnil, Qnil);
3528 Fcopy_event (event, new);
3529 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
3532 /* The following two functions are used in call-interactively,
3533 for the @ and e specifications. We used to just use
3534 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3535 but FSF does it more generally so we follow their lead. */
3538 extract_this_command_keys_nth_mouse_event (int n)
3542 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3545 && (XEVENT_TYPE (event) == button_press_event
3546 || XEVENT_TYPE (event) == button_release_event
3547 || XEVENT_TYPE (event) == misc_user_event))
3551 /* must copy to avoid an abort() in next_event_internal() */
3552 if (!NILP (XEVENT_NEXT (event)))
3553 return Fcopy_event (event, Qnil);
3565 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
3568 int len = XVECTOR_LENGTH (vector);
3570 for (i = 0; i < len; i++)
3572 Lisp_Object event = XVECTOR_DATA (vector)[i];
3574 switch (XEVENT_TYPE (event))
3576 case button_press_event :
3577 case button_release_event :
3578 case misc_user_event :
3592 push_recent_keys (Lisp_Object event)
3596 if (NILP (Vrecent_keys_ring))
3597 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3599 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
3603 e = Fmake_event (Qnil, Qnil);
3604 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
3606 Fcopy_event (event, e);
3607 if (++recent_keys_ring_index == recent_keys_ring_size)
3608 recent_keys_ring_index = 0;
3613 current_events_into_vector (struct command_builder *command_builder)
3617 int n = event_chain_count (command_builder->current_events);
3619 /* Copy the vector and the events in it. */
3620 /* No need to copy the events, since they're already copies, and
3621 nobody other than the command-builder has pointers to them */
3622 vector = make_vector (n, Qnil);
3624 EVENT_CHAIN_LOOP (event, command_builder->current_events)
3625 XVECTOR_DATA (vector)[n++] = event;
3626 reset_command_builder_event_chain (command_builder);
3632 Given the current state of the command builder and a new command event
3633 that has just been dispatched:
3635 -- add the event to the event chain forming the current command
3636 (doing meta-translation as necessary)
3637 -- return the binding of this event chain; this will be one of:
3638 -- nil (there is no binding)
3639 -- a keymap (part of a command has been specified)
3640 -- a command (anything that satisfies `commandp'; this includes
3641 some symbols, lists, subrs, strings, vectors, and
3642 compiled-function objects)
3645 lookup_command_event (struct command_builder *command_builder,
3646 Lisp_Object event, int allow_misc_user_events_p)
3648 /* This function can GC */
3649 struct frame *f = selected_frame ();
3650 /* Clear output from previous command execution */
3651 if (!EQ (Qcommand, echo_area_status (f))
3652 /* but don't let mouse-up clear what mouse-down just printed */
3653 && (XEVENT (event)->event_type != button_release_event))
3654 clear_echo_area (f, Qnil, 0);
3656 /* Add the given event to the command builder.
3657 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3658 vectors to translate "ESC x" to "M-x" (for any "x" of course).
3661 Lisp_Object recent = command_builder->most_current_event;
3664 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
3667 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3668 DoubleThink the recent-keys and this-command-keys as well. */
3670 /* Modify the previous most-recently-pushed event on the command
3671 builder to be a copy of this one with the meta-bit set instead of
3672 pushing a new event.
3674 Fcopy_event (event, recent);
3675 e = XEVENT (recent);
3676 if (e->event_type == key_press_event)
3677 e->event.key.modifiers |= XEMACS_MOD_META;
3678 else if (e->event_type == button_press_event
3679 || e->event_type == button_release_event)
3680 e->event.button.modifiers |= XEMACS_MOD_META;
3685 int tckn = event_chain_count (Vthis_command_keys);
3687 /* ??? very strange if it's < 2. */
3688 this_command_keys_replace_suffix
3689 (event_chain_nth (Vthis_command_keys, tckn - 2),
3690 Fcopy_event (recent, Qnil));
3693 regenerate_echo_keys_from_this_command_keys (command_builder);
3697 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
3699 command_builder_append_event (command_builder, event);
3704 Lisp_Object leaf = command_builder_find_leaf (command_builder,
3705 allow_misc_user_events_p);
3706 struct gcpro gcpro1;
3711 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3712 if (!x_kludge_lw_menu_active ())
3717 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
3718 if (STRINGP (prompt))
3720 /* Append keymap prompt to key echo buffer */
3721 int buf_index = command_builder->echo_buf_index;
3722 Bytecount len = XSTRING_LENGTH (prompt);
3724 if (len + buf_index + 1 <= command_builder->echo_buf_length)
3726 Bufbyte *echo = command_builder->echo_buf + buf_index;
3727 memcpy (echo, XSTRING_DATA (prompt), len);
3730 maybe_echo_keys (command_builder, 1);
3733 maybe_echo_keys (command_builder, 0);
3735 else if (!NILP (Vquit_flag))
3737 Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
3738 Lisp_Event *e = XEVENT (quit_event);
3739 /* if quit happened during menu acceleration, pretend we read it */
3740 struct console *con = XCONSOLE (Fselected_console ());
3741 int ch = CONSOLE_QUIT_CHAR (con);
3743 character_to_event (ch, e, con, 1, 1);
3744 e->channel = make_console (con);
3746 enqueue_command_event (quit_event);
3750 else if (!NILP (leaf))
3752 if (EQ (Qcommand, echo_area_status (f))
3753 && command_builder->echo_buf_index > 0)
3755 /* If we had been echoing keys, echo the last one (without
3756 the trailing dash) and redisplay before executing the
3758 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
3759 maybe_echo_keys (command_builder, 1);
3760 Fsit_for (Qzero, Qt);
3763 RETURN_UNGCPRO (leaf);
3768 execute_command_event (struct command_builder *command_builder,
3771 /* This function can GC */
3772 struct console *con = XCONSOLE (command_builder->console);
3773 struct gcpro gcpro1;
3775 GCPRO1 (event); /* event may be freshly created */
3776 reset_current_events (command_builder);
3778 switch (XEVENT (event)->event_type)
3780 case key_press_event:
3781 Vcurrent_mouse_event = Qnil;
3783 case button_press_event:
3784 case button_release_event:
3785 case misc_user_event:
3786 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
3791 /* Store the last-command-event. The semantics of this is that it
3792 is the last event most recently involved in command-lookup. */
3793 if (!EVENTP (Vlast_command_event))
3794 Vlast_command_event = Fmake_event (Qnil, Qnil);
3795 if (XEVENT (Vlast_command_event)->event_type == dead_event)
3797 Vlast_command_event = Fmake_event (Qnil, Qnil);
3798 error ("Someone deallocated the last-command-event!");
3801 if (! EQ (event, Vlast_command_event))
3802 Fcopy_event (event, Vlast_command_event);
3804 /* Note that last-command-char will never have its high-bit set, in
3805 an effort to sidestep the ambiguity between M-x and oslash. */
3806 Vlast_command_char = Fevent_to_character (Vlast_command_event,
3809 /* Actually call the command, with all sorts of hair to preserve or clear
3810 the echo-area and region as appropriate and call the pre- and post-
3813 int old_kbd_macro = con->kbd_macro_end;
3814 struct window *w = XWINDOW (Fselected_window (Qnil));
3816 /* We're executing a new command, so the old value is irrelevant. */
3817 zmacs_region_stays = 0;
3819 /* If the previous command tried to force a specific window-start,
3820 reset the flag in case this command moves point far away from
3821 that position. Also, reset the window's buffer's change
3822 information so that we don't trigger an incremental update. */
3826 buffer_reset_changes (XBUFFER (w->buffer));
3829 pre_command_hook ();
3831 if (XEVENT (event)->event_type == misc_user_event)
3833 call1 (XEVENT (event)->event.eval.function,
3834 XEVENT (event)->event.eval.object);
3838 Fcommand_execute (Vthis_command, Qnil, Qnil);
3841 post_command_hook ();
3843 #if 0 /* #### here was an attempted fix that didn't work */
3844 if (XEVENT (event)->event_type == misc_user_event)
3848 if (!NILP (con->prefix_arg))
3850 /* Commands that set the prefix arg don't update last-command, don't
3851 reset the echoing state, and don't go into keyboard macros unless
3852 followed by another command. */
3853 maybe_echo_keys (command_builder, 0);
3855 /* If we're recording a keyboard macro, and the last command
3856 executed set a prefix argument, then decrement the pointer to
3857 the "last character really in the macro" to be just before this
3858 command. This is so that the ^U in "^U ^X )" doesn't go onto
3859 the end of macro. */
3860 if (!NILP (con->defining_kbd_macro))
3861 con->kbd_macro_end = old_kbd_macro;
3865 /* Start a new command next time */
3866 Vlast_command = Vthis_command;
3867 Vlast_command_properties = Vthis_command_properties;
3868 Vthis_command_properties = Qnil;
3870 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
3871 so we don't either */
3872 reset_this_command_keys (make_console (con), 0);
3879 /* Run the pre command hook. */
3882 pre_command_hook (void)
3884 last_point_position = BUF_PT (current_buffer);
3885 XSETBUFFER (last_point_position_buffer, current_buffer);
3886 /* This function can GC */
3887 safe_run_hook_trapping_errors
3888 ("Error in `pre-command-hook' (setting hook to nil)",
3889 Qpre_command_hook, 1);
3891 /* This is a kludge, but necessary; see simple.el */
3892 call0 (Qhandle_pre_motion_command);
3895 /* Run the post command hook. */
3898 post_command_hook (void)
3900 /* This function can GC */
3901 /* Turn off region highlighting unless this command requested that
3902 it be left on, or we're in the minibuffer. We don't turn it off
3903 when we're in the minibuffer so that things like M-x write-region
3906 This could be done via a function on the post-command-hook, but
3907 we don't want the user to accidentally remove it.
3910 Lisp_Object win = Fselected_window (Qnil);
3912 /* If the last command deleted the frame, `win' might be nil.
3913 It seems safest to do nothing in this case. */
3914 /* Note: Someone added the following comment and put #if 0's around
3915 this code, not realizing that doing this invites a crash in the
3917 /* #### This doesn't really fix the problem,
3918 if delete-frame is called by some hook */
3922 /* This is a kludge, but necessary; see simple.el */
3923 call0 (Qhandle_post_motion_command);
3925 if (! zmacs_region_stays
3926 && (!MINI_WINDOW_P (XWINDOW (win))
3927 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
3928 zmacs_deactivate_region ();
3930 zmacs_update_region ();
3932 safe_run_hook_trapping_errors
3933 ("Error in `post-command-hook' (setting hook to nil)",
3934 Qpost_command_hook, 1);
3936 #if 0 /* FSF Emacs crap */
3937 if (!NILP (Vdeferred_action_list))
3938 call0 (Vdeferred_action_function);
3940 if (NILP (Vunread_command_events)
3941 && NILP (Vexecuting_macro)
3942 && !NILP (Vpost_command_idle_hook)
3943 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
3945 safe_run_hook_trapping_errors
3946 ("Error in `post-command-idle-hook' (setting hook to nil)",
3947 Qpost_command_idle_hook, 1);
3948 #endif /* FSF Emacs crap */
3950 #if 0 /* FSF Emacs */
3951 if (!NILP (current_buffer->mark_active))
3953 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
3955 current_buffer->mark_active = Qnil;
3956 run_hook (intern ("deactivate-mark-hook"));
3958 else if (current_buffer != prev_buffer ||
3959 BUF_MODIFF (current_buffer) != prev_modiff)
3960 run_hook (intern ("activate-mark-hook"));
3962 #endif /* FSF Emacs */
3964 /* #### Kludge!!! This is necessary to make sure that things
3965 are properly positioned even if post-command-hook moves point.
3966 #### There should be a cleaner way of handling this. */
3967 call0 (Qauto_show_make_point_visible);
3971 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
3972 Given an event object as returned by `next-event', execute it.
3974 Key-press, button-press, and button-release events get accumulated
3975 until a complete key sequence (see `read-key-sequence') is reached,
3976 at which point the sequence is looked up in the current keymaps and
3979 Mouse motion events cause the low-level handling function stored in
3980 `mouse-motion-handler' to be called. (There are very few circumstances
3981 under which you should change this handler. Use `mode-motion-hook'
3984 Menu, timeout, and eval events cause the associated function or handler
3987 Process events cause the subprocess's output to be read and acted upon
3988 appropriately (see `start-process').
3990 Magic events are handled as necessary.
3994 /* This function can GC */
3995 struct command_builder *command_builder;
3997 Lisp_Object console;
3998 Lisp_Object channel;
4000 CHECK_LIVE_EVENT (event);
4001 ev = XEVENT (event);
4003 /* events on dead channels get silently eaten */
4004 channel = EVENT_CHANNEL (ev);
4005 if (object_dead_p (channel))
4008 /* Some events don't have channels (e.g. eval events). */
4009 console = CDFW_CONSOLE (channel);
4011 console = Vselected_console;
4012 else if (!EQ (console, Vselected_console))
4013 Fselect_console (console);
4015 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4016 switch (XEVENT (event)->event_type)
4018 case button_press_event:
4019 case button_release_event:
4020 case key_press_event:
4022 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4025 /* Incomplete key sequence */
4029 /* At this point, we know that the sequence is not bound to a
4030 command. Normally, we beep and print a message informing the
4031 user of this. But we do not beep or print a message when:
4033 o the last event in this sequence is a mouse-up event; or
4034 o the last event in this sequence is a mouse-down event and
4035 there is a binding for the mouse-up version.
4037 That is, if the sequence ``C-x button1'' is typed, and is not
4038 bound to a command, but the sequence ``C-x button1up'' is bound
4039 to a command, we do not complain about the ``C-x button1''
4040 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4041 bound to a command, then we complain about the ``C-x button1''
4042 sequence, but later will *not* complain about the
4043 ``C-x button1up'' sequence, which would be redundant.
4045 This is pretty hairy, but I think it's the most intuitive
4048 Lisp_Object terminal = command_builder->most_current_event;
4050 if (XEVENT_TYPE (terminal) == button_press_event)
4053 /* Temporarily pretend the last event was an "up" instead of a
4054 "down", and look up its binding. */
4055 XEVENT_TYPE (terminal) = button_release_event;
4056 /* If the "up" version is bound, don't complain. */
4058 = !NILP (command_builder_find_leaf (command_builder, 0));
4059 /* Undo the temporary changes we just made. */
4060 XEVENT_TYPE (terminal) = button_press_event;
4063 /* Pretend this press was not seen (treat as a prefix) */
4064 if (EQ (command_builder->current_events, terminal))
4066 reset_current_events (command_builder);
4072 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4073 if (EQ (XEVENT_NEXT (eve), terminal))
4076 Fdeallocate_event (command_builder->
4077 most_current_event);
4078 XSET_EVENT_NEXT (eve, Qnil);
4079 command_builder->most_current_event = eve;
4081 maybe_echo_keys (command_builder, 1);
4086 /* Complain that the typed sequence is not defined, if this is the
4087 kind of sequence that warrants a complaint. */
4088 XCONSOLE (console)->defining_kbd_macro = Qnil;
4089 XCONSOLE (console)->prefix_arg = Qnil;
4090 /* Don't complain about undefined button-release events */
4091 if (XEVENT_TYPE (terminal) != button_release_event)
4093 Lisp_Object keys = current_events_into_vector (command_builder);
4094 struct gcpro gcpro1;
4096 /* Run the pre-command-hook before barfing about an undefined
4098 Vthis_command = Qnil;
4100 pre_command_hook ();
4102 /* The post-command-hook doesn't run. */
4103 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4105 /* Reset the command builder for reading the next sequence. */
4106 reset_this_command_keys (console, 1);
4108 else /* key sequence is bound to a command */
4111 int magic_undo_count = 20;
4113 Vthis_command = leaf;
4115 /* Don't push an undo boundary if the command set the prefix arg,
4116 or if we are executing a keyboard macro, or if in the
4117 minibuffer. If the command we are about to execute is
4118 self-insert, it's tricky: up to 20 consecutive self-inserts may
4119 be done without an undo boundary. This counter is reset as
4120 soon as a command other than self-insert-command is executed.
4122 Programmers can also use the `self-insert-defer-undo'
4123 property to install that behavior on functions other
4124 than `self-insert-command', or to change the magic
4125 number 20 to something else. #### DOCUMENT THIS! */
4129 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
4131 magic_undo = 1, magic_undo_count = XINT (prop);
4132 else if (!NILP (prop))
4134 else if (EQ (leaf, Qself_insert_command))
4139 command_builder->self_insert_countdown = 0;
4140 if (NILP (XCONSOLE (console)->prefix_arg)
4141 && NILP (Vexecuting_macro)
4143 /* This was done in the days when there was no undo
4144 in the minibuffer. If we don't disable this code,
4145 then each instance of "undo" undoes everything in
4147 && !EQ (minibuf_window, Fselected_window (Qnil))
4149 && command_builder->self_insert_countdown == 0)
4154 if (--command_builder->self_insert_countdown < 0)
4155 command_builder->self_insert_countdown = magic_undo_count;
4157 execute_command_event
4159 internal_equal (event, command_builder-> most_current_event, 0)
4161 /* Use the translated event that was most recently seen.
4162 This way, last-command-event becomes f1 instead of
4163 the P from ESC O P. But we must copy it, else we'll
4164 lose when the command-builder events are deallocated. */
4165 : Fcopy_event (command_builder-> most_current_event, Qnil));
4169 case misc_user_event:
4173 We could just always use the menu item entry, whatever it is, but
4174 this might break some Lisp code that expects `this-command' to
4175 always contain a symbol. So only store it if this is a simple
4176 `call-interactively' sort of menu item.
4178 But this is bogus. `this-command' could be a string or vector
4179 anyway (for keyboard macros). There's even one instance
4180 (in pending-del.el) of `this-command' getting set to a cons
4181 (a lambda expression). So in the `eval' case I'll just
4182 convert it into a lambda expression.
4184 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4185 && SYMBOLP (XEVENT (event)->event.eval.object))
4186 Vthis_command = XEVENT (event)->event.eval.object;
4187 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4189 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4190 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4191 /* A scrollbar command or the like. */
4192 Vthis_command = XEVENT (event)->event.eval.function;
4195 Vthis_command = Qnil;
4197 /* clear the echo area */
4198 reset_key_echo (command_builder, 1);
4200 command_builder->self_insert_countdown = 0;
4201 if (NILP (XCONSOLE (console)->prefix_arg)
4202 && NILP (Vexecuting_macro)
4203 && !EQ (minibuf_window, Fselected_window (Qnil)))
4205 execute_command_event (command_builder, event);
4210 execute_internal_event (event);
4217 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4218 Read a sequence of keystrokes or mouse clicks.
4219 Returns a vector of the event objects read. The vector and the event
4220 objects it contains are freshly created (and will not be side-effected
4221 by subsequent calls to this function).
4223 The sequence read is sufficient to specify a non-prefix command starting
4224 from the current local and global keymaps. A C-g typed while in this
4225 function is treated like any other character, and `quit-flag' is not set.
4227 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4228 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4229 as a continuation of the previous key.
4231 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4232 convert the last event to lower case. (Normally any upper case event
4233 is converted to lower case if the original event is undefined and the lower
4234 case equivalent is defined.) This argument is provided mostly for
4235 FSF compatibility; the equivalent effect can be achieved more generally
4236 by binding `retry-undefined-key-binding-unshifted' to nil around the
4237 call to `read-key-sequence'.
4239 A C-g typed while in this function is treated like any other character,
4240 and `quit-flag' is not set.
4242 If the user selects a menu item while we are prompting for a key-sequence,
4243 the returned value will be a vector of a single menu-selection event.
4244 An error will be signalled if you pass this value to `lookup-key' or a
4247 `read-key-sequence' checks `function-key-map' for function key
4248 sequences, where they wouldn't conflict with ordinary bindings. See
4249 `function-key-map' for more details.
4251 (prompt, continue_echo, dont_downcase_last))
4253 /* This function can GC */
4254 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4258 struct command_builder *command_builder =
4259 XCOMMAND_BUILDER (con->command_builder);
4261 Lisp_Object event = Fmake_event (Qnil, Qnil);
4262 int speccount = specpdl_depth ();
4263 struct gcpro gcpro1;
4267 CHECK_STRING (prompt);
4268 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4271 if (NILP (continue_echo))
4272 reset_this_command_keys (make_console (con), 1);
4274 specbind (Qinhibit_quit, Qt);
4276 if (!NILP (dont_downcase_last))
4277 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4281 Fnext_event (event, prompt);
4282 /* restore the selected-console damage */
4283 con = event_console_or_selected (event);
4284 command_builder = XCOMMAND_BUILDER (con->command_builder);
4285 if (! command_event_p (event))
4286 execute_internal_event (event);
4289 if (XEVENT (event)->event_type == misc_user_event)
4290 reset_current_events (command_builder);
4291 result = lookup_command_event (command_builder, event, 1);
4292 if (!KEYMAPP (result))
4294 result = current_events_into_vector (command_builder);
4295 reset_key_echo (command_builder, 0);
4302 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4303 Fdeallocate_event (event);
4304 RETURN_UNGCPRO (unbind_to (speccount, result));
4307 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4308 Return a vector of the keyboard or mouse button events that were used
4309 to invoke this command. This copies the vector and the events; it is safe
4310 to keep and modify them.
4318 if (NILP (Vthis_command_keys))
4319 return make_vector (0, Qnil);
4321 len = event_chain_count (Vthis_command_keys);
4323 result = make_vector (len, Qnil);
4325 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4326 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4330 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4331 Used for complicated reasons in `universal-argument-other-key'.
4333 `universal-argument-other-key' rereads the event just typed.
4334 It then gets translated through `function-key-map'.
4335 The translated event gets included in the echo area and in
4336 the value of `this-command-keys' in addition to the raw original event.
4339 Calling this function directs the translated event to replace
4340 the original event, so that only one version of the event actually
4341 appears in the echo area and in the value of `this-command-keys'.
4345 /* #### I don't understand this at all, so currently it does nothing.
4346 If there is ever a problem, maybe someone should investigate. */
4352 dribble_out_event (Lisp_Object event)
4354 if (NILP (Vdribble_file))
4357 if (XEVENT (event)->event_type == key_press_event &&
4358 !XEVENT (event)->event.key.modifiers)
4360 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4361 if (CHARP (XEVENT (event)->event.key.keysym))
4363 Emchar ch = XCHAR (keysym);
4364 Bufbyte str[MAX_EMCHAR_LEN];
4365 Bytecount len = set_charptr_emchar (str, ch);
4366 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4368 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4369 /* one-char key events are printed with just the key name */
4370 Fprinc (keysym, Vdribble_file);
4371 else if (EQ (keysym, Qreturn))
4372 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4373 else if (EQ (keysym, Qspace))
4374 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4376 Fprinc (event, Vdribble_file);
4379 Fprinc (event, Vdribble_file);
4380 Lstream_flush (XLSTREAM (Vdribble_file));
4383 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4384 "FOpen dribble file: ", /*
4385 Start writing all keyboard characters to a dribble file called FILE.
4386 If FILE is nil, close any open dribble file.
4390 /* This function can GC */
4391 /* XEmacs change: always close existing dribble file. */
4392 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4393 if (!NILP (Vdribble_file))
4395 Lstream_close (XLSTREAM (Vdribble_file));
4396 Vdribble_file = Qnil;
4402 file = Fexpand_file_name (file, Qnil);
4403 fd = open ((char*) XSTRING_DATA (file),
4404 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4407 error ("Unable to create dribble file");
4408 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4411 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4412 Fget_coding_system (Qescape_quoted));
4419 /************************************************************************/
4420 /* initialization */
4421 /************************************************************************/
4424 syms_of_event_stream (void)
4426 INIT_LRECORD_IMPLEMENTATION (command_builder);
4427 INIT_LRECORD_IMPLEMENTATION (timeout);
4429 defsymbol (&Qdisabled, "disabled");
4430 defsymbol (&Qcommand_event_p, "command-event-p");
4432 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
4433 "Undefined keystroke sequence", Qerror);
4435 DEFSUBR (Frecent_keys);
4436 DEFSUBR (Frecent_keys_ring_size);
4437 DEFSUBR (Fset_recent_keys_ring_size);
4438 DEFSUBR (Finput_pending_p);
4439 DEFSUBR (Fenqueue_eval_event);
4440 DEFSUBR (Fnext_event);
4441 DEFSUBR (Fnext_command_event);
4442 DEFSUBR (Fdiscard_input);
4444 DEFSUBR (Fsleep_for);
4445 DEFSUBR (Faccept_process_output);
4446 DEFSUBR (Fadd_timeout);
4447 DEFSUBR (Fdisable_timeout);
4448 DEFSUBR (Fadd_async_timeout);
4449 DEFSUBR (Fdisable_async_timeout);
4450 DEFSUBR (Fdispatch_event);
4451 DEFSUBR (Fdispatch_non_command_events);
4452 DEFSUBR (Fread_key_sequence);
4453 DEFSUBR (Fthis_command_keys);
4454 DEFSUBR (Freset_this_command_lengths);
4455 DEFSUBR (Fopen_dribble_file);
4457 defsymbol (&Qpre_command_hook, "pre-command-hook");
4458 defsymbol (&Qpost_command_hook, "post-command-hook");
4459 defsymbol (&Qunread_command_events, "unread-command-events");
4460 defsymbol (&Qunread_command_event, "unread-command-event");
4461 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4462 defsymbol (&Qhandle_pre_motion_command, "handle-pre-motion-command");
4463 defsymbol (&Qhandle_post_motion_command, "handle-post-motion-command");
4464 #if 0 /* FSF Emacs crap */
4465 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4466 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4468 defsymbol (&Qretry_undefined_key_binding_unshifted,
4469 "retry-undefined-key-binding-unshifted");
4470 defsymbol (&Qauto_show_make_point_visible,
4471 "auto-show-make-point-visible");
4473 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
4474 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4478 reinit_vars_of_event_stream (void)
4480 recent_keys_ring_index = 0;
4481 recent_keys_ring_size = 100;
4482 num_input_chars = 0;
4483 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4485 staticpro_nodump (&Vtimeout_free_list);
4486 the_low_level_timeout_blocktype =
4487 Blocktype_new (struct low_level_timeout_blocktype);
4488 something_happened = 0;
4489 recursive_sit_for = Qnil;
4493 vars_of_event_stream (void)
4495 reinit_vars_of_event_stream ();
4496 Vrecent_keys_ring = Qnil;
4497 staticpro (&Vrecent_keys_ring);
4499 Vthis_command_keys = Qnil;
4500 staticpro (&Vthis_command_keys);
4501 Vthis_command_keys_tail = Qnil;
4502 pdump_wire (&Vthis_command_keys_tail);
4504 command_event_queue = Qnil;
4505 staticpro (&command_event_queue);
4506 command_event_queue_tail = Qnil;
4507 pdump_wire (&command_event_queue_tail);
4509 Vlast_selected_frame = Qnil;
4510 staticpro (&Vlast_selected_frame);
4512 pending_timeout_list = Qnil;
4513 staticpro (&pending_timeout_list);
4515 pending_async_timeout_list = Qnil;
4516 staticpro (&pending_async_timeout_list);
4518 last_point_position_buffer = Qnil;
4519 staticpro (&last_point_position_buffer);
4521 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
4522 *Nonzero means echo unfinished commands after this many seconds of pause.
4524 Vecho_keystrokes = make_int (1);
4526 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
4527 *Number of keyboard input characters between auto-saves.
4528 Zero means disable autosaving due to number of characters typed.
4529 See also the variable `auto-save-timeout'.
4531 auto_save_interval = 300;
4533 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
4534 Function or functions to run before every command.
4535 This may examine the `this-command' variable to find out what command
4536 is about to be run, or may change it to cause a different command to run.
4537 Function on this hook must be careful to avoid signalling errors!
4539 Vpre_command_hook = Qnil;
4541 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
4542 Function or functions to run after every command.
4543 This may examine the `this-command' variable to find out what command
4546 Vpost_command_hook = Qnil;
4548 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
4549 Normal hook run when XEmacs it about to be idle.
4550 This occurs whenever it is going to block, waiting for an event.
4551 This generally happens as a result of a call to `next-event',
4552 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4553 `x-get-selection', or various Energize-specific commands.
4554 Errors running the hook are caught and ignored.
4556 Vpre_idle_hook = Qnil;
4558 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
4559 *Variable to control XEmacs behavior with respect to focus changing.
4560 If this variable is set to t, then XEmacs will not gratuitously change
4561 the keyboard focus. XEmacs cannot in general detect when this mode is
4562 used by the window manager, so it is up to the user to set it.
4564 focus_follows_mouse = 0;
4566 #if 0 /* FSF Emacs crap */
4567 /* Ill-conceived because it's not run in all sorts of cases
4568 where XEmacs is blocking. That's what `pre-idle-hook'
4569 is designed to solve. */
4570 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
4571 Normal hook run after each command is executed, if idle.
4572 `post-command-idle-delay' specifies a time in microseconds that XEmacs
4573 must be idle for in order for the functions on this hook to be called.
4574 Errors running the hook are caught and ignored.
4576 Vpost_command_idle_hook = Qnil;
4578 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
4579 Delay time before running `post-command-idle-hook'.
4580 This is measured in microseconds.
4582 post_command_idle_delay = 5000;
4584 /* Random FSFmacs crap. There is absolutely nothing to gain,
4585 and a great deal to lose, in using this in place of just
4586 setting `post-command-hook'. */
4587 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
4588 List of deferred actions to be performed at a later time.
4589 The precise format isn't relevant here; we just check whether it is nil.
4591 Vdeferred_action_list = Qnil;
4593 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
4594 Function to call to handle deferred actions, after each command.
4595 This function is called with no arguments after each command
4596 whenever `deferred-action-list' is non-nil.
4598 Vdeferred_action_function = Qnil;
4599 #endif /* FSF Emacs crap */
4601 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
4602 Last keyboard or mouse button event that was part of a command. This
4603 variable is off limits: you may not set its value or modify the event that
4604 is its value, as it is destructively modified by `read-key-sequence'. If
4605 you want to keep a pointer to this value, you must use `copy-event'.
4607 Vlast_command_event = Qnil;
4609 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
4610 If the value of `last-command-event' is a keyboard event, then
4611 this is the nearest ASCII equivalent to it. This is the value that
4612 `self-insert-command' will put in the buffer. Remember that there is
4613 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4614 of keyboard events is much larger, so writing code that examines this
4615 variable to determine what key has been typed is bad practice, unless
4616 you are certain that it will be one of a small set of characters.
4618 Vlast_command_char = Qnil;
4620 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
4621 Last keyboard or mouse button event received. This variable is off
4622 limits: you may not set its value or modify the event that is its value, as
4623 it is destructively modified by `next-event'. If you want to keep a pointer
4624 to this value, you must use `copy-event'.
4626 Vlast_input_event = Qnil;
4628 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
4629 The mouse-button event which invoked this command, or nil.
4630 This is usually what `(interactive "e")' returns.
4632 Vcurrent_mouse_event = Qnil;
4634 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
4635 If the value of `last-input-event' is a keyboard event, then
4636 this is the nearest ASCII equivalent to it. Remember that there is
4637 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4638 of keyboard events is much larger, so writing code that examines this
4639 variable to determine what key has been typed is bad practice, unless
4640 you are certain that it will be one of a small set of characters.
4642 Vlast_input_char = Qnil;
4644 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
4645 The time (in seconds since Jan 1, 1970) of the last-command-event,
4646 represented as a cons of two 16-bit integers. This is destructively
4647 modified, so copy it if you want to keep it.
4649 Vlast_input_time = Qnil;
4651 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
4652 The time (in seconds since Jan 1, 1970) of the last-command-event,
4653 represented as a list of three integers. The first integer contains
4654 the most significant 16 bits of the number of seconds, and the second
4655 integer contains the least significant 16 bits. The third integer
4656 contains the remainder number of microseconds, if the current system
4657 supports microsecond clock resolution. This list is destructively
4658 modified, so copy it if you want to keep it.
4660 Vlast_command_event_time = Qnil;
4662 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
4663 List of event objects to be read as next command input events.
4664 This can be used to simulate the receipt of events from the user.
4665 Normally this is nil.
4666 Events are removed from the front of this list.
4668 Vunread_command_events = Qnil;
4670 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
4671 Obsolete. Use `unread-command-events' instead.
4673 Vunread_command_event = Qnil;
4675 DEFVAR_LISP ("last-command", &Vlast_command /*
4676 The last command executed. Normally a symbol with a function definition,
4677 but can be whatever was found in the keymap, or whatever the variable
4678 `this-command' was set to by that command.
4680 Vlast_command = Qnil;
4682 DEFVAR_LISP ("this-command", &Vthis_command /*
4683 The command now being executed.
4684 The command can set this variable; whatever is put here
4685 will be in `last-command' during the following command.
4687 Vthis_command = Qnil;
4689 DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /*
4690 Value of `this-command-properties' for the last command.
4691 Used by commands to help synchronize consecutive commands, in preference
4692 to looking at `last-command' directly.
4694 Vlast_command_properties = Qnil;
4696 DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /*
4697 Properties set by the current command.
4698 At the beginning of each command, the current value of this variable is
4699 copied to `last-command-properties', and then it is set to nil. Use `putf'
4700 to add properties to this variable. Commands should use this to communicate
4701 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4702 in preference to looking at and/or setting `this-command'.
4704 Vthis_command_properties = Qnil;
4706 DEFVAR_LISP ("help-char", &Vhelp_char /*
4707 Character to recognize as meaning Help.
4708 When it is read, do `(eval help-form)', and display result if it's a string.
4709 If the value of `help-form' is nil, this char can be read normally.
4710 This can be any form recognized as a single key specifier.
4711 The help-char cannot be a negative number in XEmacs.
4713 Vhelp_char = make_char (8); /* C-h */
4715 DEFVAR_LISP ("help-form", &Vhelp_form /*
4716 Form to execute when character help-char is read.
4717 If the form returns a string, that string is displayed.
4718 If `help-form' is nil, the help char is not recognized.
4722 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
4723 Command to run when `help-char' character follows a prefix key.
4724 This command is used only when there is no actual binding
4725 for that character after that prefix key.
4727 Vprefix_help_command = Qnil;
4729 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
4730 Hash table used as translate table for keyboard input.
4731 Use `keyboard-translate' to portably add entries to this table.
4732 Each key-press event is looked up in this table as follows:
4734 -- If an entry maps a symbol to a symbol, then a key-press event whose
4735 keysym is the former symbol (with any modifiers at all) gets its
4736 keysym changed and its modifiers left alone. This is useful for
4737 dealing with non-standard X keyboards, such as the grievous damage
4738 that Sun has inflicted upon the world.
4739 -- If an entry maps a character to a character, then a key-press event
4740 matching the former character gets converted to a key-press event
4741 matching the latter character. This is useful on ASCII terminals
4742 for (e.g.) making C-\\ look like C-s, to get around flow-control
4744 -- If an entry maps a character to a symbol, then a key-press event
4745 matching the character gets converted to a key-press event whose
4746 keysym is the given symbol and which has no modifiers.
4749 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
4750 &Vretry_undefined_key_binding_unshifted /*
4751 If a key-sequence which ends with a shifted keystroke is undefined
4752 and this variable is non-nil then the command lookup is retried again
4753 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
4754 If lookup still fails, a normal error is signalled. In general,
4755 you should *bind* this, not set it.
4757 Vretry_undefined_key_binding_unshifted = Qt;
4759 DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
4760 *Non-nil makes modifier keys sticky.
4761 This means that you can release the modifier key before pressing down
4762 the key that you wish to be modified. Although this is non-standard
4763 behavior, it is recommended because it reduces the strain on your hand,
4764 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4766 modifier_keys_are_sticky = 0;
4769 DEFVAR_LISP ("composed-character-default-binding",
4770 &Vcomposed_character_default_binding /*
4771 The default keybinding to use for key events from composed input.
4772 Window systems frequently have ways to allow the user to compose
4773 single characters in a language using multiple keystrokes.
4774 XEmacs sees these as single character keypress events.
4776 Vcomposed_character_default_binding = Qself_insert_command;
4777 #endif /* HAVE_XIM */
4779 Vcontrolling_terminal = Qnil;
4780 staticpro (&Vcontrolling_terminal);
4782 Vdribble_file = Qnil;
4783 staticpro (&Vdribble_file);
4786 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
4787 If non-zero, display debug information about Emacs events that XEmacs sees.
4788 Information is displayed on stderr.
4790 Before the event, the source of the event is displayed in parentheses,
4791 and is one of the following:
4793 \(real) A real event from the window system or
4794 terminal driver, as far as XEmacs can tell.
4796 \(keyboard macro) An event generated from a keyboard macro.
4798 \(unread-command-events) An event taken from `unread-command-events'.
4800 \(unread-command-event) An event taken from `unread-command-event'.
4802 \(command event queue) An event taken from an internal queue.
4803 Events end up on this queue when
4804 `enqueue-eval-event' is called or when
4805 user or eval events are received while
4806 XEmacs is blocking (e.g. in `sit-for',
4807 `sleep-for', or `accept-process-output',
4808 or while waiting for the reply to an
4811 \(->keyboard-translate-table) The result of an event translated through
4812 keyboard-translate-table. Note that in
4813 this case, two events are printed even
4814 though only one is really generated.
4816 \(SIGINT) A faked C-g resulting when XEmacs receives
4817 a SIGINT (e.g. C-c was pressed in XEmacs'
4818 controlling terminal or the signal was
4819 explicitly sent to the XEmacs process).
4821 debug_emacs_events = 0;
4824 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
4825 Non-nil inhibits recording of input-events to recent-keys ring.
4827 inhibit_input_event_recording = 0;
4831 complex_vars_of_event_stream (void)
4833 Vkeyboard_translate_table =
4834 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4838 init_event_stream (void)
4842 #ifdef HAVE_UNIXOID_EVENT_LOOP
4843 init_event_unixoid ();
4845 #ifdef HAVE_X_WINDOWS
4846 if (!strcmp (display_use, "x"))
4847 init_event_Xt_late ();
4850 #ifdef HAVE_MS_WINDOWS
4851 if (!strcmp (display_use, "mswindows"))
4852 init_event_mswindows_late ();
4856 /* For TTY's, use the Xt event loop if we can; it allows
4857 us to later open an X connection. */
4858 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
4859 || (defined (HAVE_MSG_SELECT) \
4860 && !defined (DEBUG_TTY_EVENT_STREAM)))
4861 init_event_mswindows_late ();
4862 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
4863 init_event_Xt_late ();
4864 #elif defined (HAVE_TTY)
4865 init_event_tty_late ();
4868 init_interrupts_late ();
4874 useful testcases for v18/v19 compatibility:
4878 (setq unread-command-event (character-to-event ?A (allocate-event)))
4879 (setq x (list (read-char)
4880 ; (read-key-sequence "") ; try it with and without this
4881 last-command-char last-input-char
4882 (recent-keys) (this-command-keys))))
4883 (global-set-key "\^Q" 'foo)
4885 without the read-key-sequence:
4886 ^Q ==> (65 17 65 [... ^Q] [^Q])
4887 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
4888 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
4890 with the read-key-sequence:
4891 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
4892 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
4893 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
4895 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
4897 ;(setq x (list (read-char) quit-flag))^J^G
4898 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
4899 ;for BOTH, x should get set to (7 t), but no result should be printed.
4901 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
4902 ;in *scratch*, type (sit-for 20)^J
4903 ;wait a couple of seconds, move cursor to foo, type "a"
4904 ;a should be inserted in foo. Cursor highlighting should not change in
4907 ;do it with sleep-for. move cursor into foo, then back into *scratch*
4909 ;repeat also with (accept-process-output nil 20)
4911 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
4914 (list (condition-case c
4919 (tst)^Ja^G ==> ((quit) 97) with no signal
4920 (tst)^J^Ga ==> ((quit) 97) with no signal
4921 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
4923 ; with sit-for only do the 2nd test.
4924 ; Do all 3 tests with (accept-process-output nil 20)
4927 (setq enable-recursive-minibuffers t
4928 minibuffer-max-depth nil)
4929 ESC ESC ESC ESC - there are now two minibuffers active
4930 C-g C-g C-g - there should be active 0, not 1
4932 C-x C-f ~ / ? - wait for "Making completion list..." to display
4933 C-g - wait for "Quit" to display
4934 C-g - minibuffer should not be active
4935 however C-g before "Quit" is displayed should leave minibuffer active.
4937 ;do it all in both v18 and v19 and make sure all results are the same.
4938 ;all of these cases matter a lot, but some in quite subtle ways.
4942 Additional test cases for accept-process-output, sleep-for, sit-for.
4943 Be sure you do all of the above checking for C-g and focus, too!
4945 ; Make sure that timer handlers are run during, not after sit-for:
4946 (defun timer-check ()
4947 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
4949 (message "after sit-for"))
4951 ; The first message should appear after 2 seconds, and the final message
4952 ; 3 seconds after that.
4953 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
4957 ; Make sure that process filters are run during, not after sit-for.
4959 (message "sit-for = %s" (sit-for 30)))
4960 (add-hook 'post-command-hook 'fubar)
4962 ; Now type M-x shell RET
4963 ; wait for the shell prompt then send: ls RET
4964 ; the output of ls should fill immediately, and not wait 30 seconds.
4966 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
4970 ; Make sure that recursive invocations return immediately:
4971 (defmacro test-diff-time (start end)
4972 `(+ (* (- (car ,end) (car ,start)) 65536.0)
4973 (- (cadr ,end) (cadr ,start))
4974 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
4976 (defun testee (ignore)
4980 (let ((start (current-time))
4982 (add-timeout 2 'testee nil)
4984 (add-timeout 2 'testee nil)
4986 (add-timeout 2 'testee nil)
4987 (accept-process-output nil 5)
4988 (setq end (current-time))
4989 (test-diff-time start end)))
4991 (test-them) should sit for 15 seconds.
4992 Repeat with testee set to sleep-for and accept-process-output.
4993 These should each delay 36 seconds.