1 /* The portable interface to event streams.
2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Not in FSF. */
28 Created 1991 by Jamie Zawinski.
29 A great deal of work over the ages by Ben Wing (Mule-ization for 19.12,
30 device abstraction for 19.12/19.13, async timers for 19.14,
31 rewriting of focus code for 19.12, pre-idle hook for 19.12,
32 redoing of signal and quit handling for 19.9 and 19.12,
33 misc-user events to clean up menu/scrollbar handling for 19.11,
34 function-key-map/key-translation-map/keyboard-translate-table for
35 19.13/19.14, open-dribble-file for 19.13, much other cleanup).
36 focus-follows-mouse from Chuck Thompson, 1995.
37 XIM stuff by Martin Buchholz, c. 1996?.
40 /* This file has been Mule-ized. */
45 * If you ever change ANYTHING in this file, you MUST run the
46 * testcases at the end to make sure that you haven't changed
47 * the semantics of recent-keys, last-input-char, or keyboard
48 * macros. You'd be surprised how easy it is to break this.
53 This stuff is way too hard to maintain - needs rework.
55 C-x @ h <scrollbar-drag> x causes a crash.
57 The command builder should deal only with key and button events.
58 Other command events should be able to come in the MIDDLE of a key
59 sequence, without disturbing the key sequence composition, or the
60 command builder structure representing it.
62 Someone should rethink universal-argument and figure out how an
63 arbitrary command can influence the next command (universal-argument
64 or universal-coding-system-argument) or the next key (hyperify).
66 Both C-h and Help in the middle of a key sequence should trigger
67 prefix-help-command. help-char is stupid. Maybe we need
68 keymap-of-last-resort?
70 After prefix-help is run, one should be able to CONTINUE TYPING,
71 instead of RETYPING, the key sequence.
77 #include "blocktype.h"
84 #include "insdel.h" /* for buffer_reset_changes */
87 #include "macros.h" /* for defining_keyboard_macro */
88 #include "menubar.h" /* #### for evil kludges. */
92 #include "sysdep.h" /* init_poll_for_quit() */
93 #include "syssignal.h" /* SIGCHLD, etc. */
95 #include "systime.h" /* to set Vlast_input_time */
97 #include "events-mod.h"
99 #include "file-coding.h"
104 /* The number of keystrokes between auto-saves. */
105 static int auto_save_interval;
107 Lisp_Object Qundefined_keystroke_sequence;
109 Lisp_Object Qcommand_event_p;
111 /* Hooks to run before and after each command. */
112 Lisp_Object Vpre_command_hook, Vpost_command_hook;
113 Lisp_Object Qpre_command_hook, Qpost_command_hook;
116 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
118 /* Hook run when XEmacs is about to be idle. */
119 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
121 /* Control gratuitous keyboard focus throwing. */
122 int focus_follows_mouse;
124 int modifier_keys_are_sticky;
126 #if 0 /* FSF Emacs crap */
127 /* Hook run after a command if there's no more input soon. */
128 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
130 /* Delay time in microseconds before running post-command-idle-hook. */
131 int post_command_idle_delay;
133 /* List of deferred actions to be performed at a later time.
134 The precise format isn't relevant here; we just check whether it is nil. */
135 Lisp_Object Vdeferred_action_list;
137 /* Function to call to handle deferred actions, when there are any. */
138 Lisp_Object Vdeferred_action_function;
139 Lisp_Object Qdeferred_action_function;
140 #endif /* FSF Emacs crap */
142 /* Non-nil disable property on a command means
143 do not execute it; call disabled-command-hook's value instead. */
144 Lisp_Object Qdisabled, Vdisabled_command_hook;
146 EXFUN (Fnext_command_event, 2);
148 static void pre_command_hook (void);
149 static void post_command_hook (void);
151 /* Last keyboard or mouse input event read as a command. */
152 Lisp_Object Vlast_command_event;
154 /* The nearest ASCII equivalent of the above. */
155 Lisp_Object Vlast_command_char;
157 /* Last keyboard or mouse event read for any purpose. */
158 Lisp_Object Vlast_input_event;
160 /* The nearest ASCII equivalent of the above. */
161 Lisp_Object Vlast_input_char;
163 Lisp_Object Vcurrent_mouse_event;
165 /* This is fbound in cmdloop.el, see the commentary there */
166 Lisp_Object Qcancel_mode_internal;
168 /* If not Qnil, event objects to be read as the next command input */
169 Lisp_Object Vunread_command_events;
170 Lisp_Object Vunread_command_event; /* obsoleteness support */
172 static Lisp_Object Qunread_command_events, Qunread_command_event;
174 /* Previous command, represented by a Lisp object.
175 Does not include prefix commands and arg setting commands. */
176 Lisp_Object Vlast_command;
178 /* Contents of this-command-properties for the last command. */
179 Lisp_Object Vlast_command_properties;
181 /* If a command sets this, the value goes into
182 last-command for the next command. */
183 Lisp_Object Vthis_command;
185 /* If a command sets this, the value goes into
186 last-command-properties for the next command. */
187 Lisp_Object Vthis_command_properties;
189 /* The value of point when the last command was executed. */
190 Bufpos last_point_position;
192 /* The frame that was current when the last command was started. */
193 Lisp_Object Vlast_selected_frame;
195 /* The buffer that was current when the last command was started. */
196 Lisp_Object last_point_position_buffer;
198 /* A (16bit . 16bit) representation of the time of the last-command-event. */
199 Lisp_Object Vlast_input_time;
201 /* A (16bit 16bit usec) representation of the time
202 of the last-command-event. */
203 Lisp_Object Vlast_command_event_time;
205 /* Character to recognize as the help char. */
206 Lisp_Object Vhelp_char;
208 /* Form to execute when help char is typed. */
209 Lisp_Object Vhelp_form;
211 /* Command to run when the help character follows a prefix key. */
212 Lisp_Object Vprefix_help_command;
214 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
215 may have happened. */
216 volatile int something_happened;
218 /* Hash table to translate keysyms through */
219 Lisp_Object Vkeyboard_translate_table;
221 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
222 Lisp_Object Vretry_undefined_key_binding_unshifted;
223 Lisp_Object Qretry_undefined_key_binding_unshifted;
226 /* If composed input is undefined, use self-insert-char */
227 Lisp_Object Vcomposed_character_default_binding;
228 #endif /* HAVE_XIM */
230 /* Console that corresponds to our controlling terminal */
231 Lisp_Object Vcontrolling_terminal;
233 /* An event (actually an event chain linked through event_next) or Qnil.
235 Lisp_Object Vthis_command_keys;
236 Lisp_Object Vthis_command_keys_tail;
239 Lisp_Object Qauto_show_make_point_visible;
241 /* File in which we write all commands we read; an lstream */
242 static Lisp_Object Vdribble_file;
244 /* Recent keys ring location; a vector of events or nil-s */
245 Lisp_Object Vrecent_keys_ring;
246 int recent_keys_ring_size;
247 int recent_keys_ring_index;
249 /* Boolean specifying whether keystrokes should be added to
251 int inhibit_input_event_recording;
253 Lisp_Object Qself_insert_defer_undo;
255 /* this is in keymap.c */
256 extern Lisp_Object Fmake_keymap (Lisp_Object name);
259 int debug_emacs_events;
262 external_debugging_print_event (char *event_description, Lisp_Object event)
264 write_c_string ("(", Qexternal_debugging_output);
265 write_c_string (event_description, Qexternal_debugging_output);
266 write_c_string (") ", Qexternal_debugging_output);
267 print_internal (event, Qexternal_debugging_output, 1);
268 write_c_string ("\n", Qexternal_debugging_output);
270 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
271 if (debug_emacs_events) \
272 external_debugging_print_event (event_description, event); \
275 #define DEBUG_PRINT_EMACS_EVENT(string, event)
279 /* The callback routines for the window system or terminal driver */
280 struct event_stream *event_stream;
282 static void echo_key_event (struct command_builder *, Lisp_Object event);
283 static void maybe_kbd_translate (Lisp_Object event);
285 /* This structure is basically a typeahead queue: things like
286 wait-reading-process-output will delay the execution of
287 keyboard and mouse events by pushing them here.
289 Chained through event_next()
290 command_event_queue_tail is a pointer to the last-added element.
292 static Lisp_Object command_event_queue;
293 static Lisp_Object command_event_queue_tail;
295 /* Nonzero means echo unfinished commands after this many seconds of pause. */
296 static Lisp_Object Vecho_keystrokes;
298 /* The number of keystrokes since the last auto-save. */
299 static int keystrokes_since_auto_save;
301 /* Used by the C-g signal handler so that it will never "hard quit"
302 when waiting for an event. Otherwise holding down C-g could
303 cause a suspension back to the shell, which is generally
304 undesirable. (#### This doesn't fully work.) */
306 int emacs_is_blocking;
308 /* Handlers which run during sit-for, sleep-for and accept-process-output
309 are not allowed to recursively call these routines. We record here
310 if we are in that situation. */
312 static Lisp_Object recursive_sit_for;
316 /**********************************************************************/
317 /* Command-builder object */
318 /**********************************************************************/
320 #define XCOMMAND_BUILDER(x) \
321 XRECORD (x, command_builder, struct command_builder)
322 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
323 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
324 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
327 mark_command_builder (Lisp_Object obj)
329 struct command_builder *builder = XCOMMAND_BUILDER (obj);
330 mark_object (builder->prefix_events);
331 mark_object (builder->current_events);
332 mark_object (builder->most_current_event);
333 mark_object (builder->last_non_munged_event);
334 mark_object (builder->munge_me[0].first_mungeable_event);
335 mark_object (builder->munge_me[1].first_mungeable_event);
336 return builder->console;
340 finalize_command_builder (void *header, int for_disksave)
344 xfree (((struct command_builder *) header)->echo_buf);
345 ((struct command_builder *) header)->echo_buf = 0;
349 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
350 mark_command_builder, internal_object_printer,
351 finalize_command_builder, 0, 0, 0,
352 struct command_builder);
355 reset_command_builder_event_chain (struct command_builder *builder)
357 builder->prefix_events = Qnil;
358 builder->current_events = Qnil;
359 builder->most_current_event = Qnil;
360 builder->last_non_munged_event = Qnil;
361 builder->munge_me[0].first_mungeable_event = Qnil;
362 builder->munge_me[1].first_mungeable_event = Qnil;
366 allocate_command_builder (Lisp_Object console)
368 Lisp_Object builder_obj;
369 struct command_builder *builder =
370 alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
372 builder->console = console;
373 reset_command_builder_event_chain (builder);
374 builder->echo_buf_length = 300; /* #### Kludge */
375 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
376 builder->echo_buf[0] = 0;
377 builder->echo_buf_index = -1;
378 builder->echo_buf_index = -1;
379 builder->self_insert_countdown = 0;
381 XSETCOMMAND_BUILDER (builder_obj, builder);
386 command_builder_append_event (struct command_builder *builder,
389 assert (EVENTP (event));
391 if (EVENTP (builder->most_current_event))
392 XSET_EVENT_NEXT (builder->most_current_event, event);
394 builder->current_events = event;
396 builder->most_current_event = event;
397 if (NILP (builder->munge_me[0].first_mungeable_event))
398 builder->munge_me[0].first_mungeable_event = event;
399 if (NILP (builder->munge_me[1].first_mungeable_event))
400 builder->munge_me[1].first_mungeable_event = event;
404 /**********************************************************************/
405 /* Low-level interfaces onto event methods */
406 /**********************************************************************/
408 enum event_stream_operation
410 EVENT_STREAM_PROCESS,
411 EVENT_STREAM_TIMEOUT,
412 EVENT_STREAM_CONSOLE,
417 check_event_stream_ok (enum event_stream_operation op)
419 if (!event_stream && noninteractive)
423 case EVENT_STREAM_PROCESS:
424 error ("Can't start subprocesses in -batch mode");
425 case EVENT_STREAM_TIMEOUT:
426 error ("Can't add timeouts in -batch mode");
427 case EVENT_STREAM_CONSOLE:
428 error ("Can't add consoles in -batch mode");
429 case EVENT_STREAM_READ:
430 error ("Can't read events in -batch mode");
435 else if (!event_stream)
437 error ("event-stream callbacks not initialized (internal error?)");
442 event_stream_event_pending_p (int user)
444 return event_stream && event_stream->event_pending_p (user);
448 event_stream_force_event_pending (struct frame* f)
450 if (event_stream->force_event_pending)
451 event_stream->force_event_pending (f);
455 maybe_read_quit_event (Lisp_Event *event)
457 /* A C-g that came from `sigint_happened' will always come from the
458 controlling terminal. If that doesn't exist, however, then the
459 user manually sent us a SIGINT, and we pretend the C-g came from
460 the selected console. */
463 if (CONSOLEP (Vcontrolling_terminal) &&
464 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
465 con = XCONSOLE (Vcontrolling_terminal);
467 con = XCONSOLE (Fselected_console ());
471 int ch = CONSOLE_QUIT_CHAR (con);
474 character_to_event (ch, event, con, 1, 1);
475 event->channel = make_console (con);
482 event_stream_next_event (Lisp_Event *event)
484 Lisp_Object event_obj;
486 check_event_stream_ok (EVENT_STREAM_READ);
488 XSETEVENT (event_obj, event);
490 /* If C-g was pressed, treat it as a character to be read.
491 Note that if C-g was pressed while we were blocking,
492 the SIGINT signal handler will be called. It will
493 set Vquit_flag and write a byte on our "fake pipe",
494 which will unblock us. */
495 if (maybe_read_quit_event (event))
497 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
501 /* If a longjmp() happens in the callback, we're screwed.
502 Let's hope it doesn't. I think the code here is fairly
503 clean and doesn't do this. */
504 emacs_is_blocking = 1;
506 /* Do this if the poll-for-quit timer seems to be taking too
507 much CPU time when idle ... */
508 reset_poll_for_quit ();
510 event_stream->next_event_cb (event);
512 init_poll_for_quit ();
514 emacs_is_blocking = 0;
517 /* timeout events have more info set later, so
518 print the event out in next_event_internal(). */
519 if (event->event_type != timeout_event)
520 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
522 maybe_kbd_translate (event_obj);
526 event_stream_handle_magic_event (Lisp_Event *event)
528 check_event_stream_ok (EVENT_STREAM_READ);
529 event_stream->handle_magic_event_cb (event);
533 event_stream_add_timeout (EMACS_TIME timeout)
535 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
536 return event_stream->add_timeout_cb (timeout);
540 event_stream_remove_timeout (int id)
542 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
543 event_stream->remove_timeout_cb (id);
547 event_stream_select_console (struct console *con)
549 check_event_stream_ok (EVENT_STREAM_CONSOLE);
550 if (!con->input_enabled)
552 event_stream->select_console_cb (con);
553 con->input_enabled = 1;
558 event_stream_unselect_console (struct console *con)
560 check_event_stream_ok (EVENT_STREAM_CONSOLE);
561 if (con->input_enabled)
563 event_stream->unselect_console_cb (con);
564 con->input_enabled = 0;
569 event_stream_select_process (Lisp_Process *proc)
571 check_event_stream_ok (EVENT_STREAM_PROCESS);
572 if (!get_process_selected_p (proc))
574 event_stream->select_process_cb (proc);
575 set_process_selected_p (proc, 1);
580 event_stream_unselect_process (Lisp_Process *proc)
582 check_event_stream_ok (EVENT_STREAM_PROCESS);
583 if (get_process_selected_p (proc))
585 event_stream->unselect_process_cb (proc);
586 set_process_selected_p (proc, 0);
591 event_stream_create_stream_pair (void* inhandle, void* outhandle,
592 Lisp_Object* instream, Lisp_Object* outstream, int flags)
594 check_event_stream_ok (EVENT_STREAM_PROCESS);
595 return event_stream->create_stream_pair_cb
596 (inhandle, outhandle, instream, outstream, flags);
600 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
602 check_event_stream_ok (EVENT_STREAM_PROCESS);
603 return event_stream->delete_stream_pair_cb (instream, outstream);
607 event_stream_quit_p (void)
610 event_stream->quit_p_cb ();
614 event_stream_current_event_timestamp (struct console *c)
616 if (event_stream && event_stream->current_event_timestamp_cb)
617 return event_stream->current_event_timestamp_cb (c);
623 /**********************************************************************/
624 /* Character prompting */
625 /**********************************************************************/
628 echo_key_event (struct command_builder *command_builder,
631 /* This function can GC */
633 Bytecount buf_index = command_builder->echo_buf_index;
639 buf_index = 0; /* We're echoing now */
640 clear_echo_area (selected_frame (), Qnil, 0);
643 format_event_object (buf, XEVENT (event), 1);
646 if (len + buf_index + 4 > command_builder->echo_buf_length)
648 e = command_builder->echo_buf + buf_index;
649 memcpy (e, buf, len);
657 command_builder->echo_buf_index = buf_index + len + 1;
661 regenerate_echo_keys_from_this_command_keys (struct command_builder *
666 builder->echo_buf_index = 0;
668 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
669 echo_key_event (builder, event);
673 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
675 /* This function can GC */
676 double echo_keystrokes;
677 struct frame *f = selected_frame ();
678 /* Message turns off echoing unless more keystrokes turn it on again. */
679 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
682 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
683 echo_keystrokes = extract_float (Vecho_keystrokes);
687 if (minibuf_level == 0
688 && echo_keystrokes > 0.0
689 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
690 && !x_kludge_lw_menu_active ()
696 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
697 doesn't work. See check_quit. */
698 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
699 /* input came in, so don't echo. */
703 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
704 /* not echo_buf_index. That doesn't include
705 the terminating " - ". */
706 strlen ((char *) command_builder->echo_buf),
712 reset_key_echo (struct command_builder *command_builder,
713 int remove_echo_area_echo)
715 /* This function can GC */
716 struct frame *f = selected_frame ();
718 command_builder->echo_buf_index = -1;
720 if (remove_echo_area_echo)
721 clear_echo_area (f, Qcommand, 0);
725 /**********************************************************************/
727 /**********************************************************************/
730 maybe_kbd_translate (Lisp_Object event)
733 int did_translate = 0;
735 if (XEVENT_TYPE (event) != key_press_event)
737 if (!HASH_TABLEP (Vkeyboard_translate_table))
739 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
742 c = event_to_character (XEVENT (event), 0, 0, 0);
745 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
747 if (!NILP (traduit) && SYMBOLP (traduit))
749 XEVENT (event)->event.key.keysym = traduit;
750 XEVENT (event)->event.key.modifiers = 0;
753 else if (CHARP (traduit))
757 /* This used to call Fcharacter_to_event() directly into EVENT,
758 but that can eradicate timestamps and other such stuff.
759 This way is safer. */
761 character_to_event (XCHAR (traduit), &ev2,
762 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
763 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
764 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
771 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
772 Vkeyboard_translate_table, Qnil);
773 if (!NILP (traduit) && SYMBOLP (traduit))
775 XEVENT (event)->event.key.keysym = traduit;
778 else if (CHARP (traduit))
783 character_to_event (XCHAR (traduit), &ev2,
784 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
785 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
786 XEVENT (event)->event.key.modifiers |= ev2.event.key.modifiers;
793 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
797 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
798 keystrokes_since_auto_save is equivalent to the difference between
799 num_nonmacro_input_chars and last_auto_save. */
801 /* When an auto-save happens, record the "time", and don't do again soon. */
804 record_auto_save (void)
806 keystrokes_since_auto_save = 0;
809 /* Make an auto save happen as soon as possible at command level. */
812 force_auto_save_soon (void)
814 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
817 record_asynch_buffer_change ();
822 maybe_do_auto_save (void)
824 /* This function can call lisp */
825 keystrokes_since_auto_save++;
826 if (auto_save_interval > 0 &&
827 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
828 !detect_input_pending ())
830 Fdo_auto_save (Qnil, Qnil);
836 print_help (Lisp_Object object)
838 Fprinc (object, Qnil);
843 execute_help_form (struct command_builder *command_builder,
846 /* This function can GC */
847 Lisp_Object help = Qnil;
848 int speccount = specpdl_depth ();
849 Bytecount buf_index = command_builder->echo_buf_index;
850 Lisp_Object echo = ((buf_index <= 0)
852 : make_string (command_builder->echo_buf,
854 struct gcpro gcpro1, gcpro2;
857 record_unwind_protect (save_window_excursion_unwind,
858 Fcurrent_window_configuration (Qnil));
859 reset_key_echo (command_builder, 1);
861 help = Feval (Vhelp_form);
863 internal_with_output_to_temp_buffer (build_string ("*Help*"),
864 print_help, help, Qnil);
865 Fnext_command_event (event, Qnil);
866 /* Remove the help from the frame */
867 unbind_to (speccount, Qnil);
868 /* Hmmmm. Tricky. The unbind restores an old window configuration,
869 apparently bypassing any setting of windows_structure_changed.
870 So we need to set it so that things get redrawn properly. */
871 /* #### This is massive overkill. Look at doing it better once the
872 new redisplay is fully in place. */
874 Lisp_Object frmcons, devcons, concons;
875 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
877 struct frame *f = XFRAME (XCAR (frmcons));
878 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
883 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
885 /* Discard next key if it is a space */
886 reset_key_echo (command_builder, 1);
887 Fnext_command_event (event, Qnil);
890 command_builder->echo_buf_index = buf_index;
892 memcpy (command_builder->echo_buf,
893 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
898 /**********************************************************************/
900 /**********************************************************************/
903 detect_input_pending (void)
905 /* Always call the event_pending_p hook even if there's an unread
906 character, because that might do some needed ^G detection (on
907 systems without SIGIO, for example).
909 if (event_stream_event_pending_p (1))
911 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
913 if (!NILP (command_event_queue))
917 EVENT_CHAIN_LOOP (event, command_event_queue)
919 if (XEVENT_TYPE (event) != eval_event
920 && XEVENT_TYPE (event) != magic_eval_event)
927 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
928 Return t if command input is currently available with no waiting.
929 Actually, the value is nil only if we can be sure that no input is available.
933 return detect_input_pending () ? Qt : Qnil;
937 /**********************************************************************/
939 /**********************************************************************/
941 /**** Low-level timeout functions. ****
943 These functions maintain a sorted list of one-shot timeouts (where
944 the timeouts are in absolute time). They are intended for use by
945 functions that need to convert a list of absolute timeouts into a
946 series of intervals to wait for. */
948 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
949 used to indicate an absence of a timer. */
950 static int low_level_timeout_id_tick;
952 static struct low_level_timeout_blocktype
954 Blocktype_declare (struct low_level_timeout);
955 } *the_low_level_timeout_blocktype;
957 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
958 a unique ID identifying the timeout. */
961 add_low_level_timeout (struct low_level_timeout **timeout_list,
964 struct low_level_timeout *tm;
965 struct low_level_timeout *t, **tt;
967 /* Allocate a new time struct. */
969 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
971 if (low_level_timeout_id_tick == 0)
972 low_level_timeout_id_tick++;
973 tm->id = low_level_timeout_id_tick++;
976 /* Add it to the queue. */
980 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
991 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
992 If the timeout is not there, do nothing. */
995 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
997 struct low_level_timeout *t, *prev;
1001 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
1005 return; /* couldn't find it */
1008 *timeout_list = t->next;
1009 else prev->next = t->next;
1011 Blocktype_free (the_low_level_timeout_blocktype, t);
1014 /* If there are timeouts on TIMEOUT_LIST, store the relative time
1015 interval to the first timeout on the list into INTERVAL and
1016 return 1. Otherwise, return 0. */
1019 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
1020 EMACS_TIME *interval)
1022 if (!timeout_list) /* no timer events; block indefinitely */
1026 EMACS_TIME current_time;
1028 /* The time to block is the difference between the first
1029 (earliest) timer on the queue and the current time.
1030 If that is negative, then the timer will fire immediately
1031 but we still have to call select(), with a zero-valued
1032 timeout: user events must have precedence over timer events. */
1033 EMACS_GET_TIME (current_time);
1034 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1035 EMACS_SUB_TIME (*interval, timeout_list->time,
1038 EMACS_SET_SECS_USECS (*interval, 0, 0);
1043 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1044 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1045 timeout into TIME_OUT. */
1048 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1049 EMACS_TIME *time_out)
1051 struct low_level_timeout *tm = *timeout_list;
1057 *time_out = tm->time;
1058 *timeout_list = tm->next;
1059 Blocktype_free (the_low_level_timeout_blocktype, tm);
1064 /**** High-level timeout functions. ****/
1066 static int timeout_id_tick;
1068 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1070 static Lisp_Object Vtimeout_free_list;
1073 mark_timeout (Lisp_Object obj)
1075 Lisp_Timeout *tm = XTIMEOUT (obj);
1076 mark_object (tm->function);
1080 /* Should never, ever be called. (except by an external debugger) */
1082 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1084 const Lisp_Timeout *t = XTIMEOUT (obj);
1087 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
1089 write_c_string (buf, printcharfun);
1092 static const struct lrecord_description timeout_description[] = {
1093 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1094 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1098 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
1099 mark_timeout, print_timeout,
1100 0, 0, 0, timeout_description, Lisp_Timeout);
1102 /* Generate a timeout and return its ID. */
1105 event_stream_generate_wakeup (unsigned int milliseconds,
1106 unsigned int vanilliseconds,
1107 Lisp_Object function, Lisp_Object object,
1110 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
1111 Lisp_Timeout *timeout = XTIMEOUT (op);
1112 EMACS_TIME current_time;
1113 EMACS_TIME interval;
1115 timeout->id = timeout_id_tick++;
1116 timeout->resignal_msecs = vanilliseconds;
1117 timeout->function = function;
1118 timeout->object = object;
1120 EMACS_GET_TIME (current_time);
1121 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1122 1000 * (milliseconds % 1000));
1123 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1127 timeout->interval_id =
1128 event_stream_add_async_timeout (timeout->next_signal_time);
1129 pending_async_timeout_list = noseeum_cons (op,
1130 pending_async_timeout_list);
1134 timeout->interval_id =
1135 event_stream_add_timeout (timeout->next_signal_time);
1136 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
1141 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1142 as necessary and return the timeout's ID and function and object slots.
1144 This should be called as a result of receiving notice that a timeout
1145 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1146 identifies this particular firing of the timeout. INTERVAL-ID's and
1147 timeout ID's are in separate number spaces and bear no relation to
1148 each other. The INTERVAL-ID is all that the event callback routines
1149 work with: they work only with one-shot intervals, not with timeouts
1150 that may fire repeatedly.
1152 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1156 event_stream_resignal_wakeup (int interval_id, int async_p,
1157 Lisp_Object *function, Lisp_Object *object)
1159 Lisp_Object op = Qnil, rest;
1160 Lisp_Timeout *timeout;
1161 Lisp_Object *timeout_list;
1162 struct gcpro gcpro1;
1165 GCPRO1 (op); /* just in case ... because it's removed from the list
1168 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1170 /* Find the timeout on the list of pending ones. */
1171 LIST_LOOP (rest, *timeout_list)
1173 timeout = XTIMEOUT (XCAR (rest));
1174 if (timeout->interval_id == interval_id)
1178 assert (!NILP (rest));
1180 timeout = XTIMEOUT (op);
1181 /* We make sure to snarf the data out of the timeout object before
1182 we free it with free_managed_lcrecord(). */
1184 *function = timeout->function;
1185 *object = timeout->object;
1187 /* Remove this one from the list of pending timeouts */
1188 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1190 /* If this timeout wants to be resignalled, do it now. */
1191 if (timeout->resignal_msecs)
1193 EMACS_TIME current_time;
1194 EMACS_TIME interval;
1196 /* Determine the time that the next resignalling should occur.
1197 We do that by adding the interval time to the last signalled
1198 time until we get a time that's current.
1200 (This way, it doesn't matter if the timeout was signalled
1201 exactly when we asked for it, or at some time later.)
1203 EMACS_GET_TIME (current_time);
1204 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
1205 1000 * (timeout->resignal_msecs % 1000));
1208 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1210 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1213 timeout->interval_id =
1214 event_stream_add_async_timeout (timeout->next_signal_time);
1216 timeout->interval_id =
1217 event_stream_add_timeout (timeout->next_signal_time);
1218 /* Add back onto the list. Note that the effect of this
1219 is to move frequently-hit timeouts to the front of the
1220 list, which is a good thing. */
1221 *timeout_list = noseeum_cons (op, *timeout_list);
1224 free_managed_lcrecord (Vtimeout_free_list, op);
1231 event_stream_disable_wakeup (int id, int async_p)
1233 Lisp_Timeout *timeout = 0;
1235 Lisp_Object *timeout_list;
1238 timeout_list = &pending_async_timeout_list;
1240 timeout_list = &pending_timeout_list;
1242 /* Find the timeout on the list of pending ones, if it's still there. */
1243 LIST_LOOP (rest, *timeout_list)
1245 timeout = XTIMEOUT (XCAR (rest));
1246 if (timeout->id == id)
1250 /* If we found it, remove it from the list and disable the pending
1254 Lisp_Object op = XCAR (rest);
1256 delq_no_quit_and_free_cons (op, *timeout_list);
1258 event_stream_remove_async_timeout (timeout->interval_id);
1260 event_stream_remove_timeout (timeout->interval_id);
1261 free_managed_lcrecord (Vtimeout_free_list, op);
1266 event_stream_wakeup_pending_p (int id, int async_p)
1268 Lisp_Timeout *timeout;
1270 Lisp_Object timeout_list;
1275 timeout_list = pending_async_timeout_list;
1277 timeout_list = pending_timeout_list;
1279 /* Find the element on the list of pending ones, if it's still there. */
1280 LIST_LOOP (rest, timeout_list)
1282 timeout = XTIMEOUT (XCAR (rest));
1283 if (timeout->id == id)
1294 /**** Asynch. timeout functions (see also signal.c) ****/
1296 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1297 extern int poll_for_quit_id;
1300 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1301 extern int poll_for_sigchld_id;
1305 event_stream_deal_with_async_timeout (int interval_id)
1307 /* This function can GC */
1308 Lisp_Object humpty, dumpty;
1309 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1310 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1313 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1315 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1316 if (id == poll_for_quit_id)
1318 quit_check_signal_happened = 1;
1319 quit_check_signal_tick_count++;
1324 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1325 if (id == poll_for_sigchld_id)
1327 kick_status_notify ();
1332 /* call1 GC-protects its arguments */
1333 call1_trapping_errors ("Error in asynchronous timeout callback",
1338 /**** Lisp-level timeout functions. ****/
1340 static unsigned long
1341 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1343 #ifdef LISP_FLOAT_TYPE
1345 CHECK_INT_OR_FLOAT (secs);
1346 fsecs = XFLOATINT (secs);
1350 fsecs = XINT (secs);
1353 signal_simple_error ("timeout is negative", secs);
1354 if (!allow_0 && fsecs == 0)
1355 signal_simple_error ("timeout is non-positive", secs);
1356 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1358 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1360 return (unsigned long) (1000 * fsecs);
1363 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1364 Add a timeout, to be signaled after the timeout period has elapsed.
1365 SECS is a number of seconds, expressed as an integer or a float.
1366 FUNCTION will be called after that many seconds have elapsed, with one
1367 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1368 then after this timeout expires, `add-timeout' will automatically be called
1369 again with RESIGNAL as the first argument.
1371 This function returns an object which is the id number of this particular
1372 timeout. You can pass that object to `disable-timeout' to turn off the
1373 timeout before it has been signalled.
1375 NOTE: Id numbers as returned by this function are in a distinct namespace
1376 from those returned by `add-async-timeout'. This means that the same id
1377 number could refer to a pending synchronous timeout and a different pending
1378 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1379 to `disable-async-timeout', or vice-versa.
1381 The number of seconds may be expressed as a floating-point number, in which
1382 case some fractional part of a second will be used. Caveat: the usable
1383 timeout granularity will vary from system to system.
1385 Adding a timeout causes a timeout event to be returned by `next-event', and
1386 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1387 loop, the function will not be invoked until the next call to sit-for or
1388 until the return to top-level (the same is true of process filters).
1390 If you need to have a timeout executed even when XEmacs is in the midst of
1391 running Lisp code, use `add-async-timeout'.
1393 WARNING: if you are thinking of calling add-timeout from inside of a
1394 callback function as a way of resignalling a timeout, think again. There
1395 is a race condition. That's why the RESIGNAL argument exists.
1397 (secs, function, object, resignal))
1399 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1400 unsigned long msecs2 = (NILP (resignal) ? 0 :
1401 lisp_number_to_milliseconds (resignal, 0));
1404 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1405 lid = make_int (id);
1406 if (id != XINT (lid)) abort ();
1410 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1411 Disable a timeout from signalling any more.
1412 ID should be a timeout id number as returned by `add-timeout'. If ID
1413 corresponds to a one-shot timeout that has already signalled, nothing
1416 It will not work to call this function on an id number returned by
1417 `add-async-timeout'. Use `disable-async-timeout' for that.
1422 event_stream_disable_wakeup (XINT (id), 0);
1426 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1427 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1428 SECS is a number of seconds, expressed as an integer or a float.
1429 FUNCTION will be called after that many seconds have elapsed, with one
1430 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1431 then after this timeout expires, `add-async-timeout' will automatically be
1432 called again with RESIGNAL as the first argument.
1434 This function returns an object which is the id number of this particular
1435 timeout. You can pass that object to `disable-async-timeout' to turn off
1436 the timeout before it has been signalled.
1438 NOTE: Id numbers as returned by this function are in a distinct namespace
1439 from those returned by `add-timeout'. This means that the same id number
1440 could refer to a pending synchronous timeout and a different pending
1441 asynchronous timeout, and that you cannot pass an id from
1442 `add-async-timeout' to `disable-timeout', or vice-versa.
1444 The number of seconds may be expressed as a floating-point number, in which
1445 case some fractional part of a second will be used. Caveat: the usable
1446 timeout granularity will vary from system to system.
1448 Adding an asynchronous timeout causes the function to be invoked as soon
1449 as the timeout occurs, even if XEmacs is in the midst of executing some
1450 other code. (This is unlike the synchronous timeouts added with
1451 `add-timeout', where the timeout will only be signalled when XEmacs is
1452 waiting for events, i.e. the next return to top-level or invocation of
1453 `sit-for' or related functions.) This means that the function that is
1454 called *must* not signal an error or change any global state (e.g. switch
1455 buffers or windows) except when locking code is in place to make sure
1456 that race conditions don't occur in the interaction between the
1457 asynchronous timeout function and other code.
1459 Under most circumstances, you should use `add-timeout' instead, as it is
1460 much safer. Asynchronous timeouts should only be used when such behavior
1461 is really necessary.
1463 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1464 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1465 asynchronous timeouts will get called immediately. (Multiple occurrences
1466 of the same asynchronous timeout are not queued, however.) While the
1467 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1468 is automatically bound to non-nil, and thus other asynchronous timeouts
1469 will be blocked unless the callback function explicitly sets `inhibit-quit'
1472 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1473 callback function as a way of resignalling a timeout, think again. There
1474 is a race condition. That's why the RESIGNAL argument exists.
1476 (secs, function, object, resignal))
1478 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1479 unsigned long msecs2 = (NILP (resignal) ? 0 :
1480 lisp_number_to_milliseconds (resignal, 0));
1483 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1484 lid = make_int (id);
1485 if (id != XINT (lid)) abort ();
1489 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1490 Disable an asynchronous timeout from signalling any more.
1491 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1492 corresponds to a one-shot timeout that has already signalled, nothing
1495 It will not work to call this function on an id number returned by
1496 `add-timeout'. Use `disable-timeout' for that.
1501 event_stream_disable_wakeup (XINT (id), 1);
1506 /**********************************************************************/
1507 /* enqueuing and dequeuing events */
1508 /**********************************************************************/
1510 /* Add an event to the back of the command-event queue: it will be the next
1511 event read after all pending events. This only works on keyboard,
1512 mouse-click, misc-user, and eval events.
1515 enqueue_command_event (Lisp_Object event)
1517 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1521 dequeue_command_event (void)
1523 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1526 /* put the event on the typeahead queue, unless
1527 the event is the quit char, in which case the `QUIT'
1528 which will occur on the next trip through this loop is
1529 all the processing we should do - leaving it on the queue
1530 would cause the quit to be processed twice.
1533 enqueue_command_event_1 (Lisp_Object event_to_copy)
1535 /* do not call check_quit() here. Vquit_flag was set in
1536 next_event_internal. */
1537 if (NILP (Vquit_flag))
1538 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1542 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1544 Lisp_Object event = Fmake_event (Qnil, Qnil);
1546 XEVENT (event)->event_type = magic_eval_event;
1547 /* channel for magic_eval events is nil */
1548 XEVENT (event)->event.magic_eval.internal_function = fun;
1549 XEVENT (event)->event.magic_eval.object = object;
1550 enqueue_command_event (event);
1553 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1554 Add an eval event to the back of the eval event queue.
1555 When this event is dispatched, FUNCTION (which should be a function
1556 of one argument) will be called with OBJECT as its argument.
1557 See `next-event' for a description of event types and how events
1562 Lisp_Object event = Fmake_event (Qnil, Qnil);
1564 XEVENT (event)->event_type = eval_event;
1565 /* channel for eval events is nil */
1566 XEVENT (event)->event.eval.function = function;
1567 XEVENT (event)->event.eval.object = object;
1568 enqueue_command_event (event);
1574 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1577 Lisp_Object event = Fmake_event (Qnil, Qnil);
1579 XEVENT (event)->event_type = misc_user_event;
1580 XEVENT (event)->channel = channel;
1581 XEVENT (event)->event.misc.function = function;
1582 XEVENT (event)->event.misc.object = object;
1583 XEVENT (event)->event.misc.button = 0;
1584 XEVENT (event)->event.misc.modifiers = 0;
1585 XEVENT (event)->event.misc.x = -1;
1586 XEVENT (event)->event.misc.y = -1;
1587 enqueue_command_event (event);
1593 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1595 int button, int modifiers, int x, int y)
1597 Lisp_Object event = Fmake_event (Qnil, Qnil);
1599 XEVENT (event)->event_type = misc_user_event;
1600 XEVENT (event)->channel = channel;
1601 XEVENT (event)->event.misc.function = function;
1602 XEVENT (event)->event.misc.object = object;
1603 XEVENT (event)->event.misc.button = button;
1604 XEVENT (event)->event.misc.modifiers = modifiers;
1605 XEVENT (event)->event.misc.x = x;
1606 XEVENT (event)->event.misc.y = y;
1607 enqueue_command_event (event);
1613 /**********************************************************************/
1614 /* focus-event handling */
1615 /**********************************************************************/
1619 Ben's capsule lecture on focus:
1621 In FSFmacs `select-frame' never changes the window-manager frame
1622 focus. All it does is change the "selected frame". This is similar
1623 to what happens when we call `select-device' or `select-console'.
1624 Whenever an event comes in (including a keyboard event), its frame is
1625 selected; therefore, evaluating `select-frame' in *scratch* won't
1626 cause any effects because the next received event (in the same frame)
1627 will cause a switch back to the frame displaying *scratch*.
1629 Whenever a focus-change event is received from the window manager, it
1630 generates a `switch-frame' event, which causes the Lisp function
1631 `handle-switch-frame' to get run. This basically just runs
1632 `select-frame' (see below, however).
1634 In FSFmacs, if you want to have an operation run when a frame is
1635 selected, you supply an event binding for `switch-frame' (and then
1636 maybe call `handle-switch-frame', or something ...).
1638 In XEmacs, we *do* change the window-manager frame focus as a result
1639 of `select-frame', but not until the next time an event is received,
1640 so that a function that momentarily changes the selected frame won't
1641 cause WM focus flashing. (#### There's something not quite right here;
1642 this is causing the wrong-cursor-focus problems that you occasionally
1643 see. But the general idea is correct.) This approach is winning for
1644 people who use the explicit-focus model, but is trickier to implement.
1646 We also don't make the `switch-frame' event visible but instead have
1647 `select-frame-hook', which is a better approach.
1649 There is the problem of surrogate minibuffers, where when we enter the
1650 minibuffer, you essentially want to temporarily switch the WM focus to
1651 the frame with the minibuffer, and switch it back when you exit the
1654 FSFmacs solves this with the crockish `redirect-frame-focus', which
1655 says "for keyboard events received from FRAME, act like they're
1656 coming from FOCUS-FRAME". I think what this means is that, when
1657 a keyboard event comes in and the event manager is about to select the
1658 event's frame, if that frame has its focus redirected, the redirected-to
1659 frame is selected instead. That way, if you're in a minibufferless
1660 frame and enter the minibuffer, then all Lisp functions that run see
1661 the selected frame as the minibuffer's frame rather than the minibufferless
1662 frame you came from, so that (e.g.) your typing actually appears in
1663 the minibuffer's frame and things behave sanely.
1665 There's also some weird logic that switches the redirected frame focus
1666 from one frame to another if Lisp code explicitly calls `select-frame'
1667 \(but not if `handle-switch-frame' is called), and saves and restores
1668 the frame focus in window configurations, etc. etc. All of this logic
1669 is heavily #if 0'd, with lots of comments saying "No, this approach
1670 doesn't seem to work, so I'm trying this ... is it reasonable?
1671 Well, I'm not sure ..." that are a red flag indicating crockishness.
1673 Because of our way of doing things, we can avoid all this crock.
1674 Keyboard events never cause a select-frame (who cares what frame
1675 they're associated with? They come from a console, only). We change
1676 the actual WM focus to a surrogate minibuffer frame, so we don't have
1677 to do any internal redirection. In order to get the focus back,
1678 I took the approach in minibuf.el of just checking to see if the
1679 frame we moved to is still the selected frame, and move back to the
1680 old one if so. Conceivably we might have to do the weird "tracking"
1681 that FSFmacs does when `select-frame' is called, but I don't think
1682 so. If the selected frame moved from the minibuffer frame, then
1683 we just leave it there, figuring that someone knows what they're
1684 doing. Because we don't have any redirection recorded anywhere,
1685 it's safe to do this, and we don't end up with unwanted redirection.
1690 run_select_frame_hook (void)
1692 run_hook (Qselect_frame_hook);
1696 run_deselect_frame_hook (void)
1698 #if 0 /* unclean! FSF calls this at all sorts of random places,
1699 including a bunch of places in their mouse.el. If this
1700 is implemented, it has to be done cleanly. */
1701 run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also
1702 called in `call-interactively'.
1703 Does this mean it will be
1704 called twice? Oh well, FSF
1705 bug -- FSF calls it in
1706 `handle-switch-frame',
1707 which is approximately the
1708 same as the caller of this
1711 run_hook (Qdeselect_frame_hook);
1714 /* When select-frame is called and focus_follows_mouse is false, we want
1715 to tell the window system that the focus should be changed to point to
1716 the new frame. However,
1717 sometimes Lisp functions will temporarily change the selected frame
1718 (e.g. to call a function that operates on the selected frame),
1719 and it's annoying if this focus-change happens exactly when
1720 select-frame is called, because then you get some flickering of the
1721 window-manager border and perhaps other undesirable results. We
1722 really only want to change the focus when we're about to retrieve
1723 an event from the user. To do this, we keep track of the frame
1724 where the window-manager focus lies on, and just before waiting
1725 for user events, check the currently selected frame and change
1726 the focus as necessary.
1728 On the other hand, if focus_follows_mouse is true, we need to switch the
1729 selected frame back to the frame with window manager focus just before we
1730 execute the next command in Fcommand_loop_1, just as the selected buffer is
1731 reverted after a set-buffer.
1733 Both cases are handled by this function. It must be called as appropriate
1734 from these two places, depending on the value of focus_follows_mouse. */
1737 investigate_frame_change (void)
1739 Lisp_Object devcons, concons;
1741 /* if the selected frame was changed, change the window-system
1742 focus to the new frame. We don't do it when select-frame was
1743 called, to avoid flickering and other unwanted side effects when
1744 the frame is just changed temporarily. */
1745 DEVICE_LOOP_NO_BREAK (devcons, concons)
1747 struct device *d = XDEVICE (XCAR (devcons));
1748 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1750 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1751 but that can cause us to end up in an infinite loop focusing
1752 between two frames. It seems that since the call to `select-frame'
1753 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1754 value, we need to do so too. */
1755 if (!NILP (sel_frame) &&
1756 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1757 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1758 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1760 /* At this point, we know that the frame has been changed. Now, if
1761 * focus_follows_mouse is not set, we finish off the frame change,
1762 * so that user events will now come from the new frame. Otherwise,
1763 * if focus_follows_mouse is set, no gratuitous frame changing
1764 * should take place. Set the focus back to the frame which was
1765 * originally selected for user input.
1767 if (!focus_follows_mouse)
1769 /* prevent us from issuing the same request more than once */
1770 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1771 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1775 Lisp_Object old_frame = Qnil;
1777 /* #### Do we really want to check OUGHT ??
1778 * It seems to make sense, though I have never seen us
1779 * get here and have it be non-nil.
1781 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1782 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1783 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1784 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1786 /* #### Can old_frame ever be NIL? play it safe.. */
1787 if (!NILP (old_frame))
1789 /* Fselect_frame is not really the right thing: it frobs the
1790 * buffer stack. But there's no easy way to do the right
1791 * thing, and this code already had this problem anyway.
1793 Fselect_frame (old_frame);
1801 cleanup_after_missed_defocusing (Lisp_Object frame)
1803 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1804 Fselect_frame (frame);
1809 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1811 Lisp_Object frame = Fcar (frame_inp_and_dev);
1812 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1813 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1816 if (!DEVICE_LIVE_P (XDEVICE (device)))
1819 d = XDEVICE (device);
1821 /* Any received focus-change notifications render invalid any
1822 pending focus-change requests. */
1823 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1826 Lisp_Object focus_frame;
1828 if (!FRAME_LIVE_P (XFRAME (frame)))
1831 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1833 /* Mark the minibuffer as changed to make sure it gets updated
1834 properly if the echo area is active. */
1836 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1837 MARK_WINDOWS_CHANGED (w);
1840 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1842 /* Oops, we missed a focus-out event. */
1843 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1844 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1846 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1847 if (!EQ (frame, focus_frame))
1849 redisplay_redraw_cursor (XFRAME (frame), 1);
1854 /* We ignore the frame reported in the event. If it's different
1855 from where we think the focus was, oh well -- we messed up.
1856 Nonetheless, we pretend we were right, for sensible behavior. */
1857 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1860 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1862 if (FRAME_LIVE_P (XFRAME (frame)))
1863 redisplay_redraw_cursor (XFRAME (frame), 1);
1868 /* Called from the window-system-specific code when we receive a
1869 notification that the focus lies on a particular frame.
1870 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1874 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1876 Lisp_Object frame = Fcar (frame_inp_and_dev);
1877 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1878 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1882 if (!DEVICE_LIVE_P (XDEVICE (device)))
1885 d = XDEVICE (device);
1889 Lisp_Object focus_frame;
1891 if (!FRAME_LIVE_P (XFRAME (frame)))
1894 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1896 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1897 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1899 /* Oops, we missed a focus-out event. */
1900 Fselect_frame (focus_frame);
1901 /* Do an unwind-protect in case an error occurs in
1902 the deselect-frame-hook */
1903 count = specpdl_depth ();
1904 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1905 run_deselect_frame_hook ();
1906 unbind_to (count, Qnil);
1907 /* the cleanup method changed the focus frame to nil, so
1908 we need to reflect this */
1912 Fselect_frame (frame);
1913 if (!EQ (frame, focus_frame))
1914 run_select_frame_hook ();
1918 /* We ignore the frame reported in the event. If it's different
1919 from where we think the focus was, oh well -- we messed up.
1920 Nonetheless, we pretend we were right, for sensible behavior. */
1921 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1924 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1925 run_deselect_frame_hook ();
1931 /**********************************************************************/
1932 /* retrieving the next event */
1933 /**********************************************************************/
1935 static int in_single_console;
1937 /* #### These functions don't currently do anything. */
1939 single_console_state (void)
1941 in_single_console = 1;
1945 any_console_state (void)
1947 in_single_console = 0;
1951 in_single_console_state (void)
1953 return in_single_console;
1956 /* the number of keyboard characters read. callint.c wants this. */
1957 Charcount num_input_chars;
1960 next_event_internal (Lisp_Object target_event, int allow_queued)
1962 struct gcpro gcpro1;
1963 /* QUIT; This is incorrect - the caller must do this because some
1964 callers (ie, Fnext_event()) do not want to QUIT. */
1966 assert (NILP (XEVENT_NEXT (target_event)));
1968 GCPRO1 (target_event);
1970 /* When focus_follows_mouse is nil, if a frame change took place, we need
1971 * to actually switch window manager focus to the selected window now.
1973 if (!focus_follows_mouse)
1974 investigate_frame_change ();
1976 if (allow_queued && !NILP (command_event_queue))
1978 Lisp_Object event = dequeue_command_event ();
1979 Fcopy_event (event, target_event);
1980 Fdeallocate_event (event);
1981 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
1985 Lisp_Event *e = XEVENT (target_event);
1987 /* The command_event_queue was empty. Wait for an event. */
1988 event_stream_next_event (e);
1989 /* If this was a timeout, then we need to extract some data
1990 out of the returned closure and might need to resignal
1992 if (e->event_type == timeout_event)
1994 Lisp_Object tristan, isolde;
1996 e->event.timeout.id_number =
1997 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
2000 e->event.timeout.function = tristan;
2001 e->event.timeout.object = isolde;
2002 /* next_event_internal() doesn't print out timeout events
2003 because of the extra info we just set. */
2004 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
2007 /* If we read a ^G, then set quit-flag but do not discard the ^G.
2008 The callers of next_event_internal() will do one of two things:
2010 -- set Vquit_flag to Qnil. (next-event does this.) This will
2011 cause the ^G to be treated as a normal keystroke.
2012 -- not change Vquit_flag but attempt to enqueue the ^G, at
2013 which point it will be discarded. The next time QUIT is
2014 called, it will notice that Vquit_flag was set.
2017 if (e->event_type == key_press_event &&
2018 event_matches_key_specifier_p
2019 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2029 run_pre_idle_hook (void)
2031 if (!NILP (Vpre_idle_hook)
2032 && !detect_input_pending ())
2033 safe_run_hook_trapping_errors
2034 ("Error in `pre-idle-hook' (setting hook to nil)",
2038 static void push_this_command_keys (Lisp_Object event);
2039 static void push_recent_keys (Lisp_Object event);
2040 static void dribble_out_event (Lisp_Object event);
2041 static void execute_internal_event (Lisp_Object event);
2043 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2044 Return the next available event.
2045 Pass this object to `dispatch-event' to handle it.
2046 In most cases, you will want to use `next-command-event', which returns
2047 the next available "user" event (i.e. keypress, button-press,
2048 button-release, or menu selection) instead of this function.
2050 If EVENT is non-nil, it should be an event object and will be filled in
2051 and returned; otherwise a new event object will be created and returned.
2052 If PROMPT is non-nil, it should be a string and will be displayed in the
2053 echo area while this function is waiting for an event.
2055 The next available event will be
2057 -- any events in `unread-command-events' or `unread-command-event'; else
2058 -- the next event in the currently executing keyboard macro, if any; else
2059 -- an event queued by `enqueue-eval-event', if any, or any similar event
2060 queued internally, such as a misc-user event. (For example, when an item
2061 is selected from a menu or from a `question'-type dialog box, the item's
2062 callback is not immediately executed, but instead a misc-user event
2063 is generated and placed onto this queue; when it is dispatched, the
2064 callback is executed.) Else
2065 -- the next available event from the window system or terminal driver.
2067 In the last case, this function will block until an event is available.
2069 The returned event will be one of the following types:
2071 -- a key-press event.
2072 -- a button-press or button-release event.
2073 -- a misc-user-event, meaning the user selected an item on a menu or used
2075 -- a process event, meaning that output from a subprocess is available.
2076 -- a timeout event, meaning that a timeout has elapsed.
2077 -- an eval event, which simply causes a function to be executed when the
2078 event is dispatched. Eval events are generated by `enqueue-eval-event'
2079 or by certain other conditions happening.
2080 -- a magic event, indicating that some window-system-specific event
2081 happened (such as a focus-change notification) that must be handled
2082 synchronously with other events. `dispatch-event' knows what to do with
2087 /* This function can call lisp */
2088 /* #### We start out using the selected console before an event
2089 is received, for echoing the partially completed command.
2090 This is most definitely wrong -- there needs to be a separate
2091 echo area for each console! */
2092 struct console *con = XCONSOLE (Vselected_console);
2093 struct command_builder *command_builder =
2094 XCOMMAND_BUILDER (con->command_builder);
2095 int store_this_key = 0;
2096 struct gcpro gcpro1;
2099 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2100 We want to read the ^G as an event. */
2102 #ifdef LWLIB_MENUBARS_LUCID
2104 * #### Fix the menu code so this isn't necessary.
2106 * We cannot allow the lwmenu code to be reentered, because the
2107 * code is not written to be reentrant and will crash. Therefore
2108 * paths from the menu callbacks back into the menu code have to
2109 * be blocked. Fnext_event is the normal path into the menu code,
2110 * so we signal an error here.
2112 if (in_menu_callback)
2113 error ("Attempt to call next-event inside menu callback");
2114 #endif /* LWLIB_MENUBARS_LUCID */
2117 event = Fmake_event (Qnil, Qnil);
2119 CHECK_LIVE_EVENT (event);
2124 CHECK_STRING (prompt);
2126 len = XSTRING_LENGTH (prompt);
2127 if (command_builder->echo_buf_length < len)
2128 len = command_builder->echo_buf_length - 1;
2129 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2130 command_builder->echo_buf[len] = 0;
2131 command_builder->echo_buf_index = len;
2132 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2133 command_builder->echo_buf,
2135 command_builder->echo_buf_index,
2139 start_over_and_avoid_hosage:
2141 /* If there is something in unread-command-events, simply return it.
2142 But do some error checking to make sure the user hasn't put something
2143 in the unread-command-events that they shouldn't have.
2144 This does not update this-command-keys and recent-keys.
2146 if (!NILP (Vunread_command_events))
2148 if (!CONSP (Vunread_command_events))
2150 Vunread_command_events = Qnil;
2151 signal_error (Qwrong_type_argument,
2152 list3 (Qconsp, Vunread_command_events,
2153 Qunread_command_events));
2157 Lisp_Object e = XCAR (Vunread_command_events);
2158 Vunread_command_events = XCDR (Vunread_command_events);
2159 if (!EVENTP (e) || !command_event_p (e))
2160 signal_error (Qwrong_type_argument,
2161 list3 (Qcommand_event_p, e, Qunread_command_events));
2164 Fcopy_event (e, event);
2165 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2169 /* Do similar for unread-command-event (obsoleteness support). */
2170 else if (!NILP (Vunread_command_event))
2172 Lisp_Object e = Vunread_command_event;
2173 Vunread_command_event = Qnil;
2175 if (!EVENTP (e) || !command_event_p (e))
2177 signal_error (Qwrong_type_argument,
2178 list3 (Qeventp, e, Qunread_command_event));
2181 Fcopy_event (e, event);
2183 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2186 /* If we're executing a keyboard macro, take the next event from that,
2187 and update this-command-keys and recent-keys.
2188 Note that the unread-command-events take precedence over kbd macros.
2192 if (!NILP (Vexecuting_macro))
2195 pop_kbd_macro_event (event); /* This throws past us at
2198 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2200 /* Otherwise, read a real event, possibly from the
2201 command_event_queue, and update this-command-keys and
2205 run_pre_idle_hook ();
2207 next_event_internal (event, 1);
2208 Vquit_flag = Qnil; /* Read C-g as an event. */
2213 status_notify (); /* Notice process change */
2216 alloca (0); /* Cause a garbage collection now */
2217 /* Since we can free the most stuff here
2218 * (since this is typically called from
2219 * the command-loop top-level). */
2220 #endif /* C_ALLOCA */
2222 if (object_dead_p (XEVENT (event)->channel))
2223 /* event_console_or_selected may crash if the channel is dead.
2224 Best just to eat it and get the next event. */
2225 goto start_over_and_avoid_hosage;
2227 /* OK, now we can stop the selected-console kludge and use the
2228 actual console from the event. */
2229 con = event_console_or_selected (event);
2230 command_builder = XCOMMAND_BUILDER (con->command_builder);
2232 switch (XEVENT_TYPE (event))
2236 case button_release_event:
2237 case misc_user_event:
2238 /* don't echo menu accelerator keys */
2239 reset_key_echo (command_builder, 1);
2241 case button_press_event: /* key or mouse input can trigger prompting */
2242 goto STORE_AND_EXECUTE_KEY;
2243 case key_press_event: /* any key input can trigger autosave */
2247 maybe_do_auto_save ();
2249 STORE_AND_EXECUTE_KEY:
2252 echo_key_event (command_builder, event);
2256 /* Store the last-input-event. The semantics of this is that it is
2257 the thing most recently returned by next-command-event. It need
2258 not have come from the keyboard or a keyboard macro, it may have
2259 come from unread-command-events. It's always a command-event (a
2260 key, click, or menu selection), never a motion or process event.
2262 if (!EVENTP (Vlast_input_event))
2263 Vlast_input_event = Fmake_event (Qnil, Qnil);
2264 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2266 Vlast_input_event = Fmake_event (Qnil, Qnil);
2267 error ("Someone deallocated last-input-event!");
2269 if (! EQ (event, Vlast_input_event))
2270 Fcopy_event (event, Vlast_input_event);
2272 /* last-input-char and last-input-time are derived from
2274 Note that last-input-char will never have its high-bit set, in an
2275 effort to sidestep the ambiguity between M-x and oslash.
2277 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2282 if (!CONSP (Vlast_input_time))
2283 Vlast_input_time = Fcons (Qnil, Qnil);
2284 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2285 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2286 if (!CONSP (Vlast_command_event_time))
2287 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2288 XCAR (Vlast_command_event_time) =
2289 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2290 XCAR (XCDR (Vlast_command_event_time)) =
2291 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2292 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2293 = make_int (EMACS_USECS (t));
2295 /* If this key came from the keyboard or from a keyboard macro, then
2296 it goes into the recent-keys and this-command-keys vectors.
2297 If this key came from the keyboard, and we're defining a keyboard
2298 macro, then it goes into the macro.
2302 push_this_command_keys (event);
2303 if (!inhibit_input_event_recording)
2304 push_recent_keys (event);
2305 dribble_out_event (event);
2306 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2308 if (!EVENTP (command_builder->current_events))
2309 finalize_kbd_macro_chars (con);
2310 store_kbd_macro_event (event);
2313 /* If this is the help char and there is a help form, then execute the
2314 help form and swallow this character. This is the only place where
2315 calling Fnext_event() can cause arbitrary lisp code to run. Note
2316 that execute_help_form() calls Fnext_command_event(), which calls
2317 this function, as well as Fdispatch_event.
2319 if (!NILP (Vhelp_form) &&
2320 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2321 execute_help_form (command_builder, event);
2328 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2329 Return the next available "user" event.
2330 Pass this object to `dispatch-event' to handle it.
2332 If EVENT is non-nil, it should be an event object and will be filled in
2333 and returned; otherwise a new event object will be created and returned.
2334 If PROMPT is non-nil, it should be a string and will be displayed in the
2335 echo area while this function is waiting for an event.
2337 The event returned will be a keyboard, mouse press, or mouse release event.
2338 If there are non-command events available (mouse motion, sub-process output,
2339 etc) then these will be executed (with `dispatch-event') and discarded. This
2340 function is provided as a convenience; it is roughly equivalent to the lisp code
2343 (next-event event prompt)
2344 (not (or (key-press-event-p event)
2345 (button-press-event-p event)
2346 (button-release-event-p event)
2347 (misc-user-event-p event))))
2348 (dispatch-event event))
2350 but it also makes a provision for displaying keystrokes in the echo area.
2354 /* This function can GC */
2355 struct gcpro gcpro1;
2357 maybe_echo_keys (XCOMMAND_BUILDER
2358 (XCONSOLE (Vselected_console)->
2359 command_builder), 0); /* #### This sucks bigtime */
2362 event = Fnext_event (event, prompt);
2363 if (command_event_p (event))
2366 execute_internal_event (event);
2372 DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
2373 Dispatch any pending "magic" events.
2375 This function is useful for forcing the redisplay of native
2376 widgets. Normally these are redisplayed through a native window-system
2377 event encoded as magic event, rather than by the redisplay code. This
2378 function does not call redisplay or do any of the other things that
2383 /* This function can GC */
2384 Lisp_Object event = Qnil;
2385 struct gcpro gcpro1;
2387 event = Fmake_event (Qnil, Qnil);
2389 /* Make sure that there will be something in the native event queue
2390 so that externally managed things (e.g. widgets) get some CPU
2392 event_stream_force_event_pending (selected_frame ());
2394 while (event_stream_event_pending_p (0))
2396 QUIT; /* next_event_internal() does not QUIT. */
2398 /* We're a generator of the command_event_queue, so we can't be a
2399 consumer as well. Also, we have no reason to consult the
2400 command_event_queue; there are only user and eval-events there,
2401 and we'd just have to put them back anyway.
2403 next_event_internal (event, 0); /* blocks */
2404 /* See the comment in accept-process-output about Vquit_flag */
2405 if (XEVENT_TYPE (event) == magic_event ||
2406 XEVENT_TYPE (event) == timeout_event ||
2407 XEVENT_TYPE (event) == process_event ||
2408 XEVENT_TYPE (event) == pointer_motion_event)
2409 execute_internal_event (event);
2412 enqueue_command_event_1 (event);
2417 Fdeallocate_event (event);
2423 reset_current_events (struct command_builder *command_builder)
2425 Lisp_Object event = command_builder->current_events;
2426 reset_command_builder_event_chain (command_builder);
2428 deallocate_event_chain (event);
2431 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2432 Discard any pending "user" events.
2433 Also cancel any kbd macro being defined.
2434 A user event is a key press, button press, button release, or
2435 "misc-user" event (menu selection or scrollbar action).
2439 /* This throws away user-input on the queue, but doesn't process any
2440 events. Calling dispatch_event() here leads to a race condition.
2442 Lisp_Object event = Fmake_event (Qnil, Qnil);
2443 Lisp_Object head = Qnil, tail = Qnil;
2444 Lisp_Object oiq = Vinhibit_quit;
2445 struct gcpro gcpro1, gcpro2;
2446 /* #### not correct here with Vselected_console? Should
2447 discard-input take a console argument, or maybe map over
2449 struct console *con = XCONSOLE (Vselected_console);
2451 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2452 GCPRO2 (event, oiq);
2454 /* If a macro was being defined then we have to mark the modeline
2455 has changed to ensure that it gets updated correctly. */
2456 if (!NILP (con->defining_kbd_macro))
2457 MARK_MODELINE_CHANGED;
2458 con->defining_kbd_macro = Qnil;
2459 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2461 while (!NILP (command_event_queue)
2462 || event_stream_event_pending_p (1))
2464 /* This will take stuff off the command_event_queue, or read it
2465 from the event_stream, but it will not block.
2467 next_event_internal (event, 1);
2468 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2469 It is vitally important that we reset
2470 Vquit_flag here. Otherwise, if we're
2471 reading from a TTY console,
2472 maybe_read_quit_event() will notice
2473 that C-g has been set and send us
2474 another C-g. That will cause us
2475 to get right back here, and read
2476 another C-g, ad infinitum ... */
2478 /* If the event is a user event, ignore it. */
2479 if (!command_event_p (event))
2481 /* Otherwise, chain the event onto our list of events not to ignore,
2482 and keep reading until the queue is empty. This does not mean
2483 that if a subprocess is generating an infinite amount of output,
2484 we will never terminate (*provided* that the behavior of
2485 next_event_cb() is correct -- see the comment in events.h),
2486 because this loop ends as soon as there are no more user events
2487 on the command_event_queue or event_stream.
2489 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2493 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2496 /* Now tack our chain of events back on to the front of the queue.
2497 Actually, since the queue is now drained, we can just replace it.
2498 The effect of this will be that we have deleted all user events
2499 from the input stream without changing the relative ordering of
2500 any other events. (Some events may have been taken from the
2501 event_stream and added to the command_event_queue, however.)
2503 At this time, the command_event_queue will contain only eval_events.
2506 command_event_queue = head;
2507 command_event_queue_tail = tail;
2509 Fdeallocate_event (event);
2512 Vinhibit_quit = oiq;
2517 /**********************************************************************/
2518 /* pausing until an action occurs */
2519 /**********************************************************************/
2521 /* This is used in accept-process-output, sleep-for and sit-for.
2522 Before running any process_events in these routines, we set
2523 recursive_sit_for to Qt, and use this unwind protect to reset it to
2524 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2525 cause it to return immediately.
2527 All of these routines install timeouts, so we clear the installed
2530 Note: It's very easy to break the desired behaviors of these
2531 3 routines. If you make any changes to anything in this area, run
2532 the regression tests at the bottom of the file. -- dmoore */
2536 sit_for_unwind (Lisp_Object timeout_id)
2538 if (!NILP(timeout_id))
2539 Fdisable_timeout (timeout_id);
2541 recursive_sit_for = Qnil;
2545 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2548 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2549 Allow any pending output from subprocesses to be read by Emacs.
2550 It is read into the process' buffers or given to their filter functions.
2551 Non-nil arg PROCESS means do not return until some output has been received
2552 from PROCESS. Nil arg PROCESS means do not return until some output has
2553 been received from any process.
2554 If the second arg is non-nil, it is the maximum number of seconds to wait:
2555 this function will return after that much time even if no input has arrived
2556 from PROCESS. This argument may be a float, meaning wait some fractional
2558 If the third arg is non-nil, it is a number of milliseconds that is added
2559 to the second arg. (This exists only for compatibility.)
2560 Return non-nil iff we received any output before the timeout expired.
2562 (process, timeout_secs, timeout_msecs))
2564 /* This function can GC */
2565 struct gcpro gcpro1, gcpro2;
2566 Lisp_Object event = Qnil;
2567 Lisp_Object result = Qnil;
2568 int timeout_id = -1;
2569 int timeout_enabled = 0;
2571 struct buffer *old_buffer = current_buffer;
2574 /* We preserve the current buffer but nothing else. If a focus
2575 change alters the selected window then the top level event loop
2576 will eventually alter current_buffer to match. In the mean time
2577 we don't want to mess up whatever called this function. */
2579 if (!NILP (process))
2580 CHECK_PROCESS (process);
2582 GCPRO2 (event, process);
2584 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2586 unsigned long msecs = 0;
2587 if (!NILP (timeout_secs))
2588 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2589 if (!NILP (timeout_msecs))
2591 CHECK_NATNUM (timeout_msecs);
2592 msecs += XINT (timeout_msecs);
2596 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2597 timeout_enabled = 1;
2601 event = Fmake_event (Qnil, Qnil);
2603 count = specpdl_depth ();
2604 record_unwind_protect (sit_for_unwind,
2605 timeout_enabled ? make_int (timeout_id) : Qnil);
2606 recursive_sit_for = Qt;
2609 ((NILP (process) && timeout_enabled) ||
2610 (NILP (process) && event_stream_event_pending_p (0)) ||
2612 /* Calling detect_input_pending() is the wrong thing here, because
2613 that considers the Vunread_command_events and command_event_queue.
2614 We don't need to look at the command_event_queue because we are
2615 only interested in process events, which don't go on that. In
2616 fact, we can't read from it anyway, because we put stuff on it.
2618 Note that event_stream->event_pending_p must be called in such
2619 a way that it says whether any events *of any kind* are ready,
2620 not just user events, or (accept-process-output nil) will fail
2621 to dispatch any process events that may be on the queue. It is
2622 not clear to me that this is important, because the top-level
2623 loop will process it, and I don't think that there is ever a
2624 time when one calls accept-process-output with a nil argument
2625 and really need the processes to be handled. */
2627 /* If our timeout has arrived, we move along. */
2628 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2630 timeout_enabled = 0;
2631 done = 1; /* We're done. */
2632 continue; /* Don't call next_event_internal */
2635 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2636 before reading output from the process - this makes it
2637 less likely that the filter will actually be aborted.
2640 next_event_internal (event, 0);
2641 /* If C-g was pressed while we were waiting, Vquit_flag got
2642 set and next_event_internal() also returns C-g. When
2643 we enqueue the C-g below, it will get discarded. The
2644 next time through, QUIT will be called and will signal a quit. */
2645 switch (XEVENT_TYPE (event))
2649 if (NILP (process) ||
2650 EQ (XEVENT (event)->event.process.process, process))
2653 /* RMS's version always returns nil when proc is nil,
2654 and only returns t if input ever arrived on proc. */
2658 execute_internal_event (event);
2662 /* We execute the event even if it's ours, and notice that it's
2664 case pointer_motion_event:
2667 execute_internal_event (event);
2672 enqueue_command_event_1 (event);
2678 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2680 Fdeallocate_event (event);
2682 current_buffer = old_buffer;
2686 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2687 Pause, without updating display, for ARG seconds.
2688 ARG may be a float, meaning pause for some fractional part of a second.
2690 It is recommended that you never call sleep-for from inside of a process
2691 filter function or timer event (either synchronous or asynchronous).
2695 /* This function can GC */
2696 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2698 Lisp_Object event = Qnil;
2700 struct gcpro gcpro1;
2704 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2705 event = Fmake_event (Qnil, Qnil);
2707 count = specpdl_depth ();
2708 record_unwind_protect (sit_for_unwind, make_int (id));
2709 recursive_sit_for = Qt;
2713 /* If our timeout has arrived, we move along. */
2714 if (!event_stream_wakeup_pending_p (id, 0))
2717 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2718 before reading output from the process - this makes it
2719 less likely that the filter will actually be aborted.
2721 /* We're a generator of the command_event_queue, so we can't be a
2722 consumer as well. We don't care about command and eval-events
2725 next_event_internal (event, 0); /* blocks */
2726 /* See the comment in accept-process-output about Vquit_flag */
2727 switch (XEVENT_TYPE (event))
2730 /* We execute the event even if it's ours, and notice that it's
2733 case pointer_motion_event:
2736 execute_internal_event (event);
2741 enqueue_command_event_1 (event);
2747 unbind_to (count, make_int (id));
2748 Fdeallocate_event (event);
2753 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2754 Perform redisplay, then wait ARG seconds or until user input is available.
2755 ARG may be a float, meaning a fractional part of a second.
2756 Optional second arg non-nil means don't redisplay, just wait for input.
2757 Redisplay is preempted as always if user input arrives, and does not
2758 happen if input is available before it starts.
2759 Value is t if waited the full time with no input arriving.
2761 If sit-for is called from within a process filter function or timer
2762 event (either synchronous or asynchronous) it will return immediately.
2764 (seconds, nodisplay))
2766 /* This function can GC */
2767 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2768 Lisp_Object event, result;
2769 struct gcpro gcpro1;
2773 /* The unread-command-events count as pending input */
2774 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2777 /* If the command-builder already has user-input on it (not eval events)
2778 then that means we're done too.
2780 if (!NILP (command_event_queue))
2782 EVENT_CHAIN_LOOP (event, command_event_queue)
2784 if (command_event_p (event))
2789 /* If we're in a macro, or noninteractive, or early in temacs, then
2791 if (noninteractive || !NILP (Vexecuting_macro))
2794 /* Recursive call from a filter function or timeout handler. */
2795 if (!NILP(recursive_sit_for))
2797 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2799 run_pre_idle_hook ();
2806 /* Otherwise, start reading events from the event_stream.
2807 Do this loop at least once even if (sit-for 0) so that we
2808 redisplay when no input pending.
2811 event = Fmake_event (Qnil, Qnil);
2813 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2814 events get processed. The old (pre-19.12) code special-cased this
2815 and didn't generate a wakeup, but the resulting behavior was less than
2816 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2817 the E-Lisp universe. */
2819 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2821 count = specpdl_depth ();
2822 record_unwind_protect (sit_for_unwind, make_int (id));
2823 recursive_sit_for = Qt;
2827 /* If there is no user input pending, then redisplay.
2829 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2831 run_pre_idle_hook ();
2835 /* If our timeout has arrived, we move along. */
2836 if (!event_stream_wakeup_pending_p (id, 0))
2842 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2843 before reading output from the process - this makes it
2844 less likely that the filter will actually be aborted.
2846 /* We're a generator of the command_event_queue, so we can't be a
2847 consumer as well. In fact, we know there's nothing on the
2848 command_event_queue that we didn't just put there.
2850 next_event_internal (event, 0); /* blocks */
2851 /* See the comment in accept-process-output about Vquit_flag */
2853 if (command_event_p (event))
2855 QUIT; /* If the command was C-g check it here
2856 so that we abort out of the sit-for,
2857 not the next command. sleep-for and
2858 accept-process-output continue looping
2859 so they check QUIT again implicitly.*/
2863 switch (XEVENT_TYPE (event))
2867 /* eval-events get delayed until later. */
2868 enqueue_command_event (Fcopy_event (event, Qnil));
2873 /* We execute the event even if it's ours, and notice that it's
2877 execute_internal_event (event);
2884 unbind_to (count, make_int (id));
2886 /* Put back the event (if any) that made Fsit_for() exit before the
2887 timeout. Note that it is being added to the back of the queue, which
2888 would be inappropriate if there were any user events on the queue
2889 already: we would be misordering them. But we know that there are
2890 no user-events on the queue, or else we would not have reached this
2894 enqueue_command_event (event);
2896 Fdeallocate_event (event);
2902 /* This handy little function is used by select-x.c to wait for replies
2903 from processes that aren't really processes (e.g. the X server) */
2905 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2907 /* This function can GC */
2908 Lisp_Object event = Fmake_event (Qnil, Qnil);
2909 struct gcpro gcpro1;
2912 while (!(*predicate) (predicate_arg))
2914 QUIT; /* next_event_internal() does not QUIT. */
2916 /* We're a generator of the command_event_queue, so we can't be a
2917 consumer as well. Also, we have no reason to consult the
2918 command_event_queue; there are only user and eval-events there,
2919 and we'd just have to put them back anyway.
2921 next_event_internal (event, 0);
2922 /* See the comment in accept-process-output about Vquit_flag */
2923 if (command_event_p (event)
2924 || (XEVENT_TYPE (event) == eval_event)
2925 || (XEVENT_TYPE (event) == magic_eval_event))
2926 enqueue_command_event_1 (event);
2928 execute_internal_event (event);
2934 /**********************************************************************/
2935 /* dispatching events; command builder */
2936 /**********************************************************************/
2939 execute_internal_event (Lisp_Object event)
2941 /* events on dead channels get silently eaten */
2942 if (object_dead_p (XEVENT (event)->channel))
2945 /* This function can GC */
2946 switch (XEVENT_TYPE (event))
2953 call1 (XEVENT (event)->event.eval.function,
2954 XEVENT (event)->event.eval.object);
2958 case magic_eval_event:
2960 (XEVENT (event)->event.magic_eval.internal_function)
2961 (XEVENT (event)->event.magic_eval.object);
2965 case pointer_motion_event:
2967 if (!NILP (Vmouse_motion_handler))
2968 call1 (Vmouse_motion_handler, event);
2974 Lisp_Object p = XEVENT (event)->event.process.process;
2975 Charcount readstatus;
2977 assert (PROCESSP (p));
2978 while ((readstatus = read_process_output (p)) > 0)
2981 ; /* this clauses never gets executed but allows the #ifdefs
2984 else if (readstatus == -1 && errno == EWOULDBLOCK)
2986 #endif /* EWOULDBLOCK */
2988 else if (readstatus == -1 && errno == EAGAIN)
2991 else if ((readstatus == 0 &&
2992 /* Note that we cannot distinguish between no input
2993 available now and a closed pipe.
2994 With luck, a closed pipe will be accompanied by
2995 subprocess termination and SIGCHLD. */
2996 (!network_connection_p (p) ||
2998 When connected to ToolTalk (i.e.
2999 connected_via_filedesc_p()), it's not possible to
3000 reliably determine whether there is a message
3001 waiting for ToolTalk to receive. ToolTalk expects
3002 to have tt_message_receive() called exactly once
3003 every time the file descriptor becomes active, so
3004 the filter function forces this by returning 0.
3005 Emacs must not interpret this as a closed pipe. */
3006 connected_via_filedesc_p (XPROCESS (p))))
3008 /* On some OSs with ptys, when the process on one end of
3009 a pty exits, the other end gets an error reading with
3010 errno = EIO instead of getting an EOF (0 bytes read).
3011 Therefore, if we get an error reading and errno =
3012 EIO, just continue, because the child process has
3013 exited and should clean itself up soon (e.g. when we
3015 || (readstatus == -1 && errno == EIO)
3019 /* Currently, we rely on SIGCHLD to indicate that the
3020 process has terminated. Unfortunately, on some systems
3021 the SIGCHLD gets missed some of the time. So we put an
3022 additional check in status_notify() to see whether a
3023 process has terminated. We must tell status_notify()
3024 to enable that check, and we do so now. */
3025 kick_status_notify ();
3029 /* Deactivate network connection */
3030 Lisp_Object status = Fprocess_status (p);
3031 if (EQ (status, Qopen)
3032 /* In case somebody changes the theory of whether to
3033 return open as opposed to run for network connection
3035 || EQ (status, Qrun))
3036 update_process_status (p, Qexit, 256, 0);
3037 deactivate_process (p);
3040 /* We must call status_notify here to allow the
3041 event_stream->unselect_process_cb to be run if appropriate.
3042 Otherwise, dead fds may be selected for, and we will get a
3043 continuous stream of process events for them. Since we don't
3044 return until all process events have been flushed, we would
3045 get stuck here, processing events on a process whose status
3046 was 'exit. Call this after dispatch-event, or the fds will
3047 have been closed before we read the last data from them.
3048 It's safe for the filter to signal an error because
3049 status_notify() will be called on return to top-level.
3057 Lisp_Event *e = XEVENT (event);
3058 if (!NILP (e->event.timeout.function))
3059 call1 (e->event.timeout.function,
3060 e->event.timeout.object);
3065 event_stream_handle_magic_event (XEVENT (event));
3076 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3078 Lisp_Object first_before_suffix =
3079 event_chain_find_previous (Vthis_command_keys, suffix);
3081 if (NILP (first_before_suffix))
3082 Vthis_command_keys = chain;
3084 XSET_EVENT_NEXT (first_before_suffix, chain);
3085 deallocate_event_chain (suffix);
3086 Vthis_command_keys_tail = event_chain_tail (chain);
3090 command_builder_replace_suffix (struct command_builder *builder,
3091 Lisp_Object suffix, Lisp_Object chain)
3093 Lisp_Object first_before_suffix =
3094 event_chain_find_previous (builder->current_events, suffix);
3096 if (NILP (first_before_suffix))
3097 builder->current_events = chain;
3099 XSET_EVENT_NEXT (first_before_suffix, chain);
3100 deallocate_event_chain (suffix);
3101 builder->most_current_event = event_chain_tail (chain);
3105 command_builder_find_leaf_1 (struct command_builder *builder)
3107 Lisp_Object event0 = builder->current_events;
3112 return event_binding (event0, 1);
3115 /* See if we can do function-key-map or key-translation-map translation
3116 on the current events in the command builder. If so, do this, and
3117 return the resulting binding, if any. */
3120 munge_keymap_translate (struct command_builder *builder,
3121 enum munge_me_out_the_door munge,
3122 int has_normal_binding_p)
3126 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3128 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3133 if (KEYMAPP (result))
3135 if (NILP (builder->last_non_munged_event)
3136 && !has_normal_binding_p)
3137 builder->last_non_munged_event = builder->most_current_event;
3140 builder->last_non_munged_event = Qnil;
3142 if (!KEYMAPP (result) &&
3143 !VECTORP (result) &&
3146 struct gcpro gcpro1;
3148 result = call1 (result, Qnil);
3154 if (KEYMAPP (result))
3157 if (VECTORP (result) || STRINGP (result))
3159 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3163 /* If the first_mungeable_event of the other munger is
3164 within the events we're munging, then it will point to
3165 deallocated events afterwards, which is bad -- so make it
3166 point at the beginning of the munged events. */
3167 EVENT_CHAIN_LOOP (tempev, suffix)
3169 Lisp_Object *mungeable_event =
3170 &builder->munge_me[1 - munge].first_mungeable_event;
3171 if (EQ (tempev, *mungeable_event))
3173 *mungeable_event = new_chain;
3178 n = event_chain_count (suffix);
3179 command_builder_replace_suffix (builder, suffix, new_chain);
3180 builder->munge_me[munge].first_mungeable_event = Qnil;
3181 /* Now hork this-command-keys as well. */
3183 /* We just assume that the events we just replaced are
3184 sitting in copied form at the end of this-command-keys.
3185 If the user did weird things with `dispatch-event' this
3186 may not be the case, but at least we make sure we won't
3188 new_chain = copy_event_chain (new_chain);
3189 tckn = event_chain_count (Vthis_command_keys);
3192 this_command_keys_replace_suffix
3193 (event_chain_nth (Vthis_command_keys, tckn - n),
3197 result = command_builder_find_leaf_1 (builder);
3201 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3202 "Invalid binding in function-key-map" :
3203 "Invalid binding in key-translation-map"),
3210 /* Compare the current state of the command builder against the local and
3211 global keymaps, and return the binding. If there is no match, try again,
3212 case-insensitively. The return value will be one of:
3213 -- nil (there is no binding)
3214 -- a keymap (part of a command has been specified)
3215 -- a command (anything that satisfies `commandp'; this includes
3216 some symbols, lists, subrs, strings, vectors, and
3217 compiled-function objects)
3220 command_builder_find_leaf (struct command_builder *builder,
3221 int allow_misc_user_events_p)
3223 /* This function can GC */
3225 Lisp_Object evee = builder->current_events;
3227 if (XEVENT_TYPE (evee) == misc_user_event)
3229 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3230 return list2 (XEVENT (evee)->event.eval.function,
3231 XEVENT (evee)->event.eval.object);
3236 /* if we're currently in a menu accelerator, check there for further
3238 /* #### fuck me! who wrote this crap? think "abstraction", baby. */
3239 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3240 if (x_kludge_lw_menu_active ())
3242 return command_builder_operate_menu_accelerator (builder);
3247 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3248 result = command_builder_find_menu_accelerator (builder);
3251 result = command_builder_find_leaf_1 (builder);
3252 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3254 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3255 result = command_builder_find_menu_accelerator (builder);
3259 /* Check to see if we have a potential function-key-map match. */
3262 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3263 regenerate_echo_keys_from_this_command_keys (builder);
3265 /* Check to see if we have a potential key-translation-map match. */
3267 Lisp_Object key_translate_result =
3268 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3270 if (!NILP (key_translate_result))
3272 result = key_translate_result;
3273 regenerate_echo_keys_from_this_command_keys (builder);
3280 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3282 /* If we didn't find a binding, and the last event in the sequence is
3283 a shifted character, then try again with the lowercase version. */
3285 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3286 && !NILP (Vretry_undefined_key_binding_unshifted))
3288 Lisp_Object terminal = builder->most_current_event;
3289 struct key_data* key = & XEVENT (terminal)->event.key;
3291 if ((key->modifiers & XEMACS_MOD_SHIFT)
3292 || (CHAR_OR_CHAR_INTP (key->keysym)
3293 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3295 Lisp_Event terminal_copy = *XEVENT (terminal);
3297 if (key->modifiers & XEMACS_MOD_SHIFT)
3298 key->modifiers &= (~ XEMACS_MOD_SHIFT);
3300 key->keysym = make_char (c + 'a' - 'A');
3302 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3305 /* If there was no match with the lower-case version either,
3306 then put back the upper-case event for the error
3307 message. But make sure that function-key-map didn't
3308 change things out from under us. */
3309 if (EQ (terminal, builder->most_current_event))
3310 *XEVENT (terminal) = terminal_copy;
3314 /* help-char is `auto-bound' in every keymap */
3315 if (!NILP (Vprefix_help_command) &&
3316 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3318 return Vprefix_help_command;
3321 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3322 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3323 && !NILP (Vcomposed_character_default_binding))
3325 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3326 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3327 return Vcomposed_character_default_binding;
3329 #endif /* HAVE_XIM */
3331 /* If we read extra events attempting to match a function key but end
3332 up failing, then we release those events back to the command loop
3333 and fail on the original lookup. The released events will then be
3334 reprocessed in the context of the first part having failed. */
3335 if (!NILP (builder->last_non_munged_event))
3337 Lisp_Object event0 = builder->last_non_munged_event;
3339 /* Put the commands back on the event queue. */
3340 enqueue_event_chain (XEVENT_NEXT (event0),
3341 &command_event_queue,
3342 &command_event_queue_tail);
3344 /* Then remove them from the command builder. */
3345 XSET_EVENT_NEXT (event0, Qnil);
3346 builder->most_current_event = event0;
3347 builder->last_non_munged_event = Qnil;
3354 /* Every time a command-event (a key, button, or menu selection) is read by
3355 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3356 and in Vthis_command_keys. (Eval-events are not stored there.)
3358 Every time a command is invoked, Vlast_command_event is set to the last
3359 event in the sequence.
3361 This means that Vthis_command_keys is really about "input read since the
3362 last command was executed" rather than about "what keys invoked this
3363 command." This is a little counterintuitive, but that's the way it
3366 As an extra kink, the function read-key-sequence resets/updates the
3367 last-command-event and this-command-keys. It doesn't append to the
3368 command-keys as read-char does. Such are the pitfalls of having to
3369 maintain compatibility with a program for which the only specification
3372 (We could implement recent_keys_ring and Vthis_command_keys as the same
3376 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3377 Return a vector of recent keyboard or mouse button events read.
3378 If NUMBER is non-nil, not more than NUMBER events will be returned.
3379 Change number of events stored using `set-recent-keys-ring-size'.
3381 This copies the event objects into a new vector; it is safe to keep and
3386 struct gcpro gcpro1;
3387 Lisp_Object val = Qnil;
3389 int start, nkeys, i, j;
3393 nwanted = recent_keys_ring_size;
3396 CHECK_NATNUM (number);
3397 nwanted = XINT (number);
3400 /* Create the keys ring vector, if none present. */
3401 if (NILP (Vrecent_keys_ring))
3403 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3404 /* And return nothing in particular. */
3405 return make_vector (0, Qnil);
3408 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3409 /* This means the vector has not yet wrapped */
3411 nkeys = recent_keys_ring_index;
3416 nkeys = recent_keys_ring_size;
3417 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3420 if (nwanted < nkeys)
3422 start += nkeys - nwanted;
3423 if (start >= recent_keys_ring_size)
3424 start -= recent_keys_ring_size;
3430 val = make_vector (nwanted, Qnil);
3432 for (i = 0, j = start; i < nkeys; i++)
3434 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3438 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3439 if (++j >= recent_keys_ring_size)
3447 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3448 The maximum number of events `recent-keys' can return.
3452 return make_int (recent_keys_ring_size);
3455 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3456 Set the maximum number of events to be stored internally.
3460 Lisp_Object new_vector = Qnil;
3461 int i, j, nkeys, start, min;
3462 struct gcpro gcpro1;
3463 GCPRO1 (new_vector);
3466 if (XINT (size) <= 0)
3467 error ("Recent keys ring size must be positive");
3468 if (XINT (size) == recent_keys_ring_size)
3471 new_vector = make_vector (XINT (size), Qnil);
3473 if (NILP (Vrecent_keys_ring))
3475 Vrecent_keys_ring = new_vector;
3479 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3480 /* This means the vector has not yet wrapped */
3482 nkeys = recent_keys_ring_index;
3487 nkeys = recent_keys_ring_size;
3488 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3491 if (XINT (size) > nkeys)
3496 for (i = 0, j = start; i < min; i++)
3498 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3499 if (++j >= recent_keys_ring_size)
3502 recent_keys_ring_size = XINT (size);
3503 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3505 Vrecent_keys_ring = new_vector;
3511 /* Vthis_command_keys having value Qnil means that the next time
3512 push_this_command_keys is called, it should start over.
3513 The times at which the command-keys are reset
3514 (instead of merely being augmented) are pretty counterintuitive.
3517 -- We do not reset this-command-keys when we finish reading a
3518 command. This is because some commands (e.g. C-u) act
3519 like command prefixes; they signal this by setting prefix-arg
3521 -- Therefore, we reset this-command-keys when we finish
3522 executing a command, unless prefix-arg is set.
3523 -- However, if we ever do a non-local exit out of a command
3524 loop (e.g. an error in a command), we need to reset
3525 this-command-keys. We do this by calling reset_this_command_keys()
3526 from cmdloop.c, whenever an error causes an invocation of the
3527 default error handler, and whenever there's a throw to top-level.)
3531 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
3533 struct command_builder *command_builder =
3534 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
3536 reset_key_echo (command_builder, clear_echo_area_p);
3538 deallocate_event_chain (Vthis_command_keys);
3539 Vthis_command_keys = Qnil;
3540 Vthis_command_keys_tail = Qnil;
3542 reset_current_events (command_builder);
3546 push_this_command_keys (Lisp_Object event)
3548 Lisp_Object new = Fmake_event (Qnil, Qnil);
3550 Fcopy_event (event, new);
3551 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
3554 /* The following two functions are used in call-interactively,
3555 for the @ and e specifications. We used to just use
3556 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3557 but FSF does it more generally so we follow their lead. */
3560 extract_this_command_keys_nth_mouse_event (int n)
3564 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
3567 && (XEVENT_TYPE (event) == button_press_event
3568 || XEVENT_TYPE (event) == button_release_event
3569 || XEVENT_TYPE (event) == misc_user_event))
3573 /* must copy to avoid an abort() in next_event_internal() */
3574 if (!NILP (XEVENT_NEXT (event)))
3575 return Fcopy_event (event, Qnil);
3587 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
3590 int len = XVECTOR_LENGTH (vector);
3592 for (i = 0; i < len; i++)
3594 Lisp_Object event = XVECTOR_DATA (vector)[i];
3596 switch (XEVENT_TYPE (event))
3598 case button_press_event :
3599 case button_release_event :
3600 case misc_user_event :
3614 push_recent_keys (Lisp_Object event)
3618 if (NILP (Vrecent_keys_ring))
3619 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3621 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
3625 e = Fmake_event (Qnil, Qnil);
3626 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
3628 Fcopy_event (event, e);
3629 if (++recent_keys_ring_index == recent_keys_ring_size)
3630 recent_keys_ring_index = 0;
3635 current_events_into_vector (struct command_builder *command_builder)
3639 int n = event_chain_count (command_builder->current_events);
3641 /* Copy the vector and the events in it. */
3642 /* No need to copy the events, since they're already copies, and
3643 nobody other than the command-builder has pointers to them */
3644 vector = make_vector (n, Qnil);
3646 EVENT_CHAIN_LOOP (event, command_builder->current_events)
3647 XVECTOR_DATA (vector)[n++] = event;
3648 reset_command_builder_event_chain (command_builder);
3654 Given the current state of the command builder and a new command event
3655 that has just been dispatched:
3657 -- add the event to the event chain forming the current command
3658 (doing meta-translation as necessary)
3659 -- return the binding of this event chain; this will be one of:
3660 -- nil (there is no binding)
3661 -- a keymap (part of a command has been specified)
3662 -- a command (anything that satisfies `commandp'; this includes
3663 some symbols, lists, subrs, strings, vectors, and
3664 compiled-function objects)
3667 lookup_command_event (struct command_builder *command_builder,
3668 Lisp_Object event, int allow_misc_user_events_p)
3670 /* This function can GC */
3671 struct frame *f = selected_frame ();
3672 /* Clear output from previous command execution */
3673 if (!EQ (Qcommand, echo_area_status (f))
3674 /* but don't let mouse-up clear what mouse-down just printed */
3675 && (XEVENT (event)->event_type != button_release_event))
3676 clear_echo_area (f, Qnil, 0);
3678 /* Add the given event to the command builder.
3679 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3680 vectors to translate "ESC x" to "M-x" (for any "x" of course).
3683 Lisp_Object recent = command_builder->most_current_event;
3686 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
3689 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3690 DoubleThink the recent-keys and this-command-keys as well. */
3692 /* Modify the previous most-recently-pushed event on the command
3693 builder to be a copy of this one with the meta-bit set instead of
3694 pushing a new event.
3696 Fcopy_event (event, recent);
3697 e = XEVENT (recent);
3698 if (e->event_type == key_press_event)
3699 e->event.key.modifiers |= XEMACS_MOD_META;
3700 else if (e->event_type == button_press_event
3701 || e->event_type == button_release_event)
3702 e->event.button.modifiers |= XEMACS_MOD_META;
3707 int tckn = event_chain_count (Vthis_command_keys);
3709 /* ??? very strange if it's < 2. */
3710 this_command_keys_replace_suffix
3711 (event_chain_nth (Vthis_command_keys, tckn - 2),
3712 Fcopy_event (recent, Qnil));
3715 regenerate_echo_keys_from_this_command_keys (command_builder);
3719 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
3721 command_builder_append_event (command_builder, event);
3726 Lisp_Object leaf = command_builder_find_leaf (command_builder,
3727 allow_misc_user_events_p);
3728 struct gcpro gcpro1;
3733 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3734 if (!x_kludge_lw_menu_active ())
3739 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
3740 if (STRINGP (prompt))
3742 /* Append keymap prompt to key echo buffer */
3743 int buf_index = command_builder->echo_buf_index;
3744 Bytecount len = XSTRING_LENGTH (prompt);
3746 if (len + buf_index + 1 <= command_builder->echo_buf_length)
3748 Bufbyte *echo = command_builder->echo_buf + buf_index;
3749 memcpy (echo, XSTRING_DATA (prompt), len);
3752 maybe_echo_keys (command_builder, 1);
3755 maybe_echo_keys (command_builder, 0);
3757 else if (!NILP (Vquit_flag))
3759 Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
3760 Lisp_Event *e = XEVENT (quit_event);
3761 /* if quit happened during menu acceleration, pretend we read it */
3762 struct console *con = XCONSOLE (Fselected_console ());
3763 int ch = CONSOLE_QUIT_CHAR (con);
3765 character_to_event (ch, e, con, 1, 1);
3766 e->channel = make_console (con);
3768 enqueue_command_event (quit_event);
3772 else if (!NILP (leaf))
3774 if (EQ (Qcommand, echo_area_status (f))
3775 && command_builder->echo_buf_index > 0)
3777 /* If we had been echoing keys, echo the last one (without
3778 the trailing dash) and redisplay before executing the
3780 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
3781 maybe_echo_keys (command_builder, 1);
3782 Fsit_for (Qzero, Qt);
3785 RETURN_UNGCPRO (leaf);
3790 execute_command_event (struct command_builder *command_builder,
3793 /* This function can GC */
3794 struct console *con = XCONSOLE (command_builder->console);
3795 struct gcpro gcpro1;
3797 GCPRO1 (event); /* event may be freshly created */
3798 reset_current_events (command_builder);
3800 switch (XEVENT (event)->event_type)
3802 case key_press_event:
3803 Vcurrent_mouse_event = Qnil;
3805 case button_press_event:
3806 case button_release_event:
3807 case misc_user_event:
3808 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
3813 /* Store the last-command-event. The semantics of this is that it
3814 is the last event most recently involved in command-lookup. */
3815 if (!EVENTP (Vlast_command_event))
3816 Vlast_command_event = Fmake_event (Qnil, Qnil);
3817 if (XEVENT (Vlast_command_event)->event_type == dead_event)
3819 Vlast_command_event = Fmake_event (Qnil, Qnil);
3820 error ("Someone deallocated the last-command-event!");
3823 if (! EQ (event, Vlast_command_event))
3824 Fcopy_event (event, Vlast_command_event);
3826 /* Note that last-command-char will never have its high-bit set, in
3827 an effort to sidestep the ambiguity between M-x and oslash. */
3828 Vlast_command_char = Fevent_to_character (Vlast_command_event,
3831 /* Actually call the command, with all sorts of hair to preserve or clear
3832 the echo-area and region as appropriate and call the pre- and post-
3835 int old_kbd_macro = con->kbd_macro_end;
3836 struct window *w = XWINDOW (Fselected_window (Qnil));
3838 /* We're executing a new command, so the old value is irrelevant. */
3839 zmacs_region_stays = 0;
3841 /* If the previous command tried to force a specific window-start,
3842 reset the flag in case this command moves point far away from
3843 that position. Also, reset the window's buffer's change
3844 information so that we don't trigger an incremental update. */
3848 buffer_reset_changes (XBUFFER (w->buffer));
3851 pre_command_hook ();
3853 if (XEVENT (event)->event_type == misc_user_event)
3855 call1 (XEVENT (event)->event.eval.function,
3856 XEVENT (event)->event.eval.object);
3860 Fcommand_execute (Vthis_command, Qnil, Qnil);
3863 post_command_hook ();
3865 #if 0 /* #### here was an attempted fix that didn't work */
3866 if (XEVENT (event)->event_type == misc_user_event)
3870 if (!NILP (con->prefix_arg))
3872 /* Commands that set the prefix arg don't update last-command, don't
3873 reset the echoing state, and don't go into keyboard macros unless
3874 followed by another command. */
3875 maybe_echo_keys (command_builder, 0);
3877 /* If we're recording a keyboard macro, and the last command
3878 executed set a prefix argument, then decrement the pointer to
3879 the "last character really in the macro" to be just before this
3880 command. This is so that the ^U in "^U ^X )" doesn't go onto
3881 the end of macro. */
3882 if (!NILP (con->defining_kbd_macro))
3883 con->kbd_macro_end = old_kbd_macro;
3887 /* Start a new command next time */
3888 Vlast_command = Vthis_command;
3889 Vlast_command_properties = Vthis_command_properties;
3890 Vthis_command_properties = Qnil;
3892 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
3893 so we don't either */
3894 reset_this_command_keys (make_console (con), 0);
3901 /* Run the pre command hook. */
3904 pre_command_hook (void)
3906 last_point_position = BUF_PT (current_buffer);
3907 XSETBUFFER (last_point_position_buffer, current_buffer);
3908 /* This function can GC */
3909 safe_run_hook_trapping_errors
3910 ("Error in `pre-command-hook' (setting hook to nil)",
3911 Qpre_command_hook, 1);
3913 /* This is a kludge, but necessary; see simple.el */
3914 call0 (Qhandle_pre_motion_command);
3917 /* Run the post command hook. */
3920 post_command_hook (void)
3922 /* This function can GC */
3923 /* Turn off region highlighting unless this command requested that
3924 it be left on, or we're in the minibuffer. We don't turn it off
3925 when we're in the minibuffer so that things like M-x write-region
3928 This could be done via a function on the post-command-hook, but
3929 we don't want the user to accidentally remove it.
3932 Lisp_Object win = Fselected_window (Qnil);
3934 /* If the last command deleted the frame, `win' might be nil.
3935 It seems safest to do nothing in this case. */
3936 /* Note: Someone added the following comment and put #if 0's around
3937 this code, not realizing that doing this invites a crash in the
3939 /* #### This doesn't really fix the problem,
3940 if delete-frame is called by some hook */
3944 /* This is a kludge, but necessary; see simple.el */
3945 call0 (Qhandle_post_motion_command);
3947 if (! zmacs_region_stays
3948 && (!MINI_WINDOW_P (XWINDOW (win))
3949 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
3950 zmacs_deactivate_region ();
3952 zmacs_update_region ();
3954 safe_run_hook_trapping_errors
3955 ("Error in `post-command-hook' (setting hook to nil)",
3956 Qpost_command_hook, 1);
3958 #if 0 /* FSF Emacs crap */
3959 if (!NILP (Vdeferred_action_list))
3960 call0 (Vdeferred_action_function);
3962 if (NILP (Vunread_command_events)
3963 && NILP (Vexecuting_macro)
3964 && !NILP (Vpost_command_idle_hook)
3965 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
3967 safe_run_hook_trapping_errors
3968 ("Error in `post-command-idle-hook' (setting hook to nil)",
3969 Qpost_command_idle_hook, 1);
3970 #endif /* FSF Emacs crap */
3972 #if 0 /* FSF Emacs */
3973 if (!NILP (current_buffer->mark_active))
3975 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
3977 current_buffer->mark_active = Qnil;
3978 run_hook (intern ("deactivate-mark-hook"));
3980 else if (current_buffer != prev_buffer ||
3981 BUF_MODIFF (current_buffer) != prev_modiff)
3982 run_hook (intern ("activate-mark-hook"));
3984 #endif /* FSF Emacs */
3986 /* #### Kludge!!! This is necessary to make sure that things
3987 are properly positioned even if post-command-hook moves point.
3988 #### There should be a cleaner way of handling this. */
3989 call0 (Qauto_show_make_point_visible);
3993 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
3994 Given an event object as returned by `next-event', execute it.
3996 Key-press, button-press, and button-release events get accumulated
3997 until a complete key sequence (see `read-key-sequence') is reached,
3998 at which point the sequence is looked up in the current keymaps and
4001 Mouse motion events cause the low-level handling function stored in
4002 `mouse-motion-handler' to be called. (There are very few circumstances
4003 under which you should change this handler. Use `mode-motion-hook'
4006 Menu, timeout, and eval events cause the associated function or handler
4009 Process events cause the subprocess's output to be read and acted upon
4010 appropriately (see `start-process').
4012 Magic events are handled as necessary.
4016 /* This function can GC */
4017 struct command_builder *command_builder;
4019 Lisp_Object console;
4020 Lisp_Object channel;
4022 CHECK_LIVE_EVENT (event);
4023 ev = XEVENT (event);
4025 /* events on dead channels get silently eaten */
4026 channel = EVENT_CHANNEL (ev);
4027 if (object_dead_p (channel))
4030 /* Some events don't have channels (e.g. eval events). */
4031 console = CDFW_CONSOLE (channel);
4033 console = Vselected_console;
4034 else if (!EQ (console, Vselected_console))
4035 Fselect_console (console);
4037 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4038 switch (XEVENT (event)->event_type)
4040 case button_press_event:
4041 case button_release_event:
4042 case key_press_event:
4044 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4047 /* Incomplete key sequence */
4051 /* At this point, we know that the sequence is not bound to a
4052 command. Normally, we beep and print a message informing the
4053 user of this. But we do not beep or print a message when:
4055 o the last event in this sequence is a mouse-up event; or
4056 o the last event in this sequence is a mouse-down event and
4057 there is a binding for the mouse-up version.
4059 That is, if the sequence ``C-x button1'' is typed, and is not
4060 bound to a command, but the sequence ``C-x button1up'' is bound
4061 to a command, we do not complain about the ``C-x button1''
4062 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4063 bound to a command, then we complain about the ``C-x button1''
4064 sequence, but later will *not* complain about the
4065 ``C-x button1up'' sequence, which would be redundant.
4067 This is pretty hairy, but I think it's the most intuitive
4070 Lisp_Object terminal = command_builder->most_current_event;
4072 if (XEVENT_TYPE (terminal) == button_press_event)
4075 /* Temporarily pretend the last event was an "up" instead of a
4076 "down", and look up its binding. */
4077 XEVENT_TYPE (terminal) = button_release_event;
4078 /* If the "up" version is bound, don't complain. */
4080 = !NILP (command_builder_find_leaf (command_builder, 0));
4081 /* Undo the temporary changes we just made. */
4082 XEVENT_TYPE (terminal) = button_press_event;
4085 /* Pretend this press was not seen (treat as a prefix) */
4086 if (EQ (command_builder->current_events, terminal))
4088 reset_current_events (command_builder);
4094 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4095 if (EQ (XEVENT_NEXT (eve), terminal))
4098 Fdeallocate_event (command_builder->
4099 most_current_event);
4100 XSET_EVENT_NEXT (eve, Qnil);
4101 command_builder->most_current_event = eve;
4103 maybe_echo_keys (command_builder, 1);
4108 /* Complain that the typed sequence is not defined, if this is the
4109 kind of sequence that warrants a complaint. */
4110 XCONSOLE (console)->defining_kbd_macro = Qnil;
4111 XCONSOLE (console)->prefix_arg = Qnil;
4112 /* Don't complain about undefined button-release events */
4113 if (XEVENT_TYPE (terminal) != button_release_event)
4115 Lisp_Object keys = current_events_into_vector (command_builder);
4116 struct gcpro gcpro1;
4118 /* Run the pre-command-hook before barfing about an undefined
4120 Vthis_command = Qnil;
4122 pre_command_hook ();
4124 /* The post-command-hook doesn't run. */
4125 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4127 /* Reset the command builder for reading the next sequence. */
4128 reset_this_command_keys (console, 1);
4130 else /* key sequence is bound to a command */
4133 int magic_undo_count = 20;
4135 Vthis_command = leaf;
4137 /* Don't push an undo boundary if the command set the prefix arg,
4138 or if we are executing a keyboard macro, or if in the
4139 minibuffer. If the command we are about to execute is
4140 self-insert, it's tricky: up to 20 consecutive self-inserts may
4141 be done without an undo boundary. This counter is reset as
4142 soon as a command other than self-insert-command is executed.
4144 Programmers can also use the `self-insert-defer-undo'
4145 property to install that behavior on functions other
4146 than `self-insert-command', or to change the magic
4147 number 20 to something else. #### DOCUMENT THIS! */
4151 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
4153 magic_undo = 1, magic_undo_count = XINT (prop);
4154 else if (!NILP (prop))
4156 else if (EQ (leaf, Qself_insert_command))
4161 command_builder->self_insert_countdown = 0;
4162 if (NILP (XCONSOLE (console)->prefix_arg)
4163 && NILP (Vexecuting_macro)
4165 /* This was done in the days when there was no undo
4166 in the minibuffer. If we don't disable this code,
4167 then each instance of "undo" undoes everything in
4169 && !EQ (minibuf_window, Fselected_window (Qnil))
4171 && command_builder->self_insert_countdown == 0)
4176 if (--command_builder->self_insert_countdown < 0)
4177 command_builder->self_insert_countdown = magic_undo_count;
4179 execute_command_event
4181 internal_equal (event, command_builder-> most_current_event, 0)
4183 /* Use the translated event that was most recently seen.
4184 This way, last-command-event becomes f1 instead of
4185 the P from ESC O P. But we must copy it, else we'll
4186 lose when the command-builder events are deallocated. */
4187 : Fcopy_event (command_builder-> most_current_event, Qnil));
4191 case misc_user_event:
4195 We could just always use the menu item entry, whatever it is, but
4196 this might break some Lisp code that expects `this-command' to
4197 always contain a symbol. So only store it if this is a simple
4198 `call-interactively' sort of menu item.
4200 But this is bogus. `this-command' could be a string or vector
4201 anyway (for keyboard macros). There's even one instance
4202 (in pending-del.el) of `this-command' getting set to a cons
4203 (a lambda expression). So in the `eval' case I'll just
4204 convert it into a lambda expression.
4206 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4207 && SYMBOLP (XEVENT (event)->event.eval.object))
4208 Vthis_command = XEVENT (event)->event.eval.object;
4209 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4211 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4212 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4213 /* A scrollbar command or the like. */
4214 Vthis_command = XEVENT (event)->event.eval.function;
4217 Vthis_command = Qnil;
4219 /* clear the echo area */
4220 reset_key_echo (command_builder, 1);
4222 command_builder->self_insert_countdown = 0;
4223 if (NILP (XCONSOLE (console)->prefix_arg)
4224 && NILP (Vexecuting_macro)
4225 && !EQ (minibuf_window, Fselected_window (Qnil)))
4227 execute_command_event (command_builder, event);
4232 execute_internal_event (event);
4239 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4240 Read a sequence of keystrokes or mouse clicks.
4241 Returns a vector of the event objects read. The vector and the event
4242 objects it contains are freshly created (and will not be side-effected
4243 by subsequent calls to this function).
4245 The sequence read is sufficient to specify a non-prefix command starting
4246 from the current local and global keymaps. A C-g typed while in this
4247 function is treated like any other character, and `quit-flag' is not set.
4249 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4250 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4251 as a continuation of the previous key.
4253 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4254 convert the last event to lower case. (Normally any upper case event
4255 is converted to lower case if the original event is undefined and the lower
4256 case equivalent is defined.) This argument is provided mostly for
4257 FSF compatibility; the equivalent effect can be achieved more generally
4258 by binding `retry-undefined-key-binding-unshifted' to nil around the
4259 call to `read-key-sequence'.
4261 A C-g typed while in this function is treated like any other character,
4262 and `quit-flag' is not set.
4264 If the user selects a menu item while we are prompting for a key-sequence,
4265 the returned value will be a vector of a single menu-selection event.
4266 An error will be signalled if you pass this value to `lookup-key' or a
4269 `read-key-sequence' checks `function-key-map' for function key
4270 sequences, where they wouldn't conflict with ordinary bindings. See
4271 `function-key-map' for more details.
4273 (prompt, continue_echo, dont_downcase_last))
4275 /* This function can GC */
4276 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4280 struct command_builder *command_builder =
4281 XCOMMAND_BUILDER (con->command_builder);
4283 Lisp_Object event = Fmake_event (Qnil, Qnil);
4284 int speccount = specpdl_depth ();
4285 struct gcpro gcpro1;
4289 CHECK_STRING (prompt);
4290 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4293 if (NILP (continue_echo))
4294 reset_this_command_keys (make_console (con), 1);
4296 specbind (Qinhibit_quit, Qt);
4298 if (!NILP (dont_downcase_last))
4299 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4303 Fnext_event (event, prompt);
4304 /* restore the selected-console damage */
4305 con = event_console_or_selected (event);
4306 command_builder = XCOMMAND_BUILDER (con->command_builder);
4307 if (! command_event_p (event))
4308 execute_internal_event (event);
4311 if (XEVENT (event)->event_type == misc_user_event)
4312 reset_current_events (command_builder);
4313 result = lookup_command_event (command_builder, event, 1);
4314 if (!KEYMAPP (result))
4316 result = current_events_into_vector (command_builder);
4317 reset_key_echo (command_builder, 0);
4324 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4325 Fdeallocate_event (event);
4326 RETURN_UNGCPRO (unbind_to (speccount, result));
4329 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4330 Return a vector of the keyboard or mouse button events that were used
4331 to invoke this command. This copies the vector and the events; it is safe
4332 to keep and modify them.
4340 if (NILP (Vthis_command_keys))
4341 return make_vector (0, Qnil);
4343 len = event_chain_count (Vthis_command_keys);
4345 result = make_vector (len, Qnil);
4347 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4348 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4352 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4353 Used for complicated reasons in `universal-argument-other-key'.
4355 `universal-argument-other-key' rereads the event just typed.
4356 It then gets translated through `function-key-map'.
4357 The translated event gets included in the echo area and in
4358 the value of `this-command-keys' in addition to the raw original event.
4361 Calling this function directs the translated event to replace
4362 the original event, so that only one version of the event actually
4363 appears in the echo area and in the value of `this-command-keys'.
4367 /* #### I don't understand this at all, so currently it does nothing.
4368 If there is ever a problem, maybe someone should investigate. */
4374 dribble_out_event (Lisp_Object event)
4376 if (NILP (Vdribble_file))
4379 if (XEVENT (event)->event_type == key_press_event &&
4380 !XEVENT (event)->event.key.modifiers)
4382 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4383 if (CHARP (XEVENT (event)->event.key.keysym))
4385 Emchar ch = XCHAR (keysym);
4386 Bufbyte str[MAX_EMCHAR_LEN];
4387 Bytecount len = set_charptr_emchar (str, ch);
4388 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4390 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4391 /* one-char key events are printed with just the key name */
4392 Fprinc (keysym, Vdribble_file);
4393 else if (EQ (keysym, Qreturn))
4394 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4395 else if (EQ (keysym, Qspace))
4396 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4398 Fprinc (event, Vdribble_file);
4401 Fprinc (event, Vdribble_file);
4402 Lstream_flush (XLSTREAM (Vdribble_file));
4405 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4406 "FOpen dribble file: ", /*
4407 Start writing all keyboard characters to a dribble file called FILE.
4408 If FILE is nil, close any open dribble file.
4412 /* This function can GC */
4413 /* XEmacs change: always close existing dribble file. */
4414 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4415 if (!NILP (Vdribble_file))
4417 Lstream_close (XLSTREAM (Vdribble_file));
4418 Vdribble_file = Qnil;
4424 file = Fexpand_file_name (file, Qnil);
4425 fd = open ((char*) XSTRING_DATA (file),
4426 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4429 error ("Unable to create dribble file");
4430 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4433 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4434 Fget_coding_system (Qescape_quoted));
4442 DEFUN ("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
4443 Return the current event timestamp of the window system associated with CONSOLE.
4444 CONSOLE defaults to the selected console if omitted.
4448 struct console *c = decode_console (console);
4449 int tiempo = event_stream_current_event_timestamp (c);
4451 /* This junk is so that timestamps don't get to be negative, but contain
4452 as many bits as this particular emacs will allow.
4454 return make_int (((1L << (VALBITS - 1)) - 1) & tiempo);
4458 /************************************************************************/
4459 /* initialization */
4460 /************************************************************************/
4463 syms_of_event_stream (void)
4465 INIT_LRECORD_IMPLEMENTATION (command_builder);
4466 INIT_LRECORD_IMPLEMENTATION (timeout);
4468 defsymbol (&Qdisabled, "disabled");
4469 defsymbol (&Qcommand_event_p, "command-event-p");
4471 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qinvalid_argument);
4473 DEFSUBR (Frecent_keys);
4474 DEFSUBR (Frecent_keys_ring_size);
4475 DEFSUBR (Fset_recent_keys_ring_size);
4476 DEFSUBR (Finput_pending_p);
4477 DEFSUBR (Fenqueue_eval_event);
4478 DEFSUBR (Fnext_event);
4479 DEFSUBR (Fnext_command_event);
4480 DEFSUBR (Fdiscard_input);
4482 DEFSUBR (Fsleep_for);
4483 DEFSUBR (Faccept_process_output);
4484 DEFSUBR (Fadd_timeout);
4485 DEFSUBR (Fdisable_timeout);
4486 DEFSUBR (Fadd_async_timeout);
4487 DEFSUBR (Fdisable_async_timeout);
4488 DEFSUBR (Fdispatch_event);
4489 DEFSUBR (Fdispatch_non_command_events);
4490 DEFSUBR (Fread_key_sequence);
4491 DEFSUBR (Fthis_command_keys);
4492 DEFSUBR (Freset_this_command_lengths);
4493 DEFSUBR (Fopen_dribble_file);
4494 DEFSUBR (Fcurrent_event_timestamp);
4496 defsymbol (&Qpre_command_hook, "pre-command-hook");
4497 defsymbol (&Qpost_command_hook, "post-command-hook");
4498 defsymbol (&Qunread_command_events, "unread-command-events");
4499 defsymbol (&Qunread_command_event, "unread-command-event");
4500 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4501 defsymbol (&Qhandle_pre_motion_command, "handle-pre-motion-command");
4502 defsymbol (&Qhandle_post_motion_command, "handle-post-motion-command");
4503 #if 0 /* FSF Emacs crap */
4504 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4505 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4507 defsymbol (&Qretry_undefined_key_binding_unshifted,
4508 "retry-undefined-key-binding-unshifted");
4509 defsymbol (&Qauto_show_make_point_visible,
4510 "auto-show-make-point-visible");
4512 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
4513 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4517 reinit_vars_of_event_stream (void)
4519 recent_keys_ring_index = 0;
4520 recent_keys_ring_size = 100;
4521 num_input_chars = 0;
4522 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4524 staticpro_nodump (&Vtimeout_free_list);
4525 the_low_level_timeout_blocktype =
4526 Blocktype_new (struct low_level_timeout_blocktype);
4527 something_happened = 0;
4528 recursive_sit_for = Qnil;
4532 vars_of_event_stream (void)
4534 reinit_vars_of_event_stream ();
4535 Vrecent_keys_ring = Qnil;
4536 staticpro (&Vrecent_keys_ring);
4538 Vthis_command_keys = Qnil;
4539 staticpro (&Vthis_command_keys);
4540 Vthis_command_keys_tail = Qnil;
4541 pdump_wire (&Vthis_command_keys_tail);
4543 command_event_queue = Qnil;
4544 staticpro (&command_event_queue);
4545 command_event_queue_tail = Qnil;
4546 pdump_wire (&command_event_queue_tail);
4548 Vlast_selected_frame = Qnil;
4549 staticpro (&Vlast_selected_frame);
4551 pending_timeout_list = Qnil;
4552 staticpro (&pending_timeout_list);
4554 pending_async_timeout_list = Qnil;
4555 staticpro (&pending_async_timeout_list);
4557 last_point_position_buffer = Qnil;
4558 staticpro (&last_point_position_buffer);
4560 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
4561 *Nonzero means echo unfinished commands after this many seconds of pause.
4563 Vecho_keystrokes = make_int (1);
4565 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
4566 *Number of keyboard input characters between auto-saves.
4567 Zero means disable autosaving due to number of characters typed.
4568 See also the variable `auto-save-timeout'.
4570 auto_save_interval = 300;
4572 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
4573 Function or functions to run before every command.
4574 This may examine the `this-command' variable to find out what command
4575 is about to be run, or may change it to cause a different command to run.
4576 Function on this hook must be careful to avoid signalling errors!
4578 Vpre_command_hook = Qnil;
4580 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
4581 Function or functions to run after every command.
4582 This may examine the `this-command' variable to find out what command
4585 Vpost_command_hook = Qnil;
4587 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
4588 Normal hook run when XEmacs it about to be idle.
4589 This occurs whenever it is going to block, waiting for an event.
4590 This generally happens as a result of a call to `next-event',
4591 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4592 or `x-get-selection'.
4593 Errors running the hook are caught and ignored.
4595 Vpre_idle_hook = Qnil;
4597 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
4598 *Variable to control XEmacs behavior with respect to focus changing.
4599 If this variable is set to t, then XEmacs will not gratuitously change
4600 the keyboard focus. XEmacs cannot in general detect when this mode is
4601 used by the window manager, so it is up to the user to set it.
4603 focus_follows_mouse = 0;
4605 #if 0 /* FSF Emacs crap */
4606 /* Ill-conceived because it's not run in all sorts of cases
4607 where XEmacs is blocking. That's what `pre-idle-hook'
4608 is designed to solve. */
4609 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
4610 Normal hook run after each command is executed, if idle.
4611 `post-command-idle-delay' specifies a time in microseconds that XEmacs
4612 must be idle for in order for the functions on this hook to be called.
4613 Errors running the hook are caught and ignored.
4615 Vpost_command_idle_hook = Qnil;
4617 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
4618 Delay time before running `post-command-idle-hook'.
4619 This is measured in microseconds.
4621 post_command_idle_delay = 5000;
4623 /* Random FSFmacs crap. There is absolutely nothing to gain,
4624 and a great deal to lose, in using this in place of just
4625 setting `post-command-hook'. */
4626 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
4627 List of deferred actions to be performed at a later time.
4628 The precise format isn't relevant here; we just check whether it is nil.
4630 Vdeferred_action_list = Qnil;
4632 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
4633 Function to call to handle deferred actions, after each command.
4634 This function is called with no arguments after each command
4635 whenever `deferred-action-list' is non-nil.
4637 Vdeferred_action_function = Qnil;
4638 #endif /* FSF Emacs crap */
4640 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
4641 Last keyboard or mouse button event that was part of a command. This
4642 variable is off limits: you may not set its value or modify the event that
4643 is its value, as it is destructively modified by `read-key-sequence'. If
4644 you want to keep a pointer to this value, you must use `copy-event'.
4646 Vlast_command_event = Qnil;
4648 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
4649 If the value of `last-command-event' is a keyboard event, then
4650 this is the nearest ASCII equivalent to it. This is the value that
4651 `self-insert-command' will put in the buffer. Remember that there is
4652 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4653 of keyboard events is much larger, so writing code that examines this
4654 variable to determine what key has been typed is bad practice, unless
4655 you are certain that it will be one of a small set of characters.
4657 Vlast_command_char = Qnil;
4659 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
4660 Last keyboard or mouse button event received. This variable is off
4661 limits: you may not set its value or modify the event that is its value, as
4662 it is destructively modified by `next-event'. If you want to keep a pointer
4663 to this value, you must use `copy-event'.
4665 Vlast_input_event = Qnil;
4667 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
4668 The mouse-button event which invoked this command, or nil.
4669 This is usually what `(interactive "e")' returns.
4671 Vcurrent_mouse_event = Qnil;
4673 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
4674 If the value of `last-input-event' is a keyboard event, then
4675 this is the nearest ASCII equivalent to it. Remember that there is
4676 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4677 of keyboard events is much larger, so writing code that examines this
4678 variable to determine what key has been typed is bad practice, unless
4679 you are certain that it will be one of a small set of characters.
4681 Vlast_input_char = Qnil;
4683 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
4684 The time (in seconds since Jan 1, 1970) of the last-command-event,
4685 represented as a cons of two 16-bit integers. This is destructively
4686 modified, so copy it if you want to keep it.
4688 Vlast_input_time = Qnil;
4690 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
4691 The time (in seconds since Jan 1, 1970) of the last-command-event,
4692 represented as a list of three integers. The first integer contains
4693 the most significant 16 bits of the number of seconds, and the second
4694 integer contains the least significant 16 bits. The third integer
4695 contains the remainder number of microseconds, if the current system
4696 supports microsecond clock resolution. This list is destructively
4697 modified, so copy it if you want to keep it.
4699 Vlast_command_event_time = Qnil;
4701 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
4702 List of event objects to be read as next command input events.
4703 This can be used to simulate the receipt of events from the user.
4704 Normally this is nil.
4705 Events are removed from the front of this list.
4707 Vunread_command_events = Qnil;
4709 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
4710 Obsolete. Use `unread-command-events' instead.
4712 Vunread_command_event = Qnil;
4714 DEFVAR_LISP ("last-command", &Vlast_command /*
4715 The last command executed. Normally a symbol with a function definition,
4716 but can be whatever was found in the keymap, or whatever the variable
4717 `this-command' was set to by that command.
4719 Vlast_command = Qnil;
4721 DEFVAR_LISP ("this-command", &Vthis_command /*
4722 The command now being executed.
4723 The command can set this variable; whatever is put here
4724 will be in `last-command' during the following command.
4726 Vthis_command = Qnil;
4728 DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /*
4729 Value of `this-command-properties' for the last command.
4730 Used by commands to help synchronize consecutive commands, in preference
4731 to looking at `last-command' directly.
4733 Vlast_command_properties = Qnil;
4735 DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /*
4736 Properties set by the current command.
4737 At the beginning of each command, the current value of this variable is
4738 copied to `last-command-properties', and then it is set to nil. Use `putf'
4739 to add properties to this variable. Commands should use this to communicate
4740 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4741 in preference to looking at and/or setting `this-command'.
4743 Vthis_command_properties = Qnil;
4745 DEFVAR_LISP ("help-char", &Vhelp_char /*
4746 Character to recognize as meaning Help.
4747 When it is read, do `(eval help-form)', and display result if it's a string.
4748 If the value of `help-form' is nil, this char can be read normally.
4749 This can be any form recognized as a single key specifier.
4750 The help-char cannot be a negative number in XEmacs.
4752 Vhelp_char = make_char (8); /* C-h */
4754 DEFVAR_LISP ("help-form", &Vhelp_form /*
4755 Form to execute when character help-char is read.
4756 If the form returns a string, that string is displayed.
4757 If `help-form' is nil, the help char is not recognized.
4761 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
4762 Command to run when `help-char' character follows a prefix key.
4763 This command is used only when there is no actual binding
4764 for that character after that prefix key.
4766 Vprefix_help_command = Qnil;
4768 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
4769 Hash table used as translate table for keyboard input.
4770 Use `keyboard-translate' to portably add entries to this table.
4771 Each key-press event is looked up in this table as follows:
4773 -- If an entry maps a symbol to a symbol, then a key-press event whose
4774 keysym is the former symbol (with any modifiers at all) gets its
4775 keysym changed and its modifiers left alone. This is useful for
4776 dealing with non-standard X keyboards, such as the grievous damage
4777 that Sun has inflicted upon the world.
4778 -- If an entry maps a symbol to a character, then a key-press event
4779 whose keysym is the former symbol (with any modifiers at all) gets
4780 changed into a key-press event matching the latter character, and the
4781 resulting modifiers are the union of the original and new modifiers.
4782 -- If an entry maps a character to a character, then a key-press event
4783 matching the former character gets converted to a key-press event
4784 matching the latter character. This is useful on ASCII terminals
4785 for (e.g.) making C-\\ look like C-s, to get around flow-control
4787 -- If an entry maps a character to a symbol, then a key-press event
4788 matching the character gets converted to a key-press event whose
4789 keysym is the given symbol and which has no modifiers.
4791 Here's an example: This makes typing parens and braces easier by rerouting
4792 their positions to eliminate the need to use the Shift key.
4794 (keyboard-translate ?[ ?()
4795 (keyboard-translate ?] ?))
4796 (keyboard-translate ?{ ?[)
4797 (keyboard-translate ?} ?])
4798 (keyboard-translate 'f11 ?{)
4799 (keyboard-translate 'f12 ?})
4802 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
4803 &Vretry_undefined_key_binding_unshifted /*
4804 If a key-sequence which ends with a shifted keystroke is undefined
4805 and this variable is non-nil then the command lookup is retried again
4806 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
4807 If lookup still fails, a normal error is signalled. In general,
4808 you should *bind* this, not set it.
4810 Vretry_undefined_key_binding_unshifted = Qt;
4812 DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
4813 *Non-nil makes modifier keys sticky.
4814 This means that you can release the modifier key before pressing down
4815 the key that you wish to be modified. Although this is non-standard
4816 behavior, it is recommended because it reduces the strain on your hand,
4817 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4819 modifier_keys_are_sticky = 0;
4822 DEFVAR_LISP ("composed-character-default-binding",
4823 &Vcomposed_character_default_binding /*
4824 The default keybinding to use for key events from composed input.
4825 Window systems frequently have ways to allow the user to compose
4826 single characters in a language using multiple keystrokes.
4827 XEmacs sees these as single character keypress events.
4829 Vcomposed_character_default_binding = Qself_insert_command;
4830 #endif /* HAVE_XIM */
4832 Vcontrolling_terminal = Qnil;
4833 staticpro (&Vcontrolling_terminal);
4835 Vdribble_file = Qnil;
4836 staticpro (&Vdribble_file);
4839 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
4840 If non-zero, display debug information about Emacs events that XEmacs sees.
4841 Information is displayed on stderr.
4843 Before the event, the source of the event is displayed in parentheses,
4844 and is one of the following:
4846 \(real) A real event from the window system or
4847 terminal driver, as far as XEmacs can tell.
4849 \(keyboard macro) An event generated from a keyboard macro.
4851 \(unread-command-events) An event taken from `unread-command-events'.
4853 \(unread-command-event) An event taken from `unread-command-event'.
4855 \(command event queue) An event taken from an internal queue.
4856 Events end up on this queue when
4857 `enqueue-eval-event' is called or when
4858 user or eval events are received while
4859 XEmacs is blocking (e.g. in `sit-for',
4860 `sleep-for', or `accept-process-output',
4861 or while waiting for the reply to an
4864 \(->keyboard-translate-table) The result of an event translated through
4865 keyboard-translate-table. Note that in
4866 this case, two events are printed even
4867 though only one is really generated.
4869 \(SIGINT) A faked C-g resulting when XEmacs receives
4870 a SIGINT (e.g. C-c was pressed in XEmacs'
4871 controlling terminal or the signal was
4872 explicitly sent to the XEmacs process).
4874 debug_emacs_events = 0;
4877 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
4878 Non-nil inhibits recording of input-events to recent-keys ring.
4880 inhibit_input_event_recording = 0;
4884 complex_vars_of_event_stream (void)
4886 Vkeyboard_translate_table =
4887 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4891 init_event_stream (void)
4895 #ifdef HAVE_UNIXOID_EVENT_LOOP
4896 init_event_unixoid ();
4898 #ifdef HAVE_X_WINDOWS
4899 if (!strcmp (display_use, "x"))
4900 init_event_Xt_late ();
4903 #ifdef HAVE_MS_WINDOWS
4904 if (!strcmp (display_use, "mswindows"))
4905 init_event_mswindows_late ();
4909 /* For TTY's, use the Xt event loop if we can; it allows
4910 us to later open an X connection. */
4911 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
4912 || (defined (HAVE_MSG_SELECT) \
4913 && !defined (DEBUG_TTY_EVENT_STREAM)))
4914 init_event_mswindows_late ();
4915 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
4916 init_event_Xt_late ();
4917 #elif defined (HAVE_TTY)
4918 init_event_tty_late ();
4921 init_interrupts_late ();
4927 useful testcases for v18/v19 compatibility:
4931 (setq unread-command-event (character-to-event ?A (allocate-event)))
4932 (setq x (list (read-char)
4933 ; (read-key-sequence "") ; try it with and without this
4934 last-command-char last-input-char
4935 (recent-keys) (this-command-keys))))
4936 (global-set-key "\^Q" 'foo)
4938 without the read-key-sequence:
4939 ^Q ==> (65 17 65 [... ^Q] [^Q])
4940 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
4941 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
4943 with the read-key-sequence:
4944 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
4945 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
4946 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
4948 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
4950 ;(setq x (list (read-char) quit-flag))^J^G
4951 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
4952 ;for BOTH, x should get set to (7 t), but no result should be printed.
4954 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
4955 ;in *scratch*, type (sit-for 20)^J
4956 ;wait a couple of seconds, move cursor to foo, type "a"
4957 ;a should be inserted in foo. Cursor highlighting should not change in
4960 ;do it with sleep-for. move cursor into foo, then back into *scratch*
4962 ;repeat also with (accept-process-output nil 20)
4964 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
4967 (list (condition-case c
4972 (tst)^Ja^G ==> ((quit) 97) with no signal
4973 (tst)^J^Ga ==> ((quit) 97) with no signal
4974 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
4976 ; with sit-for only do the 2nd test.
4977 ; Do all 3 tests with (accept-process-output nil 20)
4980 (setq enable-recursive-minibuffers t
4981 minibuffer-max-depth nil)
4982 ESC ESC ESC ESC - there are now two minibuffers active
4983 C-g C-g C-g - there should be active 0, not 1
4985 C-x C-f ~ / ? - wait for "Making completion list..." to display
4986 C-g - wait for "Quit" to display
4987 C-g - minibuffer should not be active
4988 however C-g before "Quit" is displayed should leave minibuffer active.
4990 ;do it all in both v18 and v19 and make sure all results are the same.
4991 ;all of these cases matter a lot, but some in quite subtle ways.
4995 Additional test cases for accept-process-output, sleep-for, sit-for.
4996 Be sure you do all of the above checking for C-g and focus, too!
4998 ; Make sure that timer handlers are run during, not after sit-for:
4999 (defun timer-check ()
5000 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5002 (message "after sit-for"))
5004 ; The first message should appear after 2 seconds, and the final message
5005 ; 3 seconds after that.
5006 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5010 ; Make sure that process filters are run during, not after sit-for.
5012 (message "sit-for = %s" (sit-for 30)))
5013 (add-hook 'post-command-hook 'fubar)
5015 ; Now type M-x shell RET
5016 ; wait for the shell prompt then send: ls RET
5017 ; the output of ls should fill immediately, and not wait 30 seconds.
5019 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5023 ; Make sure that recursive invocations return immediately:
5024 (defmacro test-diff-time (start end)
5025 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5026 (- (cadr ,end) (cadr ,start))
5027 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5029 (defun testee (ignore)
5033 (let ((start (current-time))
5035 (add-timeout 2 'testee nil)
5037 (add-timeout 2 'testee nil)
5039 (add-timeout 2 'testee nil)
5040 (accept-process-output nil 5)
5041 (setq end (current-time))
5042 (test-diff-time start end)))
5044 (test-them) should sit for 15 seconds.
5045 Repeat with testee set to sleep-for and accept-process-output.
5046 These should each delay 36 seconds.