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 The command builder should deal only with key and button events.
56 Other command events should be able to come in the MIDDLE of a key
57 sequence, without disturbing the key sequence composition, or the
58 command builder structure representing it.
60 Someone should rethink universal-argument and figure out how an
61 arbitrary command can influence the next command (universal-argument
62 or universal-coding-system-argument) or the next key (hyperify).
64 Both C-h and Help in the middle of a key sequence should trigger
65 prefix-help-command. help-char is stupid. Maybe we need
66 keymap-of-last-resort?
68 After prefix-help is run, one should be able to CONTINUE TYPING,
69 instead of RETYPING, the key sequence.
75 #include "blocktype.h"
82 #include "insdel.h" /* for buffer_reset_changes */
85 #include "macros.h" /* for defining_keyboard_macro */
86 #include "menubar.h" /* #### for evil kludges. */
90 #include "sysdep.h" /* init_poll_for_quit() */
91 #include "syssignal.h" /* SIGCHLD, etc. */
93 #include "systime.h" /* to set Vlast_input_time */
95 #include "events-mod.h"
97 #include "file-coding.h"
102 /* The number of keystrokes between auto-saves. */
103 static Fixnum auto_save_interval;
105 Lisp_Object Qundefined_keystroke_sequence;
107 Lisp_Object Qcommand_event_p;
109 /* Hooks to run before and after each command. */
110 Lisp_Object Vpre_command_hook, Vpost_command_hook;
111 Lisp_Object Qpre_command_hook, Qpost_command_hook;
114 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
116 /* Hook run when XEmacs is about to be idle. */
117 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
119 /* Control gratuitous keyboard focus throwing. */
120 int focus_follows_mouse;
122 /* When true, modifier keys are sticky. */
123 int modifier_keys_are_sticky;
124 /* Modifier keys are sticky for this many milliseconds. */
125 Lisp_Object Vmodifier_keys_sticky_time;
127 /* Here FSF Emacs 20.7 defines Vpost_command_idle_hook,
128 post_command_idle_delay, Vdeferred_action_list, and
129 Vdeferred_action_function, but we don't because that stuff is crap,
130 and we're smarter than them, and their momas are fat. */
132 /* FSF Emacs 20.7 also defines Vinput_method_function,
133 Qinput_method_exit_on_first_char and Qinput_method_use_echo_area.
134 I don't know this should be imported or not. */
136 /* Non-nil disable property on a command means
137 do not execute it; call disabled-command-hook's value instead. */
138 Lisp_Object Qdisabled, Vdisabled_command_hook;
140 EXFUN (Fnext_command_event, 2);
142 static void pre_command_hook (void);
143 static void post_command_hook (void);
145 /* Last keyboard or mouse input event read as a command. */
146 Lisp_Object Vlast_command_event;
148 /* The nearest ASCII equivalent of the above. */
149 Lisp_Object Vlast_command_char;
151 /* Last keyboard or mouse event read for any purpose. */
152 Lisp_Object Vlast_input_event;
154 /* The nearest ASCII equivalent of the above. */
155 Lisp_Object Vlast_input_char;
157 Lisp_Object Vcurrent_mouse_event;
159 /* This is fbound in cmdloop.el, see the commentary there */
160 Lisp_Object Qcancel_mode_internal;
162 /* If not Qnil, event objects to be read as the next command input */
163 Lisp_Object Vunread_command_events;
164 Lisp_Object Vunread_command_event; /* obsoleteness support */
166 static Lisp_Object Qunread_command_events, Qunread_command_event;
168 /* Previous command, represented by a Lisp object.
169 Does not include prefix commands and arg setting commands. */
170 Lisp_Object Vlast_command;
172 /* Contents of this-command-properties for the last command. */
173 Lisp_Object Vlast_command_properties;
175 /* If a command sets this, the value goes into
176 last-command for the next command. */
177 Lisp_Object Vthis_command;
179 /* If a command sets this, the value goes into
180 last-command-properties for the next command. */
181 Lisp_Object Vthis_command_properties;
183 /* The value of point when the last command was executed. */
184 Bufpos last_point_position;
186 /* The frame that was current when the last command was started. */
187 Lisp_Object Vlast_selected_frame;
189 /* The buffer that was current when the last command was started. */
190 Lisp_Object last_point_position_buffer;
192 /* A (16bit . 16bit) representation of the time of the last-command-event. */
193 Lisp_Object Vlast_input_time;
195 /* A (16bit 16bit usec) representation of the time
196 of the last-command-event. */
197 Lisp_Object Vlast_command_event_time;
199 /* Character to recognize as the help char. */
200 Lisp_Object Vhelp_char;
202 /* Form to execute when help char is typed. */
203 Lisp_Object Vhelp_form;
205 /* Command to run when the help character follows a prefix key. */
206 Lisp_Object Vprefix_help_command;
208 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
209 may have happened. */
210 volatile int something_happened;
212 /* Hash table to translate keysyms through */
213 Lisp_Object Vkeyboard_translate_table;
215 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
216 Lisp_Object Vretry_undefined_key_binding_unshifted;
217 Lisp_Object Qretry_undefined_key_binding_unshifted;
220 /* If composed input is undefined, use self-insert-char */
221 Lisp_Object Vcomposed_character_default_binding;
222 #endif /* HAVE_XIM */
224 /* Console that corresponds to our controlling terminal */
225 Lisp_Object Vcontrolling_terminal;
227 /* An event (actually an event chain linked through event_next) or Qnil.
229 Lisp_Object Vthis_command_keys;
230 Lisp_Object Vthis_command_keys_tail;
233 Lisp_Object Qauto_show_make_point_visible;
235 /* File in which we write all commands we read; an lstream */
236 static Lisp_Object Vdribble_file;
238 /* Recent keys ring location; a vector of events or nil-s */
239 Lisp_Object Vrecent_keys_ring;
240 int recent_keys_ring_size;
241 int recent_keys_ring_index;
243 /* Boolean specifying whether keystrokes should be added to
245 int inhibit_input_event_recording;
247 Lisp_Object Qself_insert_defer_undo;
249 /* this is in keymap.c */
250 extern Lisp_Object Fmake_keymap (Lisp_Object name);
253 Fixnum debug_emacs_events;
256 external_debugging_print_event (char *event_description, Lisp_Object event)
258 write_c_string ("(", Qexternal_debugging_output);
259 write_c_string (event_description, Qexternal_debugging_output);
260 write_c_string (") ", Qexternal_debugging_output);
261 print_internal (event, Qexternal_debugging_output, 1);
262 write_c_string ("\n", Qexternal_debugging_output);
264 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
265 if (debug_emacs_events) \
266 external_debugging_print_event (event_description, event); \
269 #define DEBUG_PRINT_EMACS_EVENT(string, event)
273 /* The callback routines for the window system or terminal driver */
274 struct event_stream *event_stream;
276 static void echo_key_event (struct command_builder *, Lisp_Object event);
277 static void maybe_kbd_translate (Lisp_Object event);
279 /* This structure is basically a typeahead queue: things like
280 wait-reading-process-output will delay the execution of
281 keyboard and mouse events by pushing them here.
283 Chained through event_next()
284 command_event_queue_tail is a pointer to the last-added element.
286 static Lisp_Object command_event_queue;
287 static Lisp_Object command_event_queue_tail;
289 /* Nonzero means echo unfinished commands after this many seconds of pause. */
290 static Lisp_Object Vecho_keystrokes;
292 /* The number of keystrokes since the last auto-save. */
293 static int keystrokes_since_auto_save;
295 /* Used by the C-g signal handler so that it will never "hard quit"
296 when waiting for an event. Otherwise holding down C-g could
297 cause a suspension back to the shell, which is generally
298 undesirable. (#### This doesn't fully work.) */
300 int emacs_is_blocking;
302 /* Handlers which run during sit-for, sleep-for and accept-process-output
303 are not allowed to recursively call these routines. We record here
304 if we are in that situation. */
306 static Lisp_Object recursive_sit_for;
310 /**********************************************************************/
311 /* Command-builder object */
312 /**********************************************************************/
314 #define XCOMMAND_BUILDER(x) \
315 XRECORD (x, command_builder, struct command_builder)
316 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
317 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
318 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
321 mark_command_builder (Lisp_Object obj)
323 struct command_builder *builder = XCOMMAND_BUILDER (obj);
324 mark_object (builder->prefix_events);
325 mark_object (builder->current_events);
326 mark_object (builder->most_current_event);
327 mark_object (builder->last_non_munged_event);
328 mark_object (builder->munge_me[0].first_mungeable_event);
329 mark_object (builder->munge_me[1].first_mungeable_event);
330 return builder->console;
334 finalize_command_builder (void *header, int for_disksave)
338 xfree (((struct command_builder *) header)->echo_buf);
339 ((struct command_builder *) header)->echo_buf = 0;
343 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
344 mark_command_builder, internal_object_printer,
345 finalize_command_builder, 0, 0, 0,
346 struct command_builder);
349 reset_command_builder_event_chain (struct command_builder *builder)
351 builder->prefix_events = Qnil;
352 builder->current_events = Qnil;
353 builder->most_current_event = Qnil;
354 builder->last_non_munged_event = Qnil;
355 builder->munge_me[0].first_mungeable_event = Qnil;
356 builder->munge_me[1].first_mungeable_event = Qnil;
360 allocate_command_builder (Lisp_Object console)
362 Lisp_Object builder_obj;
363 struct command_builder *builder =
364 alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
366 builder->console = console;
367 reset_command_builder_event_chain (builder);
368 builder->echo_buf_length = 300; /* #### Kludge */
369 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
370 builder->echo_buf[0] = 0;
371 builder->echo_buf_index = -1;
372 builder->echo_buf_index = -1;
373 builder->self_insert_countdown = 0;
375 XSETCOMMAND_BUILDER (builder_obj, builder);
380 command_builder_append_event (struct command_builder *builder,
383 assert (EVENTP (event));
385 if (EVENTP (builder->most_current_event))
386 XSET_EVENT_NEXT (builder->most_current_event, event);
388 builder->current_events = event;
390 builder->most_current_event = event;
391 if (NILP (builder->munge_me[0].first_mungeable_event))
392 builder->munge_me[0].first_mungeable_event = event;
393 if (NILP (builder->munge_me[1].first_mungeable_event))
394 builder->munge_me[1].first_mungeable_event = event;
398 /**********************************************************************/
399 /* Low-level interfaces onto event methods */
400 /**********************************************************************/
402 enum event_stream_operation
404 EVENT_STREAM_PROCESS,
405 EVENT_STREAM_TIMEOUT,
406 EVENT_STREAM_CONSOLE,
411 check_event_stream_ok (enum event_stream_operation op)
413 if (!event_stream && noninteractive)
417 case EVENT_STREAM_PROCESS:
418 error ("Can't start subprocesses in -batch mode");
419 case EVENT_STREAM_TIMEOUT:
420 error ("Can't add timeouts in -batch mode");
421 case EVENT_STREAM_CONSOLE:
422 error ("Can't add consoles in -batch mode");
423 case EVENT_STREAM_READ:
424 error ("Can't read events in -batch mode");
429 else if (!event_stream)
431 error ("event-stream callbacks not initialized (internal error?)");
436 event_stream_event_pending_p (int user)
438 return event_stream && event_stream->event_pending_p (user);
442 event_stream_force_event_pending (struct frame* f)
444 if (event_stream->force_event_pending)
445 event_stream->force_event_pending (f);
449 maybe_read_quit_event (Lisp_Event *event)
451 /* A C-g that came from `sigint_happened' will always come from the
452 controlling terminal. If that doesn't exist, however, then the
453 user manually sent us a SIGINT, and we pretend the C-g came from
454 the selected console. */
457 if (CONSOLEP (Vcontrolling_terminal) &&
458 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
459 con = XCONSOLE (Vcontrolling_terminal);
461 con = XCONSOLE (Fselected_console ());
465 int ch = CONSOLE_QUIT_CHAR (con);
468 character_to_event (ch, event, con, 1, 1);
469 event->channel = make_console (con);
476 event_stream_next_event (Lisp_Event *event)
478 Lisp_Object event_obj;
480 check_event_stream_ok (EVENT_STREAM_READ);
482 XSETEVENT (event_obj, event);
484 /* If C-g was pressed, treat it as a character to be read.
485 Note that if C-g was pressed while we were blocking,
486 the SIGINT signal handler will be called. It will
487 set Vquit_flag and write a byte on our "fake pipe",
488 which will unblock us. */
489 if (maybe_read_quit_event (event))
491 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
495 /* If a longjmp() happens in the callback, we're screwed.
496 Let's hope it doesn't. I think the code here is fairly
497 clean and doesn't do this. */
498 emacs_is_blocking = 1;
499 event_stream->next_event_cb (event);
500 emacs_is_blocking = 0;
503 /* timeout events have more info set later, so
504 print the event out in next_event_internal(). */
505 if (event->event_type != timeout_event)
506 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
508 maybe_kbd_translate (event_obj);
512 event_stream_handle_magic_event (Lisp_Event *event)
514 check_event_stream_ok (EVENT_STREAM_READ);
515 event_stream->handle_magic_event_cb (event);
519 event_stream_add_timeout (EMACS_TIME timeout)
521 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
522 return event_stream->add_timeout_cb (timeout);
526 event_stream_remove_timeout (int id)
528 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
529 event_stream->remove_timeout_cb (id);
533 event_stream_select_console (struct console *con)
535 check_event_stream_ok (EVENT_STREAM_CONSOLE);
536 if (!con->input_enabled)
538 event_stream->select_console_cb (con);
539 con->input_enabled = 1;
544 event_stream_unselect_console (struct console *con)
546 check_event_stream_ok (EVENT_STREAM_CONSOLE);
547 if (con->input_enabled)
549 event_stream->unselect_console_cb (con);
550 con->input_enabled = 0;
555 event_stream_select_process (Lisp_Process *proc)
557 check_event_stream_ok (EVENT_STREAM_PROCESS);
558 if (!get_process_selected_p (proc))
560 event_stream->select_process_cb (proc);
561 set_process_selected_p (proc, 1);
566 event_stream_unselect_process (Lisp_Process *proc)
568 check_event_stream_ok (EVENT_STREAM_PROCESS);
569 if (get_process_selected_p (proc))
571 event_stream->unselect_process_cb (proc);
572 set_process_selected_p (proc, 0);
577 event_stream_create_stream_pair (void* inhandle, void* outhandle,
578 Lisp_Object* instream, Lisp_Object* outstream, int flags)
580 check_event_stream_ok (EVENT_STREAM_PROCESS);
581 return event_stream->create_stream_pair_cb
582 (inhandle, outhandle, instream, outstream, flags);
586 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
588 check_event_stream_ok (EVENT_STREAM_PROCESS);
589 return event_stream->delete_stream_pair_cb (instream, outstream);
593 event_stream_quit_p (void)
596 event_stream->quit_p_cb ();
600 event_stream_current_event_timestamp (struct console *c)
602 if (event_stream && event_stream->current_event_timestamp_cb)
603 return event_stream->current_event_timestamp_cb (c);
609 /**********************************************************************/
610 /* Character prompting */
611 /**********************************************************************/
614 echo_key_event (struct command_builder *command_builder,
617 /* This function can GC */
619 Bytecount buf_index = command_builder->echo_buf_index;
625 buf_index = 0; /* We're echoing now */
626 clear_echo_area (selected_frame (), Qnil, 0);
629 format_event_object (buf, XEVENT (event), 1);
632 if (len + buf_index + 4 > command_builder->echo_buf_length)
634 e = command_builder->echo_buf + buf_index;
635 memcpy (e, buf, len);
643 command_builder->echo_buf_index = buf_index + len + 1;
647 regenerate_echo_keys_from_this_command_keys (struct command_builder *
652 builder->echo_buf_index = 0;
654 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
655 echo_key_event (builder, event);
659 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
661 /* This function can GC */
662 double echo_keystrokes;
663 struct frame *f = selected_frame ();
664 /* Message turns off echoing unless more keystrokes turn it on again. */
665 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
668 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
669 echo_keystrokes = extract_float (Vecho_keystrokes);
673 if (minibuf_level == 0
674 && echo_keystrokes > 0.0
675 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
676 && !x_kludge_lw_menu_active ()
682 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
683 doesn't work. See check_quit. */
684 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
685 /* input came in, so don't echo. */
689 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
690 /* not echo_buf_index. That doesn't include
691 the terminating " - ". */
692 strlen ((char *) command_builder->echo_buf),
698 reset_key_echo (struct command_builder *command_builder,
699 int remove_echo_area_echo)
701 /* This function can GC */
702 struct frame *f = selected_frame ();
704 command_builder->echo_buf_index = -1;
706 if (remove_echo_area_echo)
707 clear_echo_area (f, Qcommand, 0);
711 /**********************************************************************/
713 /**********************************************************************/
716 maybe_kbd_translate (Lisp_Object event)
719 int did_translate = 0;
721 if (XEVENT_TYPE (event) != key_press_event)
723 if (!HASH_TABLEP (Vkeyboard_translate_table))
725 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
728 c = event_to_character (XEVENT (event), 0, 0, 0);
731 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
733 if (!NILP (traduit) && SYMBOLP (traduit))
735 XEVENT (event)->event.key.keysym = traduit;
736 XEVENT (event)->event.key.modifiers = 0;
739 else if (CHARP (traduit))
743 /* This used to call Fcharacter_to_event() directly into EVENT,
744 but that can eradicate timestamps and other such stuff.
745 This way is safer. */
747 character_to_event (XCHAR (traduit), &ev2,
748 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
749 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
750 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
757 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
758 Vkeyboard_translate_table, Qnil);
759 if (!NILP (traduit) && SYMBOLP (traduit))
761 XEVENT (event)->event.key.keysym = traduit;
764 else if (CHARP (traduit))
769 character_to_event (XCHAR (traduit), &ev2,
770 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
771 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
772 XEVENT (event)->event.key.modifiers |= ev2.event.key.modifiers;
779 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
783 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
784 keystrokes_since_auto_save is equivalent to the difference between
785 num_nonmacro_input_chars and last_auto_save. */
787 /* When an auto-save happens, record the number of keystrokes, and
788 don't do again soon. */
791 record_auto_save (void)
793 keystrokes_since_auto_save = 0;
796 /* Make an auto save happen as soon as possible at command level. */
799 force_auto_save_soon (void)
801 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
805 maybe_do_auto_save (void)
807 /* This function can call lisp */
808 keystrokes_since_auto_save++;
809 if (auto_save_interval > 0 &&
810 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
811 !detect_input_pending ())
813 Fdo_auto_save (Qnil, Qnil);
819 print_help (Lisp_Object object)
821 Fprinc (object, Qnil);
826 execute_help_form (struct command_builder *command_builder,
829 /* This function can GC */
830 Lisp_Object help = Qnil;
831 int speccount = specpdl_depth ();
832 Bytecount buf_index = command_builder->echo_buf_index;
833 Lisp_Object echo = ((buf_index <= 0)
835 : make_string (command_builder->echo_buf,
837 struct gcpro gcpro1, gcpro2;
840 record_unwind_protect (save_window_excursion_unwind,
841 Fcurrent_window_configuration (Qnil));
842 reset_key_echo (command_builder, 1);
844 help = Feval (Vhelp_form);
846 internal_with_output_to_temp_buffer (build_string ("*Help*"),
847 print_help, help, Qnil);
848 Fnext_command_event (event, Qnil);
849 /* Remove the help from the frame */
850 unbind_to (speccount, Qnil);
851 /* Hmmmm. Tricky. The unbind restores an old window configuration,
852 apparently bypassing any setting of windows_structure_changed.
853 So we need to set it so that things get redrawn properly. */
854 /* #### This is massive overkill. Look at doing it better once the
855 new redisplay is fully in place. */
857 Lisp_Object frmcons, devcons, concons;
858 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
860 struct frame *f = XFRAME (XCAR (frmcons));
861 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
866 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
868 /* Discard next key if it is a space */
869 reset_key_echo (command_builder, 1);
870 Fnext_command_event (event, Qnil);
873 command_builder->echo_buf_index = buf_index;
875 memcpy (command_builder->echo_buf,
876 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
881 /**********************************************************************/
883 /**********************************************************************/
886 detect_input_pending (void)
888 /* Always call the event_pending_p hook even if there's an unread
889 character, because that might do some needed ^G detection (on
890 systems without SIGIO, for example).
892 if (event_stream_event_pending_p (1))
894 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
896 if (!NILP (command_event_queue))
900 EVENT_CHAIN_LOOP (event, command_event_queue)
902 if (XEVENT_TYPE (event) != eval_event
903 && XEVENT_TYPE (event) != magic_eval_event)
910 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
911 Return t if command input is currently available with no waiting.
912 Actually, the value is nil only if we can be sure that no input is available.
916 return detect_input_pending () ? Qt : Qnil;
920 /**********************************************************************/
922 /**********************************************************************/
924 /**** Low-level timeout functions. ****
926 These functions maintain a sorted list of one-shot timeouts (where
927 the timeouts are in absolute time). They are intended for use by
928 functions that need to convert a list of absolute timeouts into a
929 series of intervals to wait for. */
931 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
932 used to indicate an absence of a timer. */
933 static int low_level_timeout_id_tick;
935 static struct low_level_timeout_blocktype
937 Blocktype_declare (struct low_level_timeout);
938 } *the_low_level_timeout_blocktype;
940 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
941 a unique ID identifying the timeout. */
944 add_low_level_timeout (struct low_level_timeout **timeout_list,
947 struct low_level_timeout *tm;
948 struct low_level_timeout *t, **tt;
950 /* Allocate a new time struct. */
952 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
954 if (low_level_timeout_id_tick == 0)
955 low_level_timeout_id_tick++;
956 tm->id = low_level_timeout_id_tick++;
959 /* Add it to the queue. */
963 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
974 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
975 If the timeout is not there, do nothing. */
978 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
980 struct low_level_timeout *t, *prev;
984 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
988 return; /* couldn't find it */
991 *timeout_list = t->next;
992 else prev->next = t->next;
994 Blocktype_free (the_low_level_timeout_blocktype, t);
997 /* If there are timeouts on TIMEOUT_LIST, store the relative time
998 interval to the first timeout on the list into INTERVAL and
999 return 1. Otherwise, return 0. */
1002 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
1003 EMACS_TIME *interval)
1005 if (!timeout_list) /* no timer events; block indefinitely */
1009 EMACS_TIME current_time;
1011 /* The time to block is the difference between the first
1012 (earliest) timer on the queue and the current time.
1013 If that is negative, then the timer will fire immediately
1014 but we still have to call select(), with a zero-valued
1015 timeout: user events must have precedence over timer events. */
1016 EMACS_GET_TIME (current_time);
1017 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1018 EMACS_SUB_TIME (*interval, timeout_list->time,
1021 EMACS_SET_SECS_USECS (*interval, 0, 0);
1026 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1027 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1028 timeout into TIME_OUT. */
1031 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1032 EMACS_TIME *time_out)
1034 struct low_level_timeout *tm = *timeout_list;
1040 *time_out = tm->time;
1041 *timeout_list = tm->next;
1042 Blocktype_free (the_low_level_timeout_blocktype, tm);
1047 /**** High-level timeout functions. ****/
1049 static int timeout_id_tick;
1051 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1053 static Lisp_Object Vtimeout_free_list;
1056 mark_timeout (Lisp_Object obj)
1058 Lisp_Timeout *tm = XTIMEOUT (obj);
1059 mark_object (tm->function);
1063 /* Should never, ever be called. (except by an external debugger) */
1065 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1067 const Lisp_Timeout *t = XTIMEOUT (obj);
1070 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
1072 write_c_string (buf, printcharfun);
1075 static const struct lrecord_description timeout_description[] = {
1076 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1077 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1081 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
1082 mark_timeout, print_timeout,
1083 0, 0, 0, timeout_description, Lisp_Timeout);
1085 /* Generate a timeout and return its ID. */
1088 event_stream_generate_wakeup (unsigned int milliseconds,
1089 unsigned int vanilliseconds,
1090 Lisp_Object function, Lisp_Object object,
1093 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
1094 Lisp_Timeout *timeout = XTIMEOUT (op);
1095 EMACS_TIME current_time;
1096 EMACS_TIME interval;
1098 timeout->id = timeout_id_tick++;
1099 timeout->resignal_msecs = vanilliseconds;
1100 timeout->function = function;
1101 timeout->object = object;
1103 EMACS_GET_TIME (current_time);
1104 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1105 1000 * (milliseconds % 1000));
1106 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1110 timeout->interval_id =
1111 event_stream_add_async_timeout (timeout->next_signal_time);
1112 pending_async_timeout_list = noseeum_cons (op,
1113 pending_async_timeout_list);
1117 timeout->interval_id =
1118 event_stream_add_timeout (timeout->next_signal_time);
1119 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
1124 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1125 as necessary and return the timeout's ID and function and object slots.
1127 This should be called as a result of receiving notice that a timeout
1128 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1129 identifies this particular firing of the timeout. INTERVAL-ID's and
1130 timeout ID's are in separate number spaces and bear no relation to
1131 each other. The INTERVAL-ID is all that the event callback routines
1132 work with: they work only with one-shot intervals, not with timeouts
1133 that may fire repeatedly.
1135 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1139 event_stream_resignal_wakeup (int interval_id, int async_p,
1140 Lisp_Object *function, Lisp_Object *object)
1142 Lisp_Object op = Qnil, rest;
1143 Lisp_Timeout *timeout;
1144 Lisp_Object *timeout_list;
1145 struct gcpro gcpro1;
1148 GCPRO1 (op); /* just in case ... because it's removed from the list
1151 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1153 /* Find the timeout on the list of pending ones. */
1154 LIST_LOOP (rest, *timeout_list)
1156 timeout = XTIMEOUT (XCAR (rest));
1157 if (timeout->interval_id == interval_id)
1161 assert (!NILP (rest));
1163 timeout = XTIMEOUT (op);
1164 /* We make sure to snarf the data out of the timeout object before
1165 we free it with free_managed_lcrecord(). */
1167 *function = timeout->function;
1168 *object = timeout->object;
1170 /* Remove this one from the list of pending timeouts */
1171 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1173 /* If this timeout wants to be resignalled, do it now. */
1174 if (timeout->resignal_msecs)
1176 EMACS_TIME current_time;
1177 EMACS_TIME interval;
1179 /* Determine the time that the next resignalling should occur.
1180 We do that by adding the interval time to the last signalled
1181 time until we get a time that's current.
1183 (This way, it doesn't matter if the timeout was signalled
1184 exactly when we asked for it, or at some time later.)
1186 EMACS_GET_TIME (current_time);
1187 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
1188 1000 * (timeout->resignal_msecs % 1000));
1191 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1193 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1196 timeout->interval_id =
1197 event_stream_add_async_timeout (timeout->next_signal_time);
1199 timeout->interval_id =
1200 event_stream_add_timeout (timeout->next_signal_time);
1201 /* Add back onto the list. Note that the effect of this
1202 is to move frequently-hit timeouts to the front of the
1203 list, which is a good thing. */
1204 *timeout_list = noseeum_cons (op, *timeout_list);
1207 free_managed_lcrecord (Vtimeout_free_list, op);
1214 event_stream_disable_wakeup (int id, int async_p)
1216 Lisp_Timeout *timeout = 0;
1218 Lisp_Object *timeout_list;
1221 timeout_list = &pending_async_timeout_list;
1223 timeout_list = &pending_timeout_list;
1225 /* Find the timeout on the list of pending ones, if it's still there. */
1226 LIST_LOOP (rest, *timeout_list)
1228 timeout = XTIMEOUT (XCAR (rest));
1229 if (timeout->id == id)
1233 /* If we found it, remove it from the list and disable the pending
1237 Lisp_Object op = XCAR (rest);
1239 delq_no_quit_and_free_cons (op, *timeout_list);
1241 event_stream_remove_async_timeout (timeout->interval_id);
1243 event_stream_remove_timeout (timeout->interval_id);
1244 free_managed_lcrecord (Vtimeout_free_list, op);
1249 event_stream_wakeup_pending_p (int id, int async_p)
1251 Lisp_Timeout *timeout;
1253 Lisp_Object timeout_list;
1258 timeout_list = pending_async_timeout_list;
1260 timeout_list = pending_timeout_list;
1262 /* Find the element on the list of pending ones, if it's still there. */
1263 LIST_LOOP (rest, timeout_list)
1265 timeout = XTIMEOUT (XCAR (rest));
1266 if (timeout->id == id)
1277 /**** Asynch. timeout functions (see also signal.c) ****/
1279 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1280 extern int poll_for_quit_id;
1283 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1284 extern int poll_for_sigchld_id;
1288 event_stream_deal_with_async_timeout (int interval_id)
1290 /* This function can GC */
1291 Lisp_Object humpty, dumpty;
1292 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1293 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1296 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1298 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1299 if (id == poll_for_quit_id)
1301 quit_check_signal_happened = 1;
1302 quit_check_signal_tick_count++;
1307 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1308 if (id == poll_for_sigchld_id)
1310 kick_status_notify ();
1315 /* call1 GC-protects its arguments */
1316 call1_trapping_errors ("Error in asynchronous timeout callback",
1321 /**** Lisp-level timeout functions. ****/
1323 static unsigned long
1324 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1326 #ifdef LISP_FLOAT_TYPE
1328 CHECK_INT_OR_FLOAT (secs);
1329 fsecs = XFLOATINT (secs);
1333 fsecs = XINT (secs);
1336 signal_simple_error ("timeout is negative", secs);
1337 if (!allow_0 && fsecs == 0)
1338 signal_simple_error ("timeout is non-positive", secs);
1339 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1341 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1343 return (unsigned long) (1000 * fsecs);
1346 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1347 Add a timeout, to be signaled after the timeout period has elapsed.
1348 SECS is a number of seconds, expressed as an integer or a float.
1349 FUNCTION will be called after that many seconds have elapsed, with one
1350 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1351 then after this timeout expires, `add-timeout' will automatically be called
1352 again with RESIGNAL as the first argument.
1354 This function returns an object which is the id number of this particular
1355 timeout. You can pass that object to `disable-timeout' to turn off the
1356 timeout before it has been signalled.
1358 NOTE: Id numbers as returned by this function are in a distinct namespace
1359 from those returned by `add-async-timeout'. This means that the same id
1360 number could refer to a pending synchronous timeout and a different pending
1361 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1362 to `disable-async-timeout', or vice-versa.
1364 The number of seconds may be expressed as a floating-point number, in which
1365 case some fractional part of a second will be used. Caveat: the usable
1366 timeout granularity will vary from system to system.
1368 Adding a timeout causes a timeout event to be returned by `next-event', and
1369 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1370 loop, the function will not be invoked until the next call to sit-for or
1371 until the return to top-level (the same is true of process filters).
1373 If you need to have a timeout executed even when XEmacs is in the midst of
1374 running Lisp code, use `add-async-timeout'.
1376 WARNING: if you are thinking of calling add-timeout from inside of a
1377 callback function as a way of resignalling a timeout, think again. There
1378 is a race condition. That's why the RESIGNAL argument exists.
1380 (secs, function, object, resignal))
1382 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1383 unsigned long msecs2 = (NILP (resignal) ? 0 :
1384 lisp_number_to_milliseconds (resignal, 0));
1387 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1388 lid = make_int (id);
1389 if (id != XINT (lid)) abort ();
1393 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1394 Disable a timeout from signalling any more.
1395 ID should be a timeout id number as returned by `add-timeout'. If ID
1396 corresponds to a one-shot timeout that has already signalled, nothing
1399 It will not work to call this function on an id number returned by
1400 `add-async-timeout'. Use `disable-async-timeout' for that.
1405 event_stream_disable_wakeup (XINT (id), 0);
1409 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1410 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1411 SECS is a number of seconds, expressed as an integer or a float.
1412 FUNCTION will be called after that many seconds have elapsed, with one
1413 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1414 then after this timeout expires, `add-async-timeout' will automatically be
1415 called again with RESIGNAL as the first argument.
1417 This function returns an object which is the id number of this particular
1418 timeout. You can pass that object to `disable-async-timeout' to turn off
1419 the timeout before it has been signalled.
1421 NOTE: Id numbers as returned by this function are in a distinct namespace
1422 from those returned by `add-timeout'. This means that the same id number
1423 could refer to a pending synchronous timeout and a different pending
1424 asynchronous timeout, and that you cannot pass an id from
1425 `add-async-timeout' to `disable-timeout', or vice-versa.
1427 The number of seconds may be expressed as a floating-point number, in which
1428 case some fractional part of a second will be used. Caveat: the usable
1429 timeout granularity will vary from system to system.
1431 Adding an asynchronous timeout causes the function to be invoked as soon
1432 as the timeout occurs, even if XEmacs is in the midst of executing some
1433 other code. (This is unlike the synchronous timeouts added with
1434 `add-timeout', where the timeout will only be signalled when XEmacs is
1435 waiting for events, i.e. the next return to top-level or invocation of
1436 `sit-for' or related functions.) This means that the function that is
1437 called *must* not signal an error or change any global state (e.g. switch
1438 buffers or windows) except when locking code is in place to make sure
1439 that race conditions don't occur in the interaction between the
1440 asynchronous timeout function and other code.
1442 Under most circumstances, you should use `add-timeout' instead, as it is
1443 much safer. Asynchronous timeouts should only be used when such behavior
1444 is really necessary.
1446 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1447 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1448 asynchronous timeouts will get called immediately. (Multiple occurrences
1449 of the same asynchronous timeout are not queued, however.) While the
1450 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1451 is automatically bound to non-nil, and thus other asynchronous timeouts
1452 will be blocked unless the callback function explicitly sets `inhibit-quit'
1455 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1456 callback function as a way of resignalling a timeout, think again. There
1457 is a race condition. That's why the RESIGNAL argument exists.
1459 (secs, function, object, resignal))
1461 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1462 unsigned long msecs2 = (NILP (resignal) ? 0 :
1463 lisp_number_to_milliseconds (resignal, 0));
1466 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1467 lid = make_int (id);
1468 if (id != XINT (lid)) abort ();
1472 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1473 Disable an asynchronous timeout from signalling any more.
1474 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1475 corresponds to a one-shot timeout that has already signalled, nothing
1478 It will not work to call this function on an id number returned by
1479 `add-timeout'. Use `disable-timeout' for that.
1484 event_stream_disable_wakeup (XINT (id), 1);
1489 /**********************************************************************/
1490 /* enqueuing and dequeuing events */
1491 /**********************************************************************/
1493 /* Add an event to the back of the command-event queue: it will be the next
1494 event read after all pending events. This only works on keyboard,
1495 mouse-click, misc-user, and eval events.
1498 enqueue_command_event (Lisp_Object event)
1500 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1504 dequeue_command_event (void)
1506 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1509 /* put the event on the typeahead queue, unless
1510 the event is the quit char, in which case the `QUIT'
1511 which will occur on the next trip through this loop is
1512 all the processing we should do - leaving it on the queue
1513 would cause the quit to be processed twice.
1516 enqueue_command_event_1 (Lisp_Object event_to_copy)
1518 /* do not call check_quit() here. Vquit_flag was set in
1519 next_event_internal. */
1520 if (NILP (Vquit_flag))
1521 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1525 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1527 Lisp_Object event = Fmake_event (Qnil, Qnil);
1529 XEVENT (event)->event_type = magic_eval_event;
1530 /* channel for magic_eval events is nil */
1531 XEVENT (event)->event.magic_eval.internal_function = fun;
1532 XEVENT (event)->event.magic_eval.object = object;
1533 enqueue_command_event (event);
1536 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1537 Add an eval event to the back of the eval event queue.
1538 When this event is dispatched, FUNCTION (which should be a function
1539 of one argument) will be called with OBJECT as its argument.
1540 See `next-event' for a description of event types and how events
1545 Lisp_Object event = Fmake_event (Qnil, Qnil);
1547 XEVENT (event)->event_type = eval_event;
1548 /* channel for eval events is nil */
1549 XEVENT (event)->event.eval.function = function;
1550 XEVENT (event)->event.eval.object = object;
1551 enqueue_command_event (event);
1557 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1560 Lisp_Object event = Fmake_event (Qnil, Qnil);
1562 XEVENT (event)->event_type = misc_user_event;
1563 XEVENT (event)->channel = channel;
1564 XEVENT (event)->event.misc.function = function;
1565 XEVENT (event)->event.misc.object = object;
1566 XEVENT (event)->event.misc.button = 0;
1567 XEVENT (event)->event.misc.modifiers = 0;
1568 XEVENT (event)->event.misc.x = -1;
1569 XEVENT (event)->event.misc.y = -1;
1570 enqueue_command_event (event);
1576 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1578 int button, int modifiers, int x, int y)
1580 Lisp_Object event = Fmake_event (Qnil, Qnil);
1582 XEVENT (event)->event_type = misc_user_event;
1583 XEVENT (event)->channel = channel;
1584 XEVENT (event)->event.misc.function = function;
1585 XEVENT (event)->event.misc.object = object;
1586 XEVENT (event)->event.misc.button = button;
1587 XEVENT (event)->event.misc.modifiers = modifiers;
1588 XEVENT (event)->event.misc.x = x;
1589 XEVENT (event)->event.misc.y = y;
1590 enqueue_command_event (event);
1596 /**********************************************************************/
1597 /* focus-event handling */
1598 /**********************************************************************/
1602 Ben's capsule lecture on focus:
1604 In FSFmacs `select-frame' never changes the window-manager frame
1605 focus. All it does is change the "selected frame". This is similar
1606 to what happens when we call `select-device' or `select-console'.
1607 Whenever an event comes in (including a keyboard event), its frame is
1608 selected; therefore, evaluating `select-frame' in *scratch* won't
1609 cause any effects because the next received event (in the same frame)
1610 will cause a switch back to the frame displaying *scratch*.
1612 Whenever a focus-change event is received from the window manager, it
1613 generates a `switch-frame' event, which causes the Lisp function
1614 `handle-switch-frame' to get run. This basically just runs
1615 `select-frame' (see below, however).
1617 In FSFmacs, if you want to have an operation run when a frame is
1618 selected, you supply an event binding for `switch-frame' (and then
1619 maybe call `handle-switch-frame', or something ...).
1621 In XEmacs, we *do* change the window-manager frame focus as a result
1622 of `select-frame', but not until the next time an event is received,
1623 so that a function that momentarily changes the selected frame won't
1624 cause WM focus flashing. (#### There's something not quite right here;
1625 this is causing the wrong-cursor-focus problems that you occasionally
1626 see. But the general idea is correct.) This approach is winning for
1627 people who use the explicit-focus model, but is trickier to implement.
1629 We also don't make the `switch-frame' event visible but instead have
1630 `select-frame-hook', which is a better approach.
1632 There is the problem of surrogate minibuffers, where when we enter the
1633 minibuffer, you essentially want to temporarily switch the WM focus to
1634 the frame with the minibuffer, and switch it back when you exit the
1637 FSFmacs solves this with the crockish `redirect-frame-focus', which
1638 says "for keyboard events received from FRAME, act like they're
1639 coming from FOCUS-FRAME". I think what this means is that, when
1640 a keyboard event comes in and the event manager is about to select the
1641 event's frame, if that frame has its focus redirected, the redirected-to
1642 frame is selected instead. That way, if you're in a minibufferless
1643 frame and enter the minibuffer, then all Lisp functions that run see
1644 the selected frame as the minibuffer's frame rather than the minibufferless
1645 frame you came from, so that (e.g.) your typing actually appears in
1646 the minibuffer's frame and things behave sanely.
1648 There's also some weird logic that switches the redirected frame focus
1649 from one frame to another if Lisp code explicitly calls `select-frame'
1650 \(but not if `handle-switch-frame' is called), and saves and restores
1651 the frame focus in window configurations, etc. etc. All of this logic
1652 is heavily #if 0'd, with lots of comments saying "No, this approach
1653 doesn't seem to work, so I'm trying this ... is it reasonable?
1654 Well, I'm not sure ..." that are a red flag indicating crockishness.
1656 Because of our way of doing things, we can avoid all this crock.
1657 Keyboard events never cause a select-frame (who cares what frame
1658 they're associated with? They come from a console, only). We change
1659 the actual WM focus to a surrogate minibuffer frame, so we don't have
1660 to do any internal redirection. In order to get the focus back,
1661 I took the approach in minibuf.el of just checking to see if the
1662 frame we moved to is still the selected frame, and move back to the
1663 old one if so. Conceivably we might have to do the weird "tracking"
1664 that FSFmacs does when `select-frame' is called, but I don't think
1665 so. If the selected frame moved from the minibuffer frame, then
1666 we just leave it there, figuring that someone knows what they're
1667 doing. Because we don't have any redirection recorded anywhere,
1668 it's safe to do this, and we don't end up with unwanted redirection.
1673 run_select_frame_hook (void)
1675 run_hook (Qselect_frame_hook);
1679 run_deselect_frame_hook (void)
1681 run_hook (Qdeselect_frame_hook);
1684 /* When select-frame is called and focus_follows_mouse is false, we want
1685 to tell the window system that the focus should be changed to point to
1686 the new frame. However,
1687 sometimes Lisp functions will temporarily change the selected frame
1688 (e.g. to call a function that operates on the selected frame),
1689 and it's annoying if this focus-change happens exactly when
1690 select-frame is called, because then you get some flickering of the
1691 window-manager border and perhaps other undesirable results. We
1692 really only want to change the focus when we're about to retrieve
1693 an event from the user. To do this, we keep track of the frame
1694 where the window-manager focus lies on, and just before waiting
1695 for user events, check the currently selected frame and change
1696 the focus as necessary.
1698 On the other hand, if focus_follows_mouse is true, we need to switch the
1699 selected frame back to the frame with window manager focus just before we
1700 execute the next command in Fcommand_loop_1, just as the selected buffer is
1701 reverted after a set-buffer.
1703 Both cases are handled by this function. It must be called as appropriate
1704 from these two places, depending on the value of focus_follows_mouse. */
1707 investigate_frame_change (void)
1709 Lisp_Object devcons, concons;
1711 /* if the selected frame was changed, change the window-system
1712 focus to the new frame. We don't do it when select-frame was
1713 called, to avoid flickering and other unwanted side effects when
1714 the frame is just changed temporarily. */
1715 DEVICE_LOOP_NO_BREAK (devcons, concons)
1717 struct device *d = XDEVICE (XCAR (devcons));
1718 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1720 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1721 but that can cause us to end up in an infinite loop focusing
1722 between two frames. It seems that since the call to `select-frame'
1723 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1724 value, we need to do so too. */
1725 if (!NILP (sel_frame) &&
1726 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1727 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1728 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1730 /* At this point, we know that the frame has been changed. Now, if
1731 * focus_follows_mouse is not set, we finish off the frame change,
1732 * so that user events will now come from the new frame. Otherwise,
1733 * if focus_follows_mouse is set, no gratuitous frame changing
1734 * should take place. Set the focus back to the frame which was
1735 * originally selected for user input.
1737 if (!focus_follows_mouse)
1739 /* prevent us from issuing the same request more than once */
1740 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1741 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1745 Lisp_Object old_frame = Qnil;
1747 /* #### Do we really want to check OUGHT ??
1748 * It seems to make sense, though I have never seen us
1749 * get here and have it be non-nil.
1751 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1752 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1753 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1754 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1756 /* #### Can old_frame ever be NIL? play it safe.. */
1757 if (!NILP (old_frame))
1759 /* Fselect_frame is not really the right thing: it frobs the
1760 * buffer stack. But there's no easy way to do the right
1761 * thing, and this code already had this problem anyway.
1763 Fselect_frame (old_frame);
1771 cleanup_after_missed_defocusing (Lisp_Object frame)
1773 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1774 Fselect_frame (frame);
1779 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1781 Lisp_Object frame = Fcar (frame_inp_and_dev);
1782 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1783 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1786 if (!DEVICE_LIVE_P (XDEVICE (device)))
1789 d = XDEVICE (device);
1791 /* Any received focus-change notifications render invalid any
1792 pending focus-change requests. */
1793 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1796 Lisp_Object focus_frame;
1798 if (!FRAME_LIVE_P (XFRAME (frame)))
1801 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1803 /* Mark the minibuffer as changed to make sure it gets updated
1804 properly if the echo area is active. */
1806 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1807 MARK_WINDOWS_CHANGED (w);
1810 if (FRAMEP (focus_frame) && FRAME_LIVE_P (XFRAME (focus_frame))
1811 && !EQ (frame, focus_frame))
1813 /* Oops, we missed a focus-out event. */
1814 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1815 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1817 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1818 if (!EQ (frame, focus_frame))
1820 redisplay_redraw_cursor (XFRAME (frame), 1);
1825 /* We ignore the frame reported in the event. If it's different
1826 from where we think the focus was, oh well -- we messed up.
1827 Nonetheless, we pretend we were right, for sensible behavior. */
1828 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1831 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1833 if (FRAME_LIVE_P (XFRAME (frame)))
1834 redisplay_redraw_cursor (XFRAME (frame), 1);
1839 /* Called from the window-system-specific code when we receive a
1840 notification that the focus lies on a particular frame.
1841 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1845 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1847 Lisp_Object frame = Fcar (frame_inp_and_dev);
1848 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1849 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1853 if (!DEVICE_LIVE_P (XDEVICE (device)))
1856 d = XDEVICE (device);
1860 Lisp_Object focus_frame;
1862 if (!FRAME_LIVE_P (XFRAME (frame)))
1865 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1867 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1868 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1870 /* Oops, we missed a focus-out event. */
1871 Fselect_frame (focus_frame);
1872 /* Do an unwind-protect in case an error occurs in
1873 the deselect-frame-hook */
1874 count = specpdl_depth ();
1875 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1876 run_deselect_frame_hook ();
1877 unbind_to (count, Qnil);
1878 /* the cleanup method changed the focus frame to nil, so
1879 we need to reflect this */
1883 Fselect_frame (frame);
1884 if (!EQ (frame, focus_frame))
1885 run_select_frame_hook ();
1889 /* We ignore the frame reported in the event. If it's different
1890 from where we think the focus was, oh well -- we messed up.
1891 Nonetheless, we pretend we were right, for sensible behavior. */
1892 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1895 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1896 run_deselect_frame_hook ();
1902 /**********************************************************************/
1903 /* retrieving the next event */
1904 /**********************************************************************/
1906 static int in_single_console;
1908 /* #### These functions don't currently do anything. */
1910 single_console_state (void)
1912 in_single_console = 1;
1916 any_console_state (void)
1918 in_single_console = 0;
1922 in_single_console_state (void)
1924 return in_single_console;
1927 /* the number of keyboard characters read. callint.c wants this. */
1928 Charcount num_input_chars;
1931 next_event_internal (Lisp_Object target_event, int allow_queued)
1933 struct gcpro gcpro1;
1934 /* QUIT; This is incorrect - the caller must do this because some
1935 callers (ie, Fnext_event()) do not want to QUIT. */
1937 assert (NILP (XEVENT_NEXT (target_event)));
1939 GCPRO1 (target_event);
1941 /* When focus_follows_mouse is nil, if a frame change took place, we need
1942 * to actually switch window manager focus to the selected window now.
1944 if (!focus_follows_mouse)
1945 investigate_frame_change ();
1947 if (allow_queued && !NILP (command_event_queue))
1949 Lisp_Object event = dequeue_command_event ();
1950 Fcopy_event (event, target_event);
1951 Fdeallocate_event (event);
1952 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
1956 Lisp_Event *e = XEVENT (target_event);
1958 /* The command_event_queue was empty. Wait for an event. */
1959 event_stream_next_event (e);
1960 /* If this was a timeout, then we need to extract some data
1961 out of the returned closure and might need to resignal
1963 if (e->event_type == timeout_event)
1965 Lisp_Object tristan, isolde;
1967 e->event.timeout.id_number =
1968 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
1971 e->event.timeout.function = tristan;
1972 e->event.timeout.object = isolde;
1973 /* next_event_internal() doesn't print out timeout events
1974 because of the extra info we just set. */
1975 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
1978 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1979 The callers of next_event_internal() will do one of two things:
1981 -- set Vquit_flag to Qnil. (next-event does this.) This will
1982 cause the ^G to be treated as a normal keystroke.
1983 -- not change Vquit_flag but attempt to enqueue the ^G, at
1984 which point it will be discarded. The next time QUIT is
1985 called, it will notice that Vquit_flag was set.
1988 if (e->event_type == key_press_event &&
1989 event_matches_key_specifier_p
1990 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2000 run_pre_idle_hook (void)
2002 if (!NILP (Vpre_idle_hook)
2003 && !detect_input_pending ())
2004 safe_run_hook_trapping_errors
2005 ("Error in `pre-idle-hook' (setting hook to nil)",
2009 static void push_this_command_keys (Lisp_Object event);
2010 static void push_recent_keys (Lisp_Object event);
2011 static void dribble_out_event (Lisp_Object event);
2012 static void execute_internal_event (Lisp_Object event);
2013 static int is_scrollbar_event (Lisp_Object event);
2015 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2016 Return the next available event.
2017 Pass this object to `dispatch-event' to handle it.
2018 In most cases, you will want to use `next-command-event', which returns
2019 the next available "user" event (i.e. keypress, button-press,
2020 button-release, or menu selection) instead of this function.
2022 If EVENT is non-nil, it should be an event object and will be filled in
2023 and returned; otherwise a new event object will be created and returned.
2024 If PROMPT is non-nil, it should be a string and will be displayed in the
2025 echo area while this function is waiting for an event.
2027 The next available event will be
2029 -- any events in `unread-command-events' or `unread-command-event'; else
2030 -- the next event in the currently executing keyboard macro, if any; else
2031 -- an event queued by `enqueue-eval-event', if any, or any similar event
2032 queued internally, such as a misc-user event. (For example, when an item
2033 is selected from a menu or from a `question'-type dialog box, the item's
2034 callback is not immediately executed, but instead a misc-user event
2035 is generated and placed onto this queue; when it is dispatched, the
2036 callback is executed.) Else
2037 -- the next available event from the window system or terminal driver.
2039 In the last case, this function will block until an event is available.
2041 The returned event will be one of the following types:
2043 -- a key-press event.
2044 -- a button-press or button-release event.
2045 -- a misc-user-event, meaning the user selected an item on a menu or used
2047 -- a process event, meaning that output from a subprocess is available.
2048 -- a timeout event, meaning that a timeout has elapsed.
2049 -- an eval event, which simply causes a function to be executed when the
2050 event is dispatched. Eval events are generated by `enqueue-eval-event'
2051 or by certain other conditions happening.
2052 -- a magic event, indicating that some window-system-specific event
2053 happened (such as a focus-change notification) that must be handled
2054 synchronously with other events. `dispatch-event' knows what to do with
2059 /* This function can call lisp */
2060 /* #### We start out using the selected console before an event
2061 is received, for echoing the partially completed command.
2062 This is most definitely wrong -- there needs to be a separate
2063 echo area for each console! */
2064 struct console *con = XCONSOLE (Vselected_console);
2065 struct command_builder *command_builder =
2066 XCOMMAND_BUILDER (con->command_builder);
2067 int store_this_key = 0;
2068 struct gcpro gcpro1;
2071 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2072 We want to read the ^G as an event. */
2074 #ifdef LWLIB_MENUBARS_LUCID
2076 * #### Fix the menu code so this isn't necessary.
2078 * We cannot allow the lwmenu code to be reentered, because the
2079 * code is not written to be reentrant and will crash. Therefore
2080 * paths from the menu callbacks back into the menu code have to
2081 * be blocked. Fnext_event is the normal path into the menu code,
2082 * so we signal an error here.
2084 if (in_menu_callback)
2085 error ("Attempt to call next-event inside menu callback");
2086 #endif /* LWLIB_MENUBARS_LUCID */
2089 event = Fmake_event (Qnil, Qnil);
2091 CHECK_LIVE_EVENT (event);
2096 CHECK_STRING (prompt);
2098 len = XSTRING_LENGTH (prompt);
2099 if (command_builder->echo_buf_length < len)
2100 len = command_builder->echo_buf_length - 1;
2101 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2102 command_builder->echo_buf[len] = 0;
2103 command_builder->echo_buf_index = len;
2104 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2105 command_builder->echo_buf,
2107 command_builder->echo_buf_index,
2111 start_over_and_avoid_hosage:
2113 /* If there is something in unread-command-events, simply return it.
2114 But do some error checking to make sure the user hasn't put something
2115 in the unread-command-events that they shouldn't have.
2116 This does not update this-command-keys and recent-keys.
2118 if (!NILP (Vunread_command_events))
2120 if (!CONSP (Vunread_command_events))
2122 Vunread_command_events = Qnil;
2123 signal_error (Qwrong_type_argument,
2124 list3 (Qconsp, Vunread_command_events,
2125 Qunread_command_events));
2129 Lisp_Object e = XCAR (Vunread_command_events);
2130 Vunread_command_events = XCDR (Vunread_command_events);
2131 if (!EVENTP (e) || !command_event_p (e))
2132 signal_error (Qwrong_type_argument,
2133 list3 (Qcommand_event_p, e, Qunread_command_events));
2136 Fcopy_event (e, event);
2137 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2141 /* Do similar for unread-command-event (obsoleteness support). */
2142 else if (!NILP (Vunread_command_event))
2144 Lisp_Object e = Vunread_command_event;
2145 Vunread_command_event = Qnil;
2147 if (!EVENTP (e) || !command_event_p (e))
2149 signal_error (Qwrong_type_argument,
2150 list3 (Qeventp, e, Qunread_command_event));
2153 Fcopy_event (e, event);
2155 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2158 /* If we're executing a keyboard macro, take the next event from that,
2159 and update this-command-keys and recent-keys.
2160 Note that the unread-command-events take precedence over kbd macros.
2164 if (!NILP (Vexecuting_macro))
2167 pop_kbd_macro_event (event); /* This throws past us at
2170 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2172 /* Otherwise, read a real event, possibly from the
2173 command_event_queue, and update this-command-keys and
2177 run_pre_idle_hook ();
2179 next_event_internal (event, 1);
2180 Vquit_flag = Qnil; /* Read C-g as an event. */
2185 status_notify (); /* Notice process change */
2188 alloca (0); /* Cause a garbage collection now */
2189 /* Since we can free the most stuff here
2190 * (since this is typically called from
2191 * the command-loop top-level). */
2192 #endif /* C_ALLOCA */
2194 if (object_dead_p (XEVENT (event)->channel))
2195 /* event_console_or_selected may crash if the channel is dead.
2196 Best just to eat it and get the next event. */
2197 goto start_over_and_avoid_hosage;
2199 /* OK, now we can stop the selected-console kludge and use the
2200 actual console from the event. */
2201 con = event_console_or_selected (event);
2202 command_builder = XCOMMAND_BUILDER (con->command_builder);
2204 switch (XEVENT_TYPE (event))
2208 case button_release_event:
2209 case misc_user_event:
2210 /* don't echo menu accelerator keys */
2211 reset_key_echo (command_builder, 1);
2213 case button_press_event: /* key or mouse input can trigger prompting */
2214 goto STORE_AND_EXECUTE_KEY;
2215 case key_press_event: /* any key input can trigger autosave */
2219 maybe_do_auto_save ();
2221 STORE_AND_EXECUTE_KEY:
2224 echo_key_event (command_builder, event);
2228 /* Store the last-input-event. The semantics of this is that it is
2229 the thing most recently returned by next-command-event. It need
2230 not have come from the keyboard or a keyboard macro, it may have
2231 come from unread-command-events. It's always a command-event (a
2232 key, click, or menu selection), never a motion or process event.
2234 if (!EVENTP (Vlast_input_event))
2235 Vlast_input_event = Fmake_event (Qnil, Qnil);
2236 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2238 Vlast_input_event = Fmake_event (Qnil, Qnil);
2239 error ("Someone deallocated last-input-event!");
2241 if (! EQ (event, Vlast_input_event))
2242 Fcopy_event (event, Vlast_input_event);
2244 /* last-input-char and last-input-time are derived from
2246 Note that last-input-char will never have its high-bit set, in an
2247 effort to sidestep the ambiguity between M-x and oslash.
2249 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2254 if (!CONSP (Vlast_input_time))
2255 Vlast_input_time = Fcons (Qnil, Qnil);
2256 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2257 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2258 if (!CONSP (Vlast_command_event_time))
2259 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2260 XCAR (Vlast_command_event_time) =
2261 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2262 XCAR (XCDR (Vlast_command_event_time)) =
2263 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2264 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2265 = make_int (EMACS_USECS (t));
2267 /* If this key came from the keyboard or from a keyboard macro, then
2268 it goes into the recent-keys and this-command-keys vectors.
2269 If this key came from the keyboard, and we're defining a keyboard
2270 macro, then it goes into the macro.
2274 if (!is_scrollbar_event (event)) /* #### not quite right, see
2275 comment in execute_command_event */
2276 push_this_command_keys (event);
2277 if (!inhibit_input_event_recording)
2278 push_recent_keys (event);
2279 dribble_out_event (event);
2280 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2282 if (!EVENTP (command_builder->current_events))
2283 finalize_kbd_macro_chars (con);
2284 store_kbd_macro_event (event);
2287 /* If this is the help char and there is a help form, then execute the
2288 help form and swallow this character. This is the only place where
2289 calling Fnext_event() can cause arbitrary lisp code to run. Note
2290 that execute_help_form() calls Fnext_command_event(), which calls
2291 this function, as well as Fdispatch_event.
2293 if (!NILP (Vhelp_form) &&
2294 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2295 execute_help_form (command_builder, event);
2302 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2303 Return the next available "user" event.
2304 Pass this object to `dispatch-event' to handle it.
2306 If EVENT is non-nil, it should be an event object and will be filled in
2307 and returned; otherwise a new event object will be created and returned.
2308 If PROMPT is non-nil, it should be a string and will be displayed in the
2309 echo area while this function is waiting for an event.
2311 The event returned will be a keyboard, mouse press, or mouse release event.
2312 If there are non-command events available (mouse motion, sub-process output,
2313 etc) then these will be executed (with `dispatch-event') and discarded. This
2314 function is provided as a convenience; it is roughly equivalent to the lisp code
2317 (next-event event prompt)
2318 (not (or (key-press-event-p event)
2319 (button-press-event-p event)
2320 (button-release-event-p event)
2321 (misc-user-event-p event))))
2322 (dispatch-event event))
2324 but it also makes a provision for displaying keystrokes in the echo area.
2328 /* This function can GC */
2329 struct gcpro gcpro1;
2331 maybe_echo_keys (XCOMMAND_BUILDER
2332 (XCONSOLE (Vselected_console)->
2333 command_builder), 0); /* #### This sucks bigtime */
2336 event = Fnext_event (event, prompt);
2337 if (command_event_p (event))
2340 execute_internal_event (event);
2346 DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2347 Dispatch any pending "magic" events.
2349 This function is useful for forcing the redisplay of native
2350 widgets. Normally these are redisplayed through a native window-system
2351 event encoded as magic event, rather than by the redisplay code. This
2352 function does not call redisplay or do any of the other things that
2357 /* This function can GC */
2358 Lisp_Object event = Qnil;
2359 struct gcpro gcpro1;
2361 event = Fmake_event (Qnil, Qnil);
2363 /* Make sure that there will be something in the native event queue
2364 so that externally managed things (e.g. widgets) get some CPU
2366 event_stream_force_event_pending (selected_frame ());
2368 while (event_stream_event_pending_p (0))
2370 QUIT; /* next_event_internal() does not QUIT. */
2372 /* We're a generator of the command_event_queue, so we can't be a
2373 consumer as well. Also, we have no reason to consult the
2374 command_event_queue; there are only user and eval-events there,
2375 and we'd just have to put them back anyway.
2377 next_event_internal (event, 0); /* blocks */
2378 /* See the comment in accept-process-output about Vquit_flag */
2379 if (XEVENT_TYPE (event) == magic_event ||
2380 XEVENT_TYPE (event) == timeout_event ||
2381 XEVENT_TYPE (event) == process_event ||
2382 XEVENT_TYPE (event) == pointer_motion_event)
2383 execute_internal_event (event);
2386 enqueue_command_event_1 (event);
2391 Fdeallocate_event (event);
2397 reset_current_events (struct command_builder *command_builder)
2399 Lisp_Object event = command_builder->current_events;
2400 reset_command_builder_event_chain (command_builder);
2402 deallocate_event_chain (event);
2405 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2406 Discard any pending "user" events.
2407 Also cancel any kbd macro being defined.
2408 A user event is a key press, button press, button release, or
2409 "misc-user" event (menu selection or scrollbar action).
2413 /* This throws away user-input on the queue, but doesn't process any
2414 events. Calling dispatch_event() here leads to a race condition.
2416 Lisp_Object event = Fmake_event (Qnil, Qnil);
2417 Lisp_Object head = Qnil, tail = Qnil;
2418 Lisp_Object oiq = Vinhibit_quit;
2419 struct gcpro gcpro1, gcpro2;
2420 /* #### not correct here with Vselected_console? Should
2421 discard-input take a console argument, or maybe map over
2423 struct console *con = XCONSOLE (Vselected_console);
2425 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2426 GCPRO2 (event, oiq);
2428 /* If a macro was being defined then we have to mark the modeline
2429 has changed to ensure that it gets updated correctly. */
2430 if (!NILP (con->defining_kbd_macro))
2431 MARK_MODELINE_CHANGED;
2432 con->defining_kbd_macro = Qnil;
2433 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2435 while (!NILP (command_event_queue)
2436 || event_stream_event_pending_p (1))
2438 /* This will take stuff off the command_event_queue, or read it
2439 from the event_stream, but it will not block.
2441 next_event_internal (event, 1);
2442 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2443 It is vitally important that we reset
2444 Vquit_flag here. Otherwise, if we're
2445 reading from a TTY console,
2446 maybe_read_quit_event() will notice
2447 that C-g has been set and send us
2448 another C-g. That will cause us
2449 to get right back here, and read
2450 another C-g, ad infinitum ... */
2452 /* If the event is a user event, ignore it. */
2453 if (!command_event_p (event))
2455 /* Otherwise, chain the event onto our list of events not to ignore,
2456 and keep reading until the queue is empty. This does not mean
2457 that if a subprocess is generating an infinite amount of output,
2458 we will never terminate (*provided* that the behavior of
2459 next_event_cb() is correct -- see the comment in events.h),
2460 because this loop ends as soon as there are no more user events
2461 on the command_event_queue or event_stream.
2463 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2467 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2470 /* Now tack our chain of events back on to the front of the queue.
2471 Actually, since the queue is now drained, we can just replace it.
2472 The effect of this will be that we have deleted all user events
2473 from the input stream without changing the relative ordering of
2474 any other events. (Some events may have been taken from the
2475 event_stream and added to the command_event_queue, however.)
2477 At this time, the command_event_queue will contain only eval_events.
2480 command_event_queue = head;
2481 command_event_queue_tail = tail;
2483 Fdeallocate_event (event);
2486 Vinhibit_quit = oiq;
2491 /**********************************************************************/
2492 /* pausing until an action occurs */
2493 /**********************************************************************/
2495 /* This is used in accept-process-output, sleep-for and sit-for.
2496 Before running any process_events in these routines, we set
2497 recursive_sit_for to Qt, and use this unwind protect to reset it to
2498 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2499 cause it to return immediately.
2501 All of these routines install timeouts, so we clear the installed
2504 Note: It's very easy to break the desired behaviors of these
2505 3 routines. If you make any changes to anything in this area, run
2506 the regression tests at the bottom of the file. -- dmoore */
2510 sit_for_unwind (Lisp_Object timeout_id)
2512 if (!NILP(timeout_id))
2513 Fdisable_timeout (timeout_id);
2515 recursive_sit_for = Qnil;
2519 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2522 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2523 Allow any pending output from subprocesses to be read by Emacs.
2524 It is read into the process' buffers or given to their filter functions.
2525 Non-nil arg PROCESS means do not return until some output has been received
2526 from PROCESS. Nil arg PROCESS means do not return until some output has
2527 been received from any process.
2528 If the second arg is non-nil, it is the maximum number of seconds to wait:
2529 this function will return after that much time even if no input has arrived
2530 from PROCESS. This argument may be a float, meaning wait some fractional
2532 If the third arg is non-nil, it is a number of milliseconds that is added
2533 to the second arg. (This exists only for compatibility.)
2534 Return non-nil iff we received any output before the timeout expired.
2536 (process, timeout_secs, timeout_msecs))
2538 /* This function can GC */
2539 struct gcpro gcpro1, gcpro2;
2540 Lisp_Object event = Qnil;
2541 Lisp_Object result = Qnil;
2542 int timeout_id = -1;
2543 int timeout_enabled = 0;
2545 struct buffer *old_buffer = current_buffer;
2548 /* We preserve the current buffer but nothing else. If a focus
2549 change alters the selected window then the top level event loop
2550 will eventually alter current_buffer to match. In the mean time
2551 we don't want to mess up whatever called this function. */
2553 if (!NILP (process))
2554 CHECK_PROCESS (process);
2556 GCPRO2 (event, process);
2558 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2560 unsigned long msecs = 0;
2561 if (!NILP (timeout_secs))
2562 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2563 if (!NILP (timeout_msecs))
2565 CHECK_NATNUM (timeout_msecs);
2566 msecs += XINT (timeout_msecs);
2570 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2571 timeout_enabled = 1;
2575 event = Fmake_event (Qnil, Qnil);
2577 count = specpdl_depth ();
2578 record_unwind_protect (sit_for_unwind,
2579 timeout_enabled ? make_int (timeout_id) : Qnil);
2580 recursive_sit_for = Qt;
2583 ((NILP (process) && timeout_enabled) ||
2584 (NILP (process) && event_stream_event_pending_p (0)) ||
2586 /* Calling detect_input_pending() is the wrong thing here, because
2587 that considers the Vunread_command_events and command_event_queue.
2588 We don't need to look at the command_event_queue because we are
2589 only interested in process events, which don't go on that. In
2590 fact, we can't read from it anyway, because we put stuff on it.
2592 Note that event_stream->event_pending_p must be called in such
2593 a way that it says whether any events *of any kind* are ready,
2594 not just user events, or (accept-process-output nil) will fail
2595 to dispatch any process events that may be on the queue. It is
2596 not clear to me that this is important, because the top-level
2597 loop will process it, and I don't think that there is ever a
2598 time when one calls accept-process-output with a nil argument
2599 and really need the processes to be handled. */
2601 /* If our timeout has arrived, we move along. */
2602 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2604 timeout_enabled = 0;
2605 done = 1; /* We're done. */
2606 continue; /* Don't call next_event_internal */
2609 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2610 before reading output from the process - this makes it
2611 less likely that the filter will actually be aborted.
2614 next_event_internal (event, 0);
2615 /* If C-g was pressed while we were waiting, Vquit_flag got
2616 set and next_event_internal() also returns C-g. When
2617 we enqueue the C-g below, it will get discarded. The
2618 next time through, QUIT will be called and will signal a quit. */
2619 switch (XEVENT_TYPE (event))
2623 if (NILP (process) ||
2624 EQ (XEVENT (event)->event.process.process, process))
2627 /* RMS's version always returns nil when proc is nil,
2628 and only returns t if input ever arrived on proc. */
2632 execute_internal_event (event);
2636 /* We execute the event even if it's ours, and notice that it's
2638 case pointer_motion_event:
2641 execute_internal_event (event);
2646 enqueue_command_event_1 (event);
2652 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2654 Fdeallocate_event (event);
2656 current_buffer = old_buffer;
2660 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2661 Pause, without updating display, for SECONDS seconds.
2662 SECONDS may be a float, allowing pauses for fractional parts of a second.
2664 It is recommended that you never call sleep-for from inside of a process
2665 filter function or timer event (either synchronous or asynchronous).
2669 /* This function can GC */
2670 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2672 Lisp_Object event = Qnil;
2674 struct gcpro gcpro1;
2678 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2679 event = Fmake_event (Qnil, Qnil);
2681 count = specpdl_depth ();
2682 record_unwind_protect (sit_for_unwind, make_int (id));
2683 recursive_sit_for = Qt;
2687 /* If our timeout has arrived, we move along. */
2688 if (!event_stream_wakeup_pending_p (id, 0))
2691 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2692 before reading output from the process - this makes it
2693 less likely that the filter will actually be aborted.
2695 /* We're a generator of the command_event_queue, so we can't be a
2696 consumer as well. We don't care about command and eval-events
2699 next_event_internal (event, 0); /* blocks */
2700 /* See the comment in accept-process-output about Vquit_flag */
2701 switch (XEVENT_TYPE (event))
2704 /* We execute the event even if it's ours, and notice that it's
2707 case pointer_motion_event:
2710 execute_internal_event (event);
2715 enqueue_command_event_1 (event);
2721 unbind_to (count, make_int (id));
2722 Fdeallocate_event (event);
2727 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2728 Perform redisplay, then wait SECONDS seconds or until user input is available.
2729 SECONDS may be a float, meaning a fractional part of a second.
2730 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
2731 Redisplay is preempted as always if user input arrives, and does not
2732 happen if input is available before it starts.
2733 Value is t if waited the full time with no input arriving.
2735 If sit-for is called from within a process filter function or timer
2736 event (either synchronous or asynchronous) it will return immediately.
2738 (seconds, nodisplay))
2740 /* This function can GC */
2741 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2742 Lisp_Object event, result;
2743 struct gcpro gcpro1;
2747 /* The unread-command-events count as pending input */
2748 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2751 /* If the command-builder already has user-input on it (not eval events)
2752 then that means we're done too.
2754 if (!NILP (command_event_queue))
2756 EVENT_CHAIN_LOOP (event, command_event_queue)
2758 if (command_event_p (event))
2763 /* If we're in a macro, or noninteractive, or early in temacs, then
2765 if (noninteractive || !NILP (Vexecuting_macro))
2768 /* Recursive call from a filter function or timeout handler. */
2769 if (!NILP(recursive_sit_for))
2771 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2773 run_pre_idle_hook ();
2780 /* Otherwise, start reading events from the event_stream.
2781 Do this loop at least once even if (sit-for 0) so that we
2782 redisplay when no input pending.
2785 event = Fmake_event (Qnil, Qnil);
2787 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2788 events get processed. The old (pre-19.12) code special-cased this
2789 and didn't generate a wakeup, but the resulting behavior was less than
2790 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2791 the E-Lisp universe. */
2793 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2795 count = specpdl_depth ();
2796 record_unwind_protect (sit_for_unwind, make_int (id));
2797 recursive_sit_for = Qt;
2801 /* If there is no user input pending, then redisplay.
2803 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2805 run_pre_idle_hook ();
2809 /* If our timeout has arrived, we move along. */
2810 if (!event_stream_wakeup_pending_p (id, 0))
2816 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2817 before reading output from the process - this makes it
2818 less likely that the filter will actually be aborted.
2820 /* We're a generator of the command_event_queue, so we can't be a
2821 consumer as well. In fact, we know there's nothing on the
2822 command_event_queue that we didn't just put there.
2824 next_event_internal (event, 0); /* blocks */
2825 /* See the comment in accept-process-output about Vquit_flag */
2827 if (command_event_p (event))
2829 QUIT; /* If the command was C-g check it here
2830 so that we abort out of the sit-for,
2831 not the next command. sleep-for and
2832 accept-process-output continue looping
2833 so they check QUIT again implicitly.*/
2837 switch (XEVENT_TYPE (event))
2841 /* eval-events get delayed until later. */
2842 enqueue_command_event (Fcopy_event (event, Qnil));
2847 /* We execute the event even if it's ours, and notice that it's
2851 execute_internal_event (event);
2858 unbind_to (count, make_int (id));
2860 /* Put back the event (if any) that made Fsit_for() exit before the
2861 timeout. Note that it is being added to the back of the queue, which
2862 would be inappropriate if there were any user events on the queue
2863 already: we would be misordering them. But we know that there are
2864 no user-events on the queue, or else we would not have reached this
2868 enqueue_command_event (event);
2870 Fdeallocate_event (event);
2876 /* This handy little function is used by select-x.c to wait for replies
2877 from processes that aren't really processes (e.g. the X server) */
2879 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2881 /* This function can GC */
2882 Lisp_Object event = Fmake_event (Qnil, Qnil);
2883 struct gcpro gcpro1;
2886 while (!(*predicate) (predicate_arg))
2888 QUIT; /* next_event_internal() does not QUIT. */
2890 /* We're a generator of the command_event_queue, so we can't be a
2891 consumer as well. Also, we have no reason to consult the
2892 command_event_queue; there are only user and eval-events there,
2893 and we'd just have to put them back anyway.
2895 next_event_internal (event, 0);
2896 /* See the comment in accept-process-output about Vquit_flag */
2897 if (command_event_p (event)
2898 || (XEVENT_TYPE (event) == eval_event)
2899 || (XEVENT_TYPE (event) == magic_eval_event))
2900 enqueue_command_event_1 (event);
2902 execute_internal_event (event);
2908 /**********************************************************************/
2909 /* dispatching events; command builder */
2910 /**********************************************************************/
2913 execute_internal_event (Lisp_Object event)
2915 /* events on dead channels get silently eaten */
2916 if (object_dead_p (XEVENT (event)->channel))
2919 /* This function can GC */
2920 switch (XEVENT_TYPE (event))
2927 call1 (XEVENT (event)->event.eval.function,
2928 XEVENT (event)->event.eval.object);
2932 case magic_eval_event:
2934 (XEVENT (event)->event.magic_eval.internal_function)
2935 (XEVENT (event)->event.magic_eval.object);
2939 case pointer_motion_event:
2941 if (!NILP (Vmouse_motion_handler))
2942 call1 (Vmouse_motion_handler, event);
2948 Lisp_Object p = XEVENT (event)->event.process.process;
2949 Charcount readstatus;
2951 assert (PROCESSP (p));
2952 while ((readstatus = read_process_output (p)) > 0)
2955 ; /* this clauses never gets executed but allows the #ifdefs
2958 else if (readstatus == -1 && errno == EWOULDBLOCK)
2960 #endif /* EWOULDBLOCK */
2962 else if (readstatus == -1 && errno == EAGAIN)
2965 else if ((readstatus == 0 &&
2966 /* Note that we cannot distinguish between no input
2967 available now and a closed pipe.
2968 With luck, a closed pipe will be accompanied by
2969 subprocess termination and SIGCHLD. */
2970 (!network_connection_p (p) ||
2972 When connected to ToolTalk (i.e.
2973 connected_via_filedesc_p()), it's not possible to
2974 reliably determine whether there is a message
2975 waiting for ToolTalk to receive. ToolTalk expects
2976 to have tt_message_receive() called exactly once
2977 every time the file descriptor becomes active, so
2978 the filter function forces this by returning 0.
2979 Emacs must not interpret this as a closed pipe. */
2980 connected_via_filedesc_p (XPROCESS (p))))
2982 /* On some OSs with ptys, when the process on one end of
2983 a pty exits, the other end gets an error reading with
2984 errno = EIO instead of getting an EOF (0 bytes read).
2985 Therefore, if we get an error reading and errno =
2986 EIO, just continue, because the child process has
2987 exited and should clean itself up soon (e.g. when we
2989 || (readstatus == -1 && errno == EIO)
2993 /* Currently, we rely on SIGCHLD to indicate that the
2994 process has terminated. Unfortunately, on some systems
2995 the SIGCHLD gets missed some of the time. So we put an
2996 additional check in status_notify() to see whether a
2997 process has terminated. We must tell status_notify()
2998 to enable that check, and we do so now. */
2999 kick_status_notify ();
3003 /* Deactivate network connection */
3004 Lisp_Object status = Fprocess_status (p);
3005 if (EQ (status, Qopen)
3006 /* In case somebody changes the theory of whether to
3007 return open as opposed to run for network connection
3009 || EQ (status, Qrun))
3010 update_process_status (p, Qexit, 256, 0);
3011 deactivate_process (p);
3014 /* We must call status_notify here to allow the
3015 event_stream->unselect_process_cb to be run if appropriate.
3016 Otherwise, dead fds may be selected for, and we will get a
3017 continuous stream of process events for them. Since we don't
3018 return until all process events have been flushed, we would
3019 get stuck here, processing events on a process whose status
3020 was 'exit. Call this after dispatch-event, or the fds will
3021 have been closed before we read the last data from them.
3022 It's safe for the filter to signal an error because
3023 status_notify() will be called on return to top-level.
3031 Lisp_Event *e = XEVENT (event);
3032 if (!NILP (e->event.timeout.function))
3033 call1 (e->event.timeout.function,
3034 e->event.timeout.object);
3039 event_stream_handle_magic_event (XEVENT (event));
3050 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3052 Lisp_Object first_before_suffix =
3053 event_chain_find_previous (Vthis_command_keys, suffix);
3055 if (NILP (first_before_suffix))
3056 Vthis_command_keys = chain;
3058 XSET_EVENT_NEXT (first_before_suffix, chain);
3059 deallocate_event_chain (suffix);
3060 Vthis_command_keys_tail = event_chain_tail (chain);
3064 command_builder_replace_suffix (struct command_builder *builder,
3065 Lisp_Object suffix, Lisp_Object chain)
3067 Lisp_Object first_before_suffix =
3068 event_chain_find_previous (builder->current_events, suffix);
3070 if (NILP (first_before_suffix))
3071 builder->current_events = chain;
3073 XSET_EVENT_NEXT (first_before_suffix, chain);
3074 deallocate_event_chain (suffix);
3075 builder->most_current_event = event_chain_tail (chain);
3079 command_builder_find_leaf_1 (struct command_builder *builder)
3081 Lisp_Object event0 = builder->current_events;
3086 return event_binding (event0, 1);
3089 /* See if we can do function-key-map or key-translation-map translation
3090 on the current events in the command builder. If so, do this, and
3091 return the resulting binding, if any. */
3094 munge_keymap_translate (struct command_builder *builder,
3095 enum munge_me_out_the_door munge,
3096 int has_normal_binding_p)
3100 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3102 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3107 if (KEYMAPP (result))
3109 if (NILP (builder->last_non_munged_event)
3110 && !has_normal_binding_p)
3111 builder->last_non_munged_event = builder->most_current_event;
3114 builder->last_non_munged_event = Qnil;
3116 if (!KEYMAPP (result) &&
3117 !VECTORP (result) &&
3120 struct gcpro gcpro1;
3122 result = call1 (result, Qnil);
3128 if (KEYMAPP (result))
3131 if (VECTORP (result) || STRINGP (result))
3133 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3137 /* If the first_mungeable_event of the other munger is
3138 within the events we're munging, then it will point to
3139 deallocated events afterwards, which is bad -- so make it
3140 point at the beginning of the munged events. */
3141 EVENT_CHAIN_LOOP (tempev, suffix)
3143 Lisp_Object *mungeable_event =
3144 &builder->munge_me[1 - munge].first_mungeable_event;
3145 if (EQ (tempev, *mungeable_event))
3147 *mungeable_event = new_chain;
3152 n = event_chain_count (suffix);
3153 command_builder_replace_suffix (builder, suffix, new_chain);
3154 builder->munge_me[munge].first_mungeable_event = Qnil;
3155 /* Now hork this-command-keys as well. */
3157 /* We just assume that the events we just replaced are
3158 sitting in copied form at the end of this-command-keys.
3159 If the user did weird things with `dispatch-event' this
3160 may not be the case, but at least we make sure we won't
3162 new_chain = copy_event_chain (new_chain);
3163 tckn = event_chain_count (Vthis_command_keys);
3166 this_command_keys_replace_suffix
3167 (event_chain_nth (Vthis_command_keys, tckn - n),
3171 result = command_builder_find_leaf_1 (builder);
3175 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3176 "Invalid binding in function-key-map" :
3177 "Invalid binding in key-translation-map"),
3184 /* Compare the current state of the command builder against the local and
3185 global keymaps, and return the binding. If there is no match, try again,
3186 case-insensitively. The return value will be one of:
3187 -- nil (there is no binding)
3188 -- a keymap (part of a command has been specified)
3189 -- a command (anything that satisfies `commandp'; this includes
3190 some symbols, lists, subrs, strings, vectors, and
3191 compiled-function objects)
3194 command_builder_find_leaf (struct command_builder *builder,
3195 int allow_misc_user_events_p)
3197 /* This function can GC */
3199 Lisp_Object evee = builder->current_events;
3201 if (XEVENT_TYPE (evee) == misc_user_event)
3203 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3204 return list2 (XEVENT (evee)->event.eval.function,
3205 XEVENT (evee)->event.eval.object);
3210 /* if we're currently in a menu accelerator, check there for further
3212 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
3213 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3214 if (x_kludge_lw_menu_active ())
3216 return command_builder_operate_menu_accelerator (builder);
3221 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3222 result = command_builder_find_menu_accelerator (builder);
3225 result = command_builder_find_leaf_1 (builder);
3226 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3228 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3229 result = command_builder_find_menu_accelerator (builder);
3233 /* Check to see if we have a potential function-key-map match. */
3236 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3237 regenerate_echo_keys_from_this_command_keys (builder);
3239 /* Check to see if we have a potential key-translation-map match. */
3241 Lisp_Object key_translate_result =
3242 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3244 if (!NILP (key_translate_result))
3246 result = key_translate_result;
3247 regenerate_echo_keys_from_this_command_keys (builder);
3254 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3256 /* If we didn't find a binding, and the last event in the sequence is
3257 a shifted character, then try again with the lowercase version. */
3259 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3260 && !NILP (Vretry_undefined_key_binding_unshifted))
3262 Lisp_Object terminal = builder->most_current_event;
3263 struct key_data* key = & XEVENT (terminal)->event.key;
3265 if ((key->modifiers & XEMACS_MOD_SHIFT)
3266 || (CHAR_OR_CHAR_INTP (key->keysym)
3267 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3269 Lisp_Event terminal_copy = *XEVENT (terminal);
3271 if (key->modifiers & XEMACS_MOD_SHIFT)
3272 key->modifiers &= (~ XEMACS_MOD_SHIFT);
3274 key->keysym = make_char (c + 'a' - 'A');
3276 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3279 /* If there was no match with the lower-case version either,
3280 then put back the upper-case event for the error
3281 message. But make sure that function-key-map didn't
3282 change things out from under us. */
3283 if (EQ (terminal, builder->most_current_event))
3284 *XEVENT (terminal) = terminal_copy;
3288 /* help-char is `auto-bound' in every keymap */
3289 if (!NILP (Vprefix_help_command) &&
3290 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3292 return Vprefix_help_command;
3295 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3296 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3297 && !NILP (Vcomposed_character_default_binding))
3299 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3300 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3301 return Vcomposed_character_default_binding;
3303 #endif /* HAVE_XIM */
3305 /* If we read extra events attempting to match a function key but end
3306 up failing, then we release those events back to the command loop
3307 and fail on the original lookup. The released events will then be
3308 reprocessed in the context of the first part having failed. */
3309 if (!NILP (builder->last_non_munged_event))
3311 Lisp_Object event0 = builder->last_non_munged_event;
3313 /* Put the commands back on the event queue. */
3314 enqueue_event_chain (XEVENT_NEXT (event0),
3315 &command_event_queue,
3316 &command_event_queue_tail);
3318 /* Then remove them from the command builder. */
3319 XSET_EVENT_NEXT (event0, Qnil);
3320 builder->most_current_event = event0;
3321 builder->last_non_munged_event = Qnil;
3328 /* Every time a command-event (a key, button, or menu selection) is read by
3329 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3330 and in Vthis_command_keys. (Eval-events are not stored there.)
3332 Every time a command is invoked, Vlast_command_event is set to the last
3333 event in the sequence.
3335 This means that Vthis_command_keys is really about "input read since the
3336 last command was executed" rather than about "what keys invoked this
3337 command." This is a little counterintuitive, but that's the way it
3340 As an extra kink, the function read-key-sequence resets/updates the
3341 last-command-event and this-command-keys. It doesn't append to the
3342 command-keys as read-char does. Such are the pitfalls of having to
3343 maintain compatibility with a program for which the only specification
3346 (We could implement recent_keys_ring and Vthis_command_keys as the same
3350 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3351 Return a vector of recent keyboard or mouse button events read.
3352 If NUMBER is non-nil, not more than NUMBER events will be returned.
3353 Change number of events stored using `set-recent-keys-ring-size'.
3355 This copies the event objects into a new vector; it is safe to keep and
3360 struct gcpro gcpro1;
3361 Lisp_Object val = Qnil;
3363 int start, nkeys, i, j;
3367 nwanted = recent_keys_ring_size;
3370 CHECK_NATNUM (number);
3371 nwanted = XINT (number);
3374 /* Create the keys ring vector, if none present. */
3375 if (NILP (Vrecent_keys_ring))
3377 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3378 /* And return nothing in particular. */
3379 RETURN_UNGCPRO (make_vector (0, Qnil));
3382 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3383 /* This means the vector has not yet wrapped */
3385 nkeys = recent_keys_ring_index;
3390 nkeys = recent_keys_ring_size;
3391 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3394 if (nwanted < nkeys)
3396 start += nkeys - nwanted;
3397 if (start >= recent_keys_ring_size)
3398 start -= recent_keys_ring_size;
3404 val = make_vector (nwanted, Qnil);
3406 for (i = 0, j = start; i < nkeys; i++)
3408 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3412 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3413 if (++j >= recent_keys_ring_size)
3421 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3422 The maximum number of events `recent-keys' can return.
3426 return make_int (recent_keys_ring_size);
3429 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3430 Set the maximum number of events to be stored internally.
3434 Lisp_Object new_vector = Qnil;
3435 int i, j, nkeys, start, min;
3436 struct gcpro gcpro1;
3439 if (XINT (size) <= 0)
3440 error ("Recent keys ring size must be positive");
3441 if (XINT (size) == recent_keys_ring_size)
3444 GCPRO1 (new_vector);
3445 new_vector = make_vector (XINT (size), Qnil);
3447 if (NILP (Vrecent_keys_ring))
3449 Vrecent_keys_ring = new_vector;
3450 RETURN_UNGCPRO (size);
3453 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3454 /* This means the vector has not yet wrapped */
3456 nkeys = recent_keys_ring_index;
3461 nkeys = recent_keys_ring_size;
3462 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3465 if (XINT (size) > nkeys)
3470 for (i = 0, j = start; i < min; i++)
3472 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3473 if (++j >= recent_keys_ring_size)
3476 recent_keys_ring_size = XINT (size);
3477 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3479 Vrecent_keys_ring = new_vector;
3485 /* Vthis_command_keys having value Qnil means that the next time
3486 push_this_command_keys is called, it should start over.
3487 The times at which the command-keys are reset
3488 (instead of merely being augmented) are pretty counterintuitive.
3491 -- We do not reset this-command-keys when we finish reading a
3492 command. This is because some commands (e.g. C-u) act
3493 like command prefixes; they signal this by setting prefix-arg
3495 -- Therefore, we reset this-command-keys when we finish
3496 executing a command, unless prefix-arg is set.
3497 -- However, if we ever do a non-local exit out of a command
3498 loop (e.g. an error in a command), we need to reset
3499 this-command-keys. We do this by calling reset_this_command_keys()
3500 from cmdloop.c, whenever an error causes an invocation of the
3501 default error handler, and whenever there's a throw to top-level.)
3505 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
3507 struct command_builder *command_builder =
3508 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
3510 reset_key_echo (command_builder, clear_echo_area_p);
3512 deallocate_event_chain (Vthis_command_keys);
3513 Vthis_command_keys = Qnil;
3514 Vthis_command_keys_tail = Qnil;
3516 reset_current_events (command_builder);
3520 push_this_command_keys (Lisp_Object event)
3522 Lisp_Object new = Fmake_event (Qnil, Qnil);
3524 Fcopy_event (event, new);
3525 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
3528 /* The following two functions are used in call-interactively,
3529 for the @ and e specifications. We used to just use
3530 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3531 but FSF does it more generally so we follow their lead. */
3534 extract_this_command_keys_nth_mouse_event (int n)
3538 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3541 && (XEVENT_TYPE (event) == button_press_event
3542 || XEVENT_TYPE (event) == button_release_event
3543 || XEVENT_TYPE (event) == misc_user_event))
3547 /* must copy to avoid an abort() in next_event_internal() */
3548 if (!NILP (XEVENT_NEXT (event)))
3549 return Fcopy_event (event, Qnil);
3561 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
3564 int len = XVECTOR_LENGTH (vector);
3566 for (i = 0; i < len; i++)
3568 Lisp_Object event = XVECTOR_DATA (vector)[i];
3570 switch (XEVENT_TYPE (event))
3572 case button_press_event :
3573 case button_release_event :
3574 case misc_user_event :
3588 push_recent_keys (Lisp_Object event)
3592 if (NILP (Vrecent_keys_ring))
3593 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3595 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
3599 e = Fmake_event (Qnil, Qnil);
3600 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
3602 Fcopy_event (event, e);
3603 if (++recent_keys_ring_index == recent_keys_ring_size)
3604 recent_keys_ring_index = 0;
3609 current_events_into_vector (struct command_builder *command_builder)
3613 int n = event_chain_count (command_builder->current_events);
3615 /* Copy the vector and the events in it. */
3616 /* No need to copy the events, since they're already copies, and
3617 nobody other than the command-builder has pointers to them */
3618 vector = make_vector (n, Qnil);
3620 EVENT_CHAIN_LOOP (event, command_builder->current_events)
3621 XVECTOR_DATA (vector)[n++] = event;
3622 reset_command_builder_event_chain (command_builder);
3628 Given the current state of the command builder and a new command event
3629 that has just been dispatched:
3631 -- add the event to the event chain forming the current command
3632 (doing meta-translation as necessary)
3633 -- return the binding of this event chain; this will be one of:
3634 -- nil (there is no binding)
3635 -- a keymap (part of a command has been specified)
3636 -- a command (anything that satisfies `commandp'; this includes
3637 some symbols, lists, subrs, strings, vectors, and
3638 compiled-function objects)
3641 lookup_command_event (struct command_builder *command_builder,
3642 Lisp_Object event, int allow_misc_user_events_p)
3644 /* This function can GC */
3645 struct frame *f = selected_frame ();
3646 /* Clear output from previous command execution */
3647 if (!EQ (Qcommand, echo_area_status (f))
3648 /* but don't let mouse-up clear what mouse-down just printed */
3649 && (XEVENT (event)->event_type != button_release_event))
3650 clear_echo_area (f, Qnil, 0);
3652 /* Add the given event to the command builder.
3653 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3654 vectors to translate "ESC x" to "M-x" (for any "x" of course).
3657 Lisp_Object recent = command_builder->most_current_event;
3660 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
3663 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3664 DoubleThink the recent-keys and this-command-keys as well. */
3666 /* Modify the previous most-recently-pushed event on the command
3667 builder to be a copy of this one with the meta-bit set instead of
3668 pushing a new event.
3670 Fcopy_event (event, recent);
3671 e = XEVENT (recent);
3672 if (e->event_type == key_press_event)
3673 e->event.key.modifiers |= XEMACS_MOD_META;
3674 else if (e->event_type == button_press_event
3675 || e->event_type == button_release_event)
3676 e->event.button.modifiers |= XEMACS_MOD_META;
3681 int tckn = event_chain_count (Vthis_command_keys);
3683 /* ??? very strange if it's < 2. */
3684 this_command_keys_replace_suffix
3685 (event_chain_nth (Vthis_command_keys, tckn - 2),
3686 Fcopy_event (recent, Qnil));
3689 regenerate_echo_keys_from_this_command_keys (command_builder);
3693 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
3695 command_builder_append_event (command_builder, event);
3700 Lisp_Object leaf = command_builder_find_leaf (command_builder,
3701 allow_misc_user_events_p);
3702 struct gcpro gcpro1;
3707 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3708 if (!x_kludge_lw_menu_active ())
3713 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
3714 if (STRINGP (prompt))
3716 /* Append keymap prompt to key echo buffer */
3717 int buf_index = command_builder->echo_buf_index;
3718 Bytecount len = XSTRING_LENGTH (prompt);
3720 if (len + buf_index + 1 <= command_builder->echo_buf_length)
3722 Bufbyte *echo = command_builder->echo_buf + buf_index;
3723 memcpy (echo, XSTRING_DATA (prompt), len);
3726 maybe_echo_keys (command_builder, 1);
3729 maybe_echo_keys (command_builder, 0);
3731 else if (!NILP (Vquit_flag))
3733 Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
3734 Lisp_Event *e = XEVENT (quit_event);
3735 /* if quit happened during menu acceleration, pretend we read it */
3736 struct console *con = XCONSOLE (Fselected_console ());
3737 int ch = CONSOLE_QUIT_CHAR (con);
3739 character_to_event (ch, e, con, 1, 1);
3740 e->channel = make_console (con);
3742 enqueue_command_event (quit_event);
3746 else if (!NILP (leaf))
3748 if (EQ (Qcommand, echo_area_status (f))
3749 && command_builder->echo_buf_index > 0)
3751 /* If we had been echoing keys, echo the last one (without
3752 the trailing dash) and redisplay before executing the
3754 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
3755 maybe_echo_keys (command_builder, 1);
3756 Fsit_for (Qzero, Qt);
3759 RETURN_UNGCPRO (leaf);
3764 is_scrollbar_event (Lisp_Object event)
3766 #ifdef HAVE_SCROLLBARS
3769 if (XEVENT (event)->event_type != misc_user_event)
3771 fun = XEVENT (event)->event.misc.function;
3773 return (EQ (fun, Qscrollbar_line_up) ||
3774 EQ (fun, Qscrollbar_line_down) ||
3775 EQ (fun, Qscrollbar_page_up) ||
3776 EQ (fun, Qscrollbar_page_down) ||
3777 EQ (fun, Qscrollbar_to_top) ||
3778 EQ (fun, Qscrollbar_to_bottom) ||
3779 EQ (fun, Qscrollbar_vertical_drag) ||
3780 EQ (fun, Qscrollbar_char_left) ||
3781 EQ (fun, Qscrollbar_char_right) ||
3782 EQ (fun, Qscrollbar_page_left) ||
3783 EQ (fun, Qscrollbar_page_right) ||
3784 EQ (fun, Qscrollbar_to_left) ||
3785 EQ (fun, Qscrollbar_to_right) ||
3786 EQ (fun, Qscrollbar_horizontal_drag));
3789 #endif /* HAVE_SCROLLBARS */
3793 execute_command_event (struct command_builder *command_builder,
3796 /* This function can GC */
3797 struct console *con = XCONSOLE (command_builder->console);
3798 struct gcpro gcpro1;
3800 GCPRO1 (event); /* event may be freshly created */
3802 /* #### This call to is_scrollbar_event() isn't quite right, but
3803 fixing properly it requires more work than can go into 21.4.
3804 (We really need to split out menu, scrollbar, dialog, and other
3805 types of events from misc-user, and put the remaining ones in a
3806 new `user-eval' type that behaves like an eval event but is a
3807 user event and thus has all of its semantics -- e.g. being
3808 delayed during `accept-process-output' and similar wait states.)
3810 The real issue here is that "user events" and "command events"
3811 are not the same thing, but are very much confused in
3812 event-stream.c. User events are, essentially, any event that
3813 should be delayed by accept-process-output, should terminate a
3814 sit-for, etc. -- basically, any event that needs to be processed
3815 synchronously with key and mouse events. Command events are
3816 those that participate in command building; scrollbar events
3817 clearly don't belong because they should be transparent in a
3818 sequence like C-x @ h <scrollbar-drag> x, which used to cause a
3819 crash before checks similar to the is_scrollbar_event() call were
3820 added. Do other events belong with scrollbar events? I'm not
3821 sure; we need to categorize all misc-user events and see what
3822 their semantics are.
3824 (You might ask, why do scrollbar events need to be user events?
3825 That's a good question. The answer seems to be that they can
3826 change point, and having this happen asynchronously would be a
3827 very bad idea. According to the "proper" functioning of
3828 scrollbars, this should not happen, but XEmacs does not allow
3829 point to go outside of the window.)
3831 Scrollbar events and similar non-command events should obviously
3832 not be recorded in this-command-keys, so we need to check for
3835 #### We call reset_current_events() twice in this function --
3836 #### here, and later as a result of reset_this_command_keys().
3837 #### This is almost certainly wrong; need to figure out what's
3840 #### We need to figure out what's really correct w.r.t. scrollbar
3841 #### events. With these new fixes in, it actually works to do
3842 #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
3843 #### (starts over at 5). We really need to be special-casing
3844 #### scrollbar events at a lower level, and not really passing
3845 #### them through the command builder at all. (e.g. do scrollbar
3846 #### events belong in macros??? doubtful; probably only the
3847 #### point movement, if any, belongs, special-cased as a
3848 #### pseudo-issued M-x goto-char command). #### Need more work
3849 #### here. Do this when separating out scrollbar events.
3852 if (!is_scrollbar_event (event))
3853 reset_current_events (command_builder);
3855 switch (XEVENT (event)->event_type)
3857 case key_press_event:
3858 Vcurrent_mouse_event = Qnil;
3860 case button_press_event:
3861 case button_release_event:
3862 case misc_user_event:
3863 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
3868 /* Store the last-command-event. The semantics of this is that it
3869 is the last event most recently involved in command-lookup. */
3870 if (!EVENTP (Vlast_command_event))
3871 Vlast_command_event = Fmake_event (Qnil, Qnil);
3872 if (XEVENT (Vlast_command_event)->event_type == dead_event)
3874 Vlast_command_event = Fmake_event (Qnil, Qnil);
3875 error ("Someone deallocated the last-command-event!");
3878 if (! EQ (event, Vlast_command_event))
3879 Fcopy_event (event, Vlast_command_event);
3881 /* Note that last-command-char will never have its high-bit set, in
3882 an effort to sidestep the ambiguity between M-x and oslash. */
3883 Vlast_command_char = Fevent_to_character (Vlast_command_event,
3886 /* Actually call the command, with all sorts of hair to preserve or clear
3887 the echo-area and region as appropriate and call the pre- and post-
3890 int old_kbd_macro = con->kbd_macro_end;
3891 struct window *w = XWINDOW (Fselected_window (Qnil));
3893 /* We're executing a new command, so the old value is irrelevant. */
3894 zmacs_region_stays = 0;
3896 /* If the previous command tried to force a specific window-start,
3897 reset the flag in case this command moves point far away from
3898 that position. Also, reset the window's buffer's change
3899 information so that we don't trigger an incremental update. */
3903 buffer_reset_changes (XBUFFER (w->buffer));
3906 pre_command_hook ();
3908 if (XEVENT (event)->event_type == misc_user_event)
3910 call1 (XEVENT (event)->event.eval.function,
3911 XEVENT (event)->event.eval.object);
3915 Fcommand_execute (Vthis_command, Qnil, Qnil);
3918 post_command_hook ();
3920 if (!NILP (con->prefix_arg))
3922 /* Commands that set the prefix arg don't update last-command, don't
3923 reset the echoing state, and don't go into keyboard macros unless
3924 followed by another command. Also don't quit here. */
3925 int speccount = specpdl_depth ();
3926 specbind (Qinhibit_quit, Qt);
3927 maybe_echo_keys (command_builder, 0);
3928 unbind_to (speccount, Qnil);
3930 /* If we're recording a keyboard macro, and the last command
3931 executed set a prefix argument, then decrement the pointer to
3932 the "last character really in the macro" to be just before this
3933 command. This is so that the ^U in "^U ^X )" doesn't go onto
3934 the end of macro. */
3935 if (!NILP (con->defining_kbd_macro))
3936 con->kbd_macro_end = old_kbd_macro;
3940 /* Start a new command next time */
3941 Vlast_command = Vthis_command;
3942 Vlast_command_properties = Vthis_command_properties;
3943 Vthis_command_properties = Qnil;
3945 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
3946 so we don't either */
3948 if (!is_scrollbar_event (event))
3949 reset_this_command_keys (make_console (con), 0);
3956 /* Run the pre command hook. */
3959 pre_command_hook (void)
3961 last_point_position = BUF_PT (current_buffer);
3962 XSETBUFFER (last_point_position_buffer, current_buffer);
3963 /* This function can GC */
3964 safe_run_hook_trapping_errors
3965 ("Error in `pre-command-hook' (setting hook to nil)",
3966 Qpre_command_hook, 1);
3968 /* This is a kludge, but necessary; see simple.el */
3969 call0 (Qhandle_pre_motion_command);
3972 /* Run the post command hook. */
3975 post_command_hook (void)
3977 /* This function can GC */
3978 /* Turn off region highlighting unless this command requested that
3979 it be left on, or we're in the minibuffer. We don't turn it off
3980 when we're in the minibuffer so that things like M-x write-region
3983 This could be done via a function on the post-command-hook, but
3984 we don't want the user to accidentally remove it.
3987 Lisp_Object win = Fselected_window (Qnil);
3989 /* If the last command deleted the frame, `win' might be nil.
3990 It seems safest to do nothing in this case. */
3991 /* Note: Someone added the following comment and put #if 0's around
3992 this code, not realizing that doing this invites a crash in the
3994 /* #### This doesn't really fix the problem,
3995 if delete-frame is called by some hook */
3999 /* This is a kludge, but necessary; see simple.el */
4000 call0 (Qhandle_post_motion_command);
4002 if (! zmacs_region_stays
4003 && (!MINI_WINDOW_P (XWINDOW (win))
4004 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
4005 zmacs_deactivate_region ();
4007 zmacs_update_region ();
4009 safe_run_hook_trapping_errors
4010 ("Error in `post-command-hook' (setting hook to nil)",
4011 Qpost_command_hook, 1);
4013 /* #### Kludge!!! This is necessary to make sure that things
4014 are properly positioned even if post-command-hook moves point.
4015 #### There should be a cleaner way of handling this. */
4016 call0 (Qauto_show_make_point_visible);
4020 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4021 Given an event object EVENT as returned by `next-event', execute it.
4023 Key-press, button-press, and button-release events get accumulated
4024 until a complete key sequence (see `read-key-sequence') is reached,
4025 at which point the sequence is looked up in the current keymaps and
4028 Mouse motion events cause the low-level handling function stored in
4029 `mouse-motion-handler' to be called. (There are very few circumstances
4030 under which you should change this handler. Use `mode-motion-hook'
4033 Menu, timeout, and eval events cause the associated function or handler
4036 Process events cause the subprocess's output to be read and acted upon
4037 appropriately (see `start-process').
4039 Magic events are handled as necessary.
4043 /* This function can GC */
4044 struct command_builder *command_builder;
4046 Lisp_Object console;
4047 Lisp_Object channel;
4049 CHECK_LIVE_EVENT (event);
4050 ev = XEVENT (event);
4052 /* events on dead channels get silently eaten */
4053 channel = EVENT_CHANNEL (ev);
4054 if (object_dead_p (channel))
4057 /* Some events don't have channels (e.g. eval events). */
4058 console = CDFW_CONSOLE (channel);
4060 console = Vselected_console;
4061 else if (!EQ (console, Vselected_console))
4062 Fselect_console (console);
4064 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4065 switch (XEVENT (event)->event_type)
4067 case button_press_event:
4068 case button_release_event:
4069 case key_press_event:
4071 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4074 /* Incomplete key sequence */
4078 /* At this point, we know that the sequence is not bound to a
4079 command. Normally, we beep and print a message informing the
4080 user of this. But we do not beep or print a message when:
4082 o the last event in this sequence is a mouse-up event; or
4083 o the last event in this sequence is a mouse-down event and
4084 there is a binding for the mouse-up version.
4086 That is, if the sequence ``C-x button1'' is typed, and is not
4087 bound to a command, but the sequence ``C-x button1up'' is bound
4088 to a command, we do not complain about the ``C-x button1''
4089 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4090 bound to a command, then we complain about the ``C-x button1''
4091 sequence, but later will *not* complain about the
4092 ``C-x button1up'' sequence, which would be redundant.
4094 This is pretty hairy, but I think it's the most intuitive
4097 Lisp_Object terminal = command_builder->most_current_event;
4099 if (XEVENT_TYPE (terminal) == button_press_event)
4102 /* Temporarily pretend the last event was an "up" instead of a
4103 "down", and look up its binding. */
4104 XEVENT_TYPE (terminal) = button_release_event;
4105 /* If the "up" version is bound, don't complain. */
4107 = !NILP (command_builder_find_leaf (command_builder, 0));
4108 /* Undo the temporary changes we just made. */
4109 XEVENT_TYPE (terminal) = button_press_event;
4112 /* Pretend this press was not seen (treat as a prefix) */
4113 if (EQ (command_builder->current_events, terminal))
4115 reset_current_events (command_builder);
4121 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4122 if (EQ (XEVENT_NEXT (eve), terminal))
4125 Fdeallocate_event (command_builder->
4126 most_current_event);
4127 XSET_EVENT_NEXT (eve, Qnil);
4128 command_builder->most_current_event = eve;
4130 maybe_echo_keys (command_builder, 1);
4135 /* Complain that the typed sequence is not defined, if this is the
4136 kind of sequence that warrants a complaint. */
4137 XCONSOLE (console)->defining_kbd_macro = Qnil;
4138 XCONSOLE (console)->prefix_arg = Qnil;
4139 /* Don't complain about undefined button-release events */
4140 if (XEVENT_TYPE (terminal) != button_release_event)
4142 Lisp_Object keys = current_events_into_vector (command_builder);
4143 struct gcpro gcpro1;
4145 /* Run the pre-command-hook before barfing about an undefined
4147 Vthis_command = Qnil;
4149 pre_command_hook ();
4151 /* The post-command-hook doesn't run. */
4152 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4154 /* Reset the command builder for reading the next sequence. */
4155 reset_this_command_keys (console, 1);
4157 else /* key sequence is bound to a command */
4160 int magic_undo_count = 20;
4162 Vthis_command = leaf;
4164 /* Don't push an undo boundary if the command set the prefix arg,
4165 or if we are executing a keyboard macro, or if in the
4166 minibuffer. If the command we are about to execute is
4167 self-insert, it's tricky: up to 20 consecutive self-inserts may
4168 be done without an undo boundary. This counter is reset as
4169 soon as a command other than self-insert-command is executed.
4171 Programmers can also use the `self-insert-defer-undo'
4172 property to install that behavior on functions other
4173 than `self-insert-command', or to change the magic
4174 number 20 to something else. #### DOCUMENT THIS! */
4178 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
4180 magic_undo = 1, magic_undo_count = XINT (prop);
4181 else if (!NILP (prop))
4183 else if (EQ (leaf, Qself_insert_command))
4188 command_builder->self_insert_countdown = 0;
4189 if (NILP (XCONSOLE (console)->prefix_arg)
4190 && NILP (Vexecuting_macro)
4191 && command_builder->self_insert_countdown == 0)
4196 if (--command_builder->self_insert_countdown < 0)
4197 command_builder->self_insert_countdown = magic_undo_count;
4199 execute_command_event
4201 internal_equal (event, command_builder->most_current_event, 0)
4203 /* Use the translated event that was most recently seen.
4204 This way, last-command-event becomes f1 instead of
4205 the P from ESC O P. But we must copy it, else we'll
4206 lose when the command-builder events are deallocated. */
4207 : Fcopy_event (command_builder->most_current_event, Qnil));
4211 case misc_user_event:
4215 We could just always use the menu item entry, whatever it is, but
4216 this might break some Lisp code that expects `this-command' to
4217 always contain a symbol. So only store it if this is a simple
4218 `call-interactively' sort of menu item.
4220 But this is bogus. `this-command' could be a string or vector
4221 anyway (for keyboard macros). There's even one instance
4222 (in pending-del.el) of `this-command' getting set to a cons
4223 (a lambda expression). So in the `eval' case I'll just
4224 convert it into a lambda expression.
4226 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4227 && SYMBOLP (XEVENT (event)->event.eval.object))
4228 Vthis_command = XEVENT (event)->event.eval.object;
4229 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4231 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4232 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4233 /* A scrollbar command or the like. */
4234 Vthis_command = XEVENT (event)->event.eval.function;
4237 Vthis_command = Qnil;
4239 /* clear the echo area */
4240 reset_key_echo (command_builder, 1);
4242 command_builder->self_insert_countdown = 0;
4243 if (NILP (XCONSOLE (console)->prefix_arg)
4244 && NILP (Vexecuting_macro)
4245 && !EQ (minibuf_window, Fselected_window (Qnil)))
4247 execute_command_event (command_builder, event);
4252 execute_internal_event (event);
4259 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4260 Read a sequence of keystrokes or mouse clicks.
4261 Returns a vector of the event objects read. The vector and the event
4262 objects it contains are freshly created (and so will not be side-effected
4263 by subsequent calls to this function).
4265 The sequence read is sufficient to specify a non-prefix command starting
4266 from the current local and global keymaps. A C-g typed while in this
4267 function is treated like any other character, and `quit-flag' is not set.
4269 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4271 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
4272 continuation of the previous key.
4274 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
4275 last event to lower case. (Normally any upper case event is converted
4276 to lower case if the original event is undefined and the lower case
4277 equivalent is defined.) This argument is provided mostly for FSF
4278 compatibility; the equivalent effect can be achieved more generally by
4279 binding `retry-undefined-key-binding-unshifted' to nil around the call
4280 to `read-key-sequence'.
4282 If the user selects a menu item while we are prompting for a key-sequence,
4283 the returned value will be a vector of a single menu-selection event.
4284 An error will be signalled if you pass this value to `lookup-key' or a
4287 `read-key-sequence' checks `function-key-map' for function key
4288 sequences, where they wouldn't conflict with ordinary bindings.
4289 See `function-key-map' for more details.
4291 (prompt, continue_echo, dont_downcase_last))
4293 /* This function can GC */
4294 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4298 struct command_builder *command_builder =
4299 XCOMMAND_BUILDER (con->command_builder);
4301 Lisp_Object event = Fmake_event (Qnil, Qnil);
4302 int speccount = specpdl_depth ();
4303 struct gcpro gcpro1;
4306 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4308 CHECK_STRING (prompt);
4309 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4312 if (NILP (continue_echo))
4313 reset_this_command_keys (make_console (con), 1);
4315 specbind (Qinhibit_quit, Qt);
4317 if (!NILP (dont_downcase_last))
4318 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4322 Fnext_event (event, prompt);
4323 /* restore the selected-console damage */
4324 con = event_console_or_selected (event);
4325 command_builder = XCOMMAND_BUILDER (con->command_builder);
4326 if (! command_event_p (event))
4327 execute_internal_event (event);
4330 if (XEVENT (event)->event_type == misc_user_event)
4331 reset_current_events (command_builder);
4332 result = lookup_command_event (command_builder, event, 1);
4333 if (!KEYMAPP (result))
4335 result = current_events_into_vector (command_builder);
4336 reset_key_echo (command_builder, 0);
4343 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4344 Fdeallocate_event (event);
4345 RETURN_UNGCPRO (unbind_to (speccount, result));
4348 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4349 Return a vector of the keyboard or mouse button events that were used
4350 to invoke this command. This copies the vector and the events; it is safe
4351 to keep and modify them.
4359 if (NILP (Vthis_command_keys))
4360 return make_vector (0, Qnil);
4362 len = event_chain_count (Vthis_command_keys);
4364 result = make_vector (len, Qnil);
4366 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4367 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4371 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4372 Used for complicated reasons in `universal-argument-other-key'.
4374 `universal-argument-other-key' rereads the event just typed.
4375 It then gets translated through `function-key-map'.
4376 The translated event gets included in the echo area and in
4377 the value of `this-command-keys' in addition to the raw original event.
4380 Calling this function directs the translated event to replace
4381 the original event, so that only one version of the event actually
4382 appears in the echo area and in the value of `this-command-keys'.
4386 /* #### I don't understand this at all, so currently it does nothing.
4387 If there is ever a problem, maybe someone should investigate. */
4393 dribble_out_event (Lisp_Object event)
4395 if (NILP (Vdribble_file))
4398 if (XEVENT (event)->event_type == key_press_event &&
4399 !XEVENT (event)->event.key.modifiers)
4401 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4402 if (CHARP (XEVENT (event)->event.key.keysym))
4404 Emchar ch = XCHAR (keysym);
4405 Bufbyte str[MAX_EMCHAR_LEN];
4406 Bytecount len = set_charptr_emchar (str, ch);
4407 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4409 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4410 /* one-char key events are printed with just the key name */
4411 Fprinc (keysym, Vdribble_file);
4412 else if (EQ (keysym, Qreturn))
4413 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4414 else if (EQ (keysym, Qspace))
4415 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4417 Fprinc (event, Vdribble_file);
4420 Fprinc (event, Vdribble_file);
4421 Lstream_flush (XLSTREAM (Vdribble_file));
4424 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4425 "FOpen dribble file: ", /*
4426 Start writing all keyboard characters to a dribble file called FILENAME.
4427 If FILENAME is nil, close any open dribble file.
4431 /* This function can GC */
4432 /* XEmacs change: always close existing dribble file. */
4433 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4434 if (!NILP (Vdribble_file))
4436 Lstream_close (XLSTREAM (Vdribble_file));
4437 Vdribble_file = Qnil;
4439 if (!NILP (filename))
4443 filename = Fexpand_file_name (filename, Qnil);
4444 fd = open ((char*) XSTRING_DATA (filename),
4445 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4448 error ("Unable to create dribble file");
4449 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4452 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4453 Fget_coding_system (Qescape_quoted));
4461 DEFUN ("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
4462 Return the current event timestamp of the window system associated with CONSOLE.
4463 CONSOLE defaults to the selected console if omitted.
4467 struct console *c = decode_console (console);
4468 int tiempo = event_stream_current_event_timestamp (c);
4470 /* This junk is so that timestamps don't get to be negative, but contain
4471 as many bits as this particular emacs will allow.
4473 return make_int (((1L << (VALBITS - 1)) - 1) & tiempo);
4477 /************************************************************************/
4478 /* initialization */
4479 /************************************************************************/
4482 syms_of_event_stream (void)
4484 INIT_LRECORD_IMPLEMENTATION (command_builder);
4485 INIT_LRECORD_IMPLEMENTATION (timeout);
4487 defsymbol (&Qdisabled, "disabled");
4488 defsymbol (&Qcommand_event_p, "command-event-p");
4490 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qinvalid_argument);
4492 DEFSUBR (Frecent_keys);
4493 DEFSUBR (Frecent_keys_ring_size);
4494 DEFSUBR (Fset_recent_keys_ring_size);
4495 DEFSUBR (Finput_pending_p);
4496 DEFSUBR (Fenqueue_eval_event);
4497 DEFSUBR (Fnext_event);
4498 DEFSUBR (Fnext_command_event);
4499 DEFSUBR (Fdiscard_input);
4501 DEFSUBR (Fsleep_for);
4502 DEFSUBR (Faccept_process_output);
4503 DEFSUBR (Fadd_timeout);
4504 DEFSUBR (Fdisable_timeout);
4505 DEFSUBR (Fadd_async_timeout);
4506 DEFSUBR (Fdisable_async_timeout);
4507 DEFSUBR (Fdispatch_event);
4508 DEFSUBR (Fdispatch_non_command_events);
4509 DEFSUBR (Fread_key_sequence);
4510 DEFSUBR (Fthis_command_keys);
4511 DEFSUBR (Freset_this_command_lengths);
4512 DEFSUBR (Fopen_dribble_file);
4513 DEFSUBR (Fcurrent_event_timestamp);
4515 defsymbol (&Qpre_command_hook, "pre-command-hook");
4516 defsymbol (&Qpost_command_hook, "post-command-hook");
4517 defsymbol (&Qunread_command_events, "unread-command-events");
4518 defsymbol (&Qunread_command_event, "unread-command-event");
4519 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4520 defsymbol (&Qhandle_pre_motion_command, "handle-pre-motion-command");
4521 defsymbol (&Qhandle_post_motion_command, "handle-post-motion-command");
4522 defsymbol (&Qretry_undefined_key_binding_unshifted,
4523 "retry-undefined-key-binding-unshifted");
4524 defsymbol (&Qauto_show_make_point_visible,
4525 "auto-show-make-point-visible");
4527 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
4528 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4532 reinit_vars_of_event_stream (void)
4534 recent_keys_ring_index = 0;
4535 recent_keys_ring_size = 100;
4536 num_input_chars = 0;
4537 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4539 staticpro_nodump (&Vtimeout_free_list);
4540 the_low_level_timeout_blocktype =
4541 Blocktype_new (struct low_level_timeout_blocktype);
4542 something_happened = 0;
4543 recursive_sit_for = Qnil;
4547 vars_of_event_stream (void)
4549 reinit_vars_of_event_stream ();
4550 Vrecent_keys_ring = Qnil;
4551 staticpro (&Vrecent_keys_ring);
4553 Vthis_command_keys = Qnil;
4554 staticpro (&Vthis_command_keys);
4555 Vthis_command_keys_tail = Qnil;
4556 dump_add_root_object (&Vthis_command_keys_tail);
4558 command_event_queue = Qnil;
4559 staticpro (&command_event_queue);
4560 command_event_queue_tail = Qnil;
4561 dump_add_root_object (&command_event_queue_tail);
4563 Vlast_selected_frame = Qnil;
4564 staticpro (&Vlast_selected_frame);
4566 pending_timeout_list = Qnil;
4567 staticpro (&pending_timeout_list);
4569 pending_async_timeout_list = Qnil;
4570 staticpro (&pending_async_timeout_list);
4572 last_point_position_buffer = Qnil;
4573 staticpro (&last_point_position_buffer);
4575 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
4576 *Nonzero means echo unfinished commands after this many seconds of pause.
4578 Vecho_keystrokes = make_int (1);
4580 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
4581 *Number of keyboard input characters between auto-saves.
4582 Zero means disable autosaving due to number of characters typed.
4583 See also the variable `auto-save-timeout'.
4585 auto_save_interval = 300;
4587 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
4588 Function or functions to run before every command.
4589 This may examine the `this-command' variable to find out what command
4590 is about to be run, or may change it to cause a different command to run.
4591 Function on this hook must be careful to avoid signalling errors!
4593 Vpre_command_hook = Qnil;
4595 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
4596 Function or functions to run after every command.
4597 This may examine the `this-command' variable to find out what command
4600 Vpost_command_hook = Qnil;
4602 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
4603 Normal hook run when XEmacs it about to be idle.
4604 This occurs whenever it is going to block, waiting for an event.
4605 This generally happens as a result of a call to `next-event',
4606 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4607 or `x-get-selection'.
4608 Errors running the hook are caught and ignored.
4610 Vpre_idle_hook = Qnil;
4612 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
4613 *Variable to control XEmacs behavior with respect to focus changing.
4614 If this variable is set to t, then XEmacs will not gratuitously change
4615 the keyboard focus. XEmacs cannot in general detect when this mode is
4616 used by the window manager, so it is up to the user to set it.
4618 focus_follows_mouse = 0;
4620 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
4621 Last keyboard or mouse button event that was part of a command. This
4622 variable is off limits: you may not set its value or modify the event that
4623 is its value, as it is destructively modified by `read-key-sequence'. If
4624 you want to keep a pointer to this value, you must use `copy-event'.
4626 Vlast_command_event = Qnil;
4628 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
4629 If the value of `last-command-event' is a keyboard event, then
4630 this is the nearest ASCII equivalent to it. This is the value that
4631 `self-insert-command' will put in the buffer. Remember that there is
4632 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4633 of keyboard events is much larger, so writing code that examines this
4634 variable to determine what key has been typed is bad practice, unless
4635 you are certain that it will be one of a small set of characters.
4637 Vlast_command_char = Qnil;
4639 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
4640 Last keyboard or mouse button event received. This variable is off
4641 limits: you may not set its value or modify the event that is its value, as
4642 it is destructively modified by `next-event'. If you want to keep a pointer
4643 to this value, you must use `copy-event'.
4645 Vlast_input_event = Qnil;
4647 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
4648 The mouse-button event which invoked this command, or nil.
4649 This is usually what `(interactive "e")' returns.
4651 Vcurrent_mouse_event = Qnil;
4653 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
4654 If the value of `last-input-event' is a keyboard event, then
4655 this is the nearest ASCII equivalent to it. Remember that there is
4656 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4657 of keyboard events is much larger, so writing code that examines this
4658 variable to determine what key has been typed is bad practice, unless
4659 you are certain that it will be one of a small set of characters.
4661 Vlast_input_char = Qnil;
4663 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
4664 The time (in seconds since Jan 1, 1970) of the last-command-event,
4665 represented as a cons of two 16-bit integers. This is destructively
4666 modified, so copy it if you want to keep it.
4668 Vlast_input_time = Qnil;
4670 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
4671 The time (in seconds since Jan 1, 1970) of the last-command-event,
4672 represented as a list of three integers. The first integer contains
4673 the most significant 16 bits of the number of seconds, and the second
4674 integer contains the least significant 16 bits. The third integer
4675 contains the remainder number of microseconds, if the current system
4676 supports microsecond clock resolution. This list is destructively
4677 modified, so copy it if you want to keep it.
4679 Vlast_command_event_time = Qnil;
4681 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
4682 List of event objects to be read as next command input events.
4683 This can be used to simulate the receipt of events from the user.
4684 Normally this is nil.
4685 Events are removed from the front of this list.
4687 Vunread_command_events = Qnil;
4689 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
4690 Obsolete. Use `unread-command-events' instead.
4692 Vunread_command_event = Qnil;
4694 DEFVAR_LISP ("last-command", &Vlast_command /*
4695 The last command executed. Normally a symbol with a function definition,
4696 but can be whatever was found in the keymap, or whatever the variable
4697 `this-command' was set to by that command.
4699 Vlast_command = Qnil;
4701 DEFVAR_LISP ("this-command", &Vthis_command /*
4702 The command now being executed.
4703 The command can set this variable; whatever is put here
4704 will be in `last-command' during the following command.
4706 Vthis_command = Qnil;
4708 DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /*
4709 Value of `this-command-properties' for the last command.
4710 Used by commands to help synchronize consecutive commands, in preference
4711 to looking at `last-command' directly.
4713 Vlast_command_properties = Qnil;
4715 DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /*
4716 Properties set by the current command.
4717 At the beginning of each command, the current value of this variable is
4718 copied to `last-command-properties', and then it is set to nil. Use `putf'
4719 to add properties to this variable. Commands should use this to communicate
4720 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4721 in preference to looking at and/or setting `this-command'.
4723 Vthis_command_properties = Qnil;
4725 DEFVAR_LISP ("help-char", &Vhelp_char /*
4726 Character to recognize as meaning Help.
4727 When it is read, do `(eval help-form)', and display result if it's a string.
4728 If the value of `help-form' is nil, this char can be read normally.
4729 This can be any form recognized as a single key specifier.
4730 The help-char cannot be a negative number in XEmacs.
4732 Vhelp_char = make_char (8); /* C-h */
4734 DEFVAR_LISP ("help-form", &Vhelp_form /*
4735 Form to execute when character help-char is read.
4736 If the form returns a string, that string is displayed.
4737 If `help-form' is nil, the help char is not recognized.
4741 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
4742 Command to run when `help-char' character follows a prefix key.
4743 This command is used only when there is no actual binding
4744 for that character after that prefix key.
4746 Vprefix_help_command = Qnil;
4748 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
4749 Hash table used as translate table for keyboard input.
4750 Use `keyboard-translate' to portably add entries to this table.
4751 Each key-press event is looked up in this table as follows:
4753 -- If an entry maps a symbol to a symbol, then a key-press event whose
4754 keysym is the former symbol (with any modifiers at all) gets its
4755 keysym changed and its modifiers left alone. This is useful for
4756 dealing with non-standard X keyboards, such as the grievous damage
4757 that Sun has inflicted upon the world.
4758 -- If an entry maps a symbol to a character, then a key-press event
4759 whose keysym is the former symbol (with any modifiers at all) gets
4760 changed into a key-press event matching the latter character, and the
4761 resulting modifiers are the union of the original and new modifiers.
4762 -- If an entry maps a character to a character, then a key-press event
4763 matching the former character gets converted to a key-press event
4764 matching the latter character. This is useful on ASCII terminals
4765 for (e.g.) making C-\\ look like C-s, to get around flow-control
4767 -- If an entry maps a character to a symbol, then a key-press event
4768 matching the character gets converted to a key-press event whose
4769 keysym is the given symbol and which has no modifiers.
4771 Here's an example: This makes typing parens and braces easier by rerouting
4772 their positions to eliminate the need to use the Shift key.
4774 (keyboard-translate ?[ ?()
4775 (keyboard-translate ?] ?))
4776 (keyboard-translate ?{ ?[)
4777 (keyboard-translate ?} ?])
4778 (keyboard-translate 'f11 ?{)
4779 (keyboard-translate 'f12 ?})
4782 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
4783 &Vretry_undefined_key_binding_unshifted /*
4784 If a key-sequence which ends with a shifted keystroke is undefined
4785 and this variable is non-nil then the command lookup is retried again
4786 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
4787 If lookup still fails, a normal error is signalled. In general,
4788 you should *bind* this, not set it.
4790 Vretry_undefined_key_binding_unshifted = Qt;
4792 DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
4793 *Non-nil makes modifier keys sticky.
4794 This means that you can release the modifier key before pressing down
4795 the key that you wish to be modified. Although this is non-standard
4796 behavior, it is recommended because it reduces the strain on your hand,
4797 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4799 Modifier keys are sticky within the inverval specified by
4800 `modifier-keys-sticky-time'.
4802 modifier_keys_are_sticky = 0;
4804 DEFVAR_LISP ("modifier-keys-sticky-time", &Vmodifier_keys_sticky_time /*
4805 *Modifier keys are sticky within this many milliseconds.
4806 If you don't want modifier keys sticking to be bounded, set this to
4809 This variable has no effect when `modifier-keys-are-sticky' is nil.
4810 Currently only implemented under X Window System.
4812 Vmodifier_keys_sticky_time = make_int (500);
4815 DEFVAR_LISP ("composed-character-default-binding",
4816 &Vcomposed_character_default_binding /*
4817 The default keybinding to use for key events from composed input.
4818 Window systems frequently have ways to allow the user to compose
4819 single characters in a language using multiple keystrokes.
4820 XEmacs sees these as single character keypress events.
4822 Vcomposed_character_default_binding = Qself_insert_command;
4823 #endif /* HAVE_XIM */
4825 Vcontrolling_terminal = Qnil;
4826 staticpro (&Vcontrolling_terminal);
4828 Vdribble_file = Qnil;
4829 staticpro (&Vdribble_file);
4832 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
4833 If non-zero, display debug information about Emacs events that XEmacs sees.
4834 Information is displayed on stderr.
4836 Before the event, the source of the event is displayed in parentheses,
4837 and is one of the following:
4839 \(real) A real event from the window system or
4840 terminal driver, as far as XEmacs can tell.
4842 \(keyboard macro) An event generated from a keyboard macro.
4844 \(unread-command-events) An event taken from `unread-command-events'.
4846 \(unread-command-event) An event taken from `unread-command-event'.
4848 \(command event queue) An event taken from an internal queue.
4849 Events end up on this queue when
4850 `enqueue-eval-event' is called or when
4851 user or eval events are received while
4852 XEmacs is blocking (e.g. in `sit-for',
4853 `sleep-for', or `accept-process-output',
4854 or while waiting for the reply to an
4857 \(->keyboard-translate-table) The result of an event translated through
4858 keyboard-translate-table. Note that in
4859 this case, two events are printed even
4860 though only one is really generated.
4862 \(SIGINT) A faked C-g resulting when XEmacs receives
4863 a SIGINT (e.g. C-c was pressed in XEmacs'
4864 controlling terminal or the signal was
4865 explicitly sent to the XEmacs process).
4867 debug_emacs_events = 0;
4870 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
4871 Non-nil inhibits recording of input-events to recent-keys ring.
4873 inhibit_input_event_recording = 0;
4877 complex_vars_of_event_stream (void)
4879 Vkeyboard_translate_table =
4880 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4884 init_event_stream (void)
4888 #ifdef HAVE_UNIXOID_EVENT_LOOP
4889 init_event_unixoid ();
4891 #ifdef HAVE_X_WINDOWS
4892 if (!strcmp (display_use, "x"))
4893 init_event_Xt_late ();
4897 if (!strcmp (display_use, "gtk"))
4898 init_event_gtk_late ();
4901 #ifdef HAVE_MS_WINDOWS
4902 if (!strcmp (display_use, "mswindows"))
4903 init_event_mswindows_late ();
4907 /* For TTY's, use the Xt event loop if we can; it allows
4908 us to later open an X connection. */
4909 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
4910 || (defined (HAVE_MSG_SELECT) \
4911 && !defined (DEBUG_TTY_EVENT_STREAM)))
4912 init_event_mswindows_late ();
4913 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
4914 init_event_Xt_late ();
4915 #elif defined (HAVE_TTY)
4916 init_event_tty_late ();
4919 init_interrupts_late ();
4925 useful testcases for v18/v19 compatibility:
4929 (setq unread-command-event (character-to-event ?A (allocate-event)))
4930 (setq x (list (read-char)
4931 ; (read-key-sequence "") ; try it with and without this
4932 last-command-char last-input-char
4933 (recent-keys) (this-command-keys))))
4934 (global-set-key "\^Q" 'foo)
4936 without the read-key-sequence:
4937 ^Q ==> (?A ?\^Q ?A [... ^Q] [^Q])
4938 ^U^U^Q ==> (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
4939 ^U^U^U^G^Q ==> (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
4941 with the read-key-sequence:
4942 ^Qb ==> (?A [b] ?\^Q ?b [... ^Q b] [b])
4943 ^U^U^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
4944 ^U^U^U^G^Qb ==> (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
4946 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
4948 ;(setq x (list (read-char) quit-flag))^J^G
4949 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
4950 ;for BOTH, x should get set to (7 t), but no result should be printed.
4951 ;; #### According to the doc of quit-flag, second test should return
4952 ;; (?\^G nil). Accidentaly XEmacs returns correct value. However,
4953 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
4955 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
4956 ;in *scratch*, type (sit-for 20)^J
4957 ;wait a couple of seconds, move cursor to foo, type "a"
4958 ;a should be inserted in foo. Cursor highlighting should not change in
4961 ;do it with sleep-for. move cursor into foo, then back into *scratch*
4963 ;repeat also with (accept-process-output nil 20)
4965 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
4968 (list (condition-case c
4973 (tst)^Ja^G ==> ((quit) ?a) with no signal
4974 (tst)^J^Ga ==> ((quit) ?a) with no signal
4975 (tst)^Jabc^G ==> ((quit) ?a) with no signal, and "bc" inserted in buffer
4977 ; with sit-for only do the 2nd test.
4978 ; Do all 3 tests with (accept-process-output nil 20)
4981 (setq enable-recursive-minibuffers t
4982 minibuffer-max-depth nil)
4983 ESC ESC ESC ESC - there are now two minibuffers active
4984 C-g C-g C-g - there should be active 0, not 1
4986 C-x C-f ~ / ? - wait for "Making completion list..." to display
4987 C-g - wait for "Quit" to display
4988 C-g - minibuffer should not be active
4989 however C-g before "Quit" is displayed should leave minibuffer active.
4991 ;do it all in both v18 and v19 and make sure all results are the same.
4992 ;all of these cases matter a lot, but some in quite subtle ways.
4996 Additional test cases for accept-process-output, sleep-for, sit-for.
4997 Be sure you do all of the above checking for C-g and focus, too!
4999 ; Make sure that timer handlers are run during, not after sit-for:
5000 (defun timer-check ()
5001 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5003 (message "after sit-for"))
5005 ; The first message should appear after 2 seconds, and the final message
5006 ; 3 seconds after that.
5007 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5011 ; Make sure that process filters are run during, not after sit-for.
5013 (message "sit-for = %s" (sit-for 30)))
5014 (add-hook 'post-command-hook 'fubar)
5016 ; Now type M-x shell RET
5017 ; wait for the shell prompt then send: ls RET
5018 ; the output of ls should fill immediately, and not wait 30 seconds.
5020 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5024 ; Make sure that recursive invocations return immediately:
5025 (defmacro test-diff-time (start end)
5026 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5027 (- (cadr ,end) (cadr ,start))
5028 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5030 (defun testee (ignore)
5034 (let ((start (current-time))
5036 (add-timeout 2 'testee nil)
5038 (add-timeout 2 'testee nil)
5040 (add-timeout 2 'testee nil)
5041 (accept-process-output nil 5)
5042 (setq end (current-time))
5043 (test-diff-time start end)))
5045 (test-them) should sit for 15 seconds.
5046 Repeat with testee set to sleep-for and accept-process-output.
5047 These should each delay 36 seconds.