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. */
26 /* This file has been Mule-ized. */
31 * If you ever change ANYTHING in this file, you MUST run the
32 * testcases at the end to make sure that you haven't changed
33 * the semantics of recent-keys, last-input-char, or keyboard
34 * macros. You'd be surprised how easy it is to break this.
39 This stuff is way too hard to maintain - needs rework.
41 (global-set-key "\C-p" global-map) causes a crash - need recursion check.
43 C-x @ h <scrollbar-drag> x causes a crash.
45 The command builder should deal only with key and button events.
46 Other command events should be able to come in the MIDDLE of a key
47 sequence, without disturbing the key sequence composition, or the
48 command builder structure representing it.
50 Someone should rethink univeral-argument and figure out how an
51 arbitrary command can influence the next command (universal-argument
52 or univeral-coding-system-argument) or the next key (hyperify).
54 Both C-h and Help in the middle of a key sequence should trigger
55 prefix-help-command. help-char is stupid. Maybe we need
56 keymap-of-last-resort?
58 After prefix-help is run, one should be able to CONTINUE TYPING,
59 instead of RETYPING, the key sequence.
66 #include "console-x.h" /* for menu accelerators ... */
68 #include "../lwlib/lwlib.h"
70 #define lw_menu_active 0
73 #include "blocktype.h"
80 #include "insdel.h" /* for buffer_reset_changes */
83 #include "macros.h" /* for defining_keyboard_macro */
88 #include "sysdep.h" /* init_poll_for_quit() */
89 #include "syssignal.h" /* SIGCHLD, etc. */
91 #include "systime.h" /* to set Vlast_input_time */
93 #include "events-mod.h"
95 #include "file-coding.h"
100 /* The number of keystrokes between auto-saves. */
101 static int auto_save_interval;
103 Lisp_Object Qundefined_keystroke_sequence;
105 Lisp_Object Qcommand_execute;
107 Lisp_Object Qcommand_event_p;
109 /* Hooks to run before and after each command. */
110 Lisp_Object Vpre_command_hook, Vpost_command_hook;
111 Lisp_Object Qpre_command_hook, Qpost_command_hook;
113 /* Hook run when XEmacs is about to be idle. */
114 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
116 /* Control gratuitous keyboard focus throwing. */
117 int focus_follows_mouse;
119 #ifdef ILL_CONCEIVED_HOOK
120 /* Hook run after a command if there's no more input soon. */
121 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
123 /* Delay time in microseconds before running post-command-idle-hook. */
124 int post_command_idle_delay;
125 #endif /* ILL_CONCEIVED_HOOK */
127 #ifdef DEFERRED_ACTION_CRAP
128 /* List of deferred actions to be performed at a later time.
129 The precise format isn't relevant here; we just check whether it is nil. */
130 Lisp_Object Vdeferred_action_list;
132 /* Function to call to handle deferred actions, when there are any. */
133 Lisp_Object Vdeferred_action_function;
134 Lisp_Object Qdeferred_action_function;
135 #endif /* DEFERRED_ACTION_CRAP */
137 /* Non-nil disable property on a command means
138 do not execute it; call disabled-command-hook's value instead. */
139 Lisp_Object Qdisabled, Vdisabled_command_hook;
141 EXFUN (Fnext_command_event, 2);
143 static void pre_command_hook (void);
144 static void post_command_hook (void);
146 /* Last keyboard or mouse input event read as a command. */
147 Lisp_Object Vlast_command_event;
149 /* The nearest ASCII equivalent of the above. */
150 Lisp_Object Vlast_command_char;
152 /* Last keyboard or mouse event read for any purpose. */
153 Lisp_Object Vlast_input_event;
155 /* The nearest ASCII equivalent of the above. */
156 Lisp_Object Vlast_input_char;
158 Lisp_Object Vcurrent_mouse_event;
160 /* This is fbound in cmdloop.el, see the commentary there */
161 Lisp_Object Qcancel_mode_internal;
163 /* If not Qnil, event objects to be read as the next command input */
164 Lisp_Object Vunread_command_events;
165 Lisp_Object Vunread_command_event; /* obsoleteness support */
167 static Lisp_Object Qunread_command_events, Qunread_command_event;
169 /* Previous command, represented by a Lisp object.
170 Does not include prefix commands and arg setting commands */
171 Lisp_Object Vlast_command;
173 /* If a command sets this, the value goes into
174 previous-command for the next command. */
175 Lisp_Object Vthis_command;
177 /* The value of point when the last command was executed. */
178 Bufpos last_point_position;
180 /* The frame that was current when the last command was started. */
181 Lisp_Object Vlast_selected_frame;
183 /* The buffer that was current when the last command was started. */
184 Lisp_Object last_point_position_buffer;
186 /* A (16bit . 16bit) representation of the time of the last-command-event. */
187 Lisp_Object Vlast_input_time;
189 /* A (16bit 16bit usec) representation of the time
190 of the last-command-event. */
191 Lisp_Object Vlast_command_event_time;
193 /* Character to recognize as the help char. */
194 Lisp_Object Vhelp_char;
196 /* Form to execute when help char is typed. */
197 Lisp_Object Vhelp_form;
199 /* Command to run when the help character follows a prefix key. */
200 Lisp_Object Vprefix_help_command;
202 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
203 may have happened. */
204 volatile int something_happened;
206 /* Hash table to translate keysyms through */
207 Lisp_Object Vkeyboard_translate_table;
209 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
210 Lisp_Object Vretry_undefined_key_binding_unshifted;
211 Lisp_Object Qretry_undefined_key_binding_unshifted;
214 /* If composed input is undefined, use self-insert-char */
215 Lisp_Object Vcomposed_character_default_binding;
216 #endif /* HAVE_XIM */
218 /* Console that corresponds to our controlling terminal */
219 Lisp_Object Vcontrolling_terminal;
221 /* An event (actually an event chain linked through event_next) or Qnil.
223 Lisp_Object Vthis_command_keys;
224 Lisp_Object Vthis_command_keys_tail;
227 Lisp_Object Qauto_show_make_point_visible;
229 /* File in which we write all commands we read; an lstream */
230 static Lisp_Object Vdribble_file;
232 /* Recent keys ring location; a vector of events or nil-s */
233 Lisp_Object Vrecent_keys_ring;
234 int recent_keys_ring_size;
235 int recent_keys_ring_index;
237 /* Boolean specifying whether keystrokes should be added to
239 int inhibit_input_event_recording;
241 /* prefix key(s) that must match in order to activate menu.
242 This is ugly. fix me.
244 Lisp_Object Vmenu_accelerator_prefix;
246 /* list of modifier keys to match accelerator for top level menus */
247 Lisp_Object Vmenu_accelerator_modifiers;
249 /* whether menu accelerators are enabled */
250 Lisp_Object Vmenu_accelerator_enabled;
252 /* keymap for auxillary menu accelerator functions */
253 Lisp_Object Vmenu_accelerator_map;
255 Lisp_Object Qmenu_force;
256 Lisp_Object Qmenu_fallback;
257 Lisp_Object Qmenu_quit;
258 Lisp_Object Qmenu_up;
259 Lisp_Object Qmenu_down;
260 Lisp_Object Qmenu_left;
261 Lisp_Object Qmenu_right;
262 Lisp_Object Qmenu_select;
263 Lisp_Object Qmenu_escape;
265 /* this is in keymap.c */
266 extern Lisp_Object Fmake_keymap (Lisp_Object name);
269 int debug_emacs_events;
272 external_debugging_print_event (char *event_description, Lisp_Object event)
274 write_c_string ("(", Qexternal_debugging_output);
275 write_c_string (event_description, Qexternal_debugging_output);
276 write_c_string (") ", Qexternal_debugging_output);
277 print_internal (event, Qexternal_debugging_output, 1);
278 write_c_string ("\n", Qexternal_debugging_output);
280 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
281 if (debug_emacs_events) \
282 external_debugging_print_event (event_description, event); \
285 #define DEBUG_PRINT_EMACS_EVENT(string, event)
289 /* The callback routines for the window system or terminal driver */
290 struct event_stream *event_stream;
292 /* This structure is what we use to encapsulate the state of a command sequence
293 being composed; key events are executed by adding themselves to the command
294 builder; if the command builder is then complete (does not still represent
295 a prefix key sequence) it executes the corresponding command.
297 struct command_builder
299 struct lcrecord_header header;
300 Lisp_Object console; /* back pointer to the console this command
302 /* Qnil, or a Lisp_Event representing the first event read
303 * after the last command completed. Threaded. */
305 Lisp_Object prefix_events;
306 /* Qnil, or a Lisp_Event representing event in the current
307 * keymap-lookup sequence. Subsequent events are threaded via
308 * the event's next slot */
309 Lisp_Object current_events;
310 /* Last elt of above */
311 Lisp_Object most_current_event;
312 /* Last elt before function map code took over. What this means is:
313 All prefixes up to (but not including) this event have non-nil
314 bindings, but the prefix including this event has a nil binding.
315 Any events in the chain after this one were read solely because
316 we're part of a possible function key. If we end up with
317 something that's not part of a possible function key, we have to
318 unread all of those events. */
319 Lisp_Object last_non_munged_event;
320 /* One set of values for function-key-map, one for key-translation-map */
321 struct munging_key_translation
323 /* First event that can begin a possible function key sequence
324 (to be translated according to function-key-map). Normally
325 this is the first event in the chain. However, once we've
326 translated a sequence through function-key-map, this will point
327 to the first event after the translated sequence: we don't ever
328 want to translate any events twice through function-key-map, or
329 things could get really screwed up (e.g. if the user created a
330 translation loop). If this is nil, then the next-read event is
331 the first that can begin a function key sequence. */
332 Lisp_Object first_mungeable_event;
336 Bytecount echo_buf_length; /* size of echo_buf */
337 Bytecount echo_buf_index; /* index into echo_buf
338 * -1 before doing echoing for new cmd */
339 /* Self-insert-command is magic in that it doesn't always push an undo-
340 boundary: up to 20 consecutive self-inserts can happen before an undo-
341 boundary is pushed. This variable is that counter.
343 int self_insert_countdown;
346 static void echo_key_event (struct command_builder *, Lisp_Object event);
347 static void maybe_kbd_translate (Lisp_Object event);
349 /* This structure is basically a typeahead queue: things like
350 wait-reading-process-output will delay the execution of
351 keyboard and mouse events by pushing them here.
353 Chained through event_next()
354 command_event_queue_tail is a pointer to the last-added element.
356 static Lisp_Object command_event_queue;
357 static Lisp_Object command_event_queue_tail;
359 /* Nonzero means echo unfinished commands after this many seconds of pause. */
360 static Lisp_Object Vecho_keystrokes;
362 /* The number of keystrokes since the last auto-save. */
363 static int keystrokes_since_auto_save;
365 /* Used by the C-g signal handler so that it will never "hard quit"
366 when waiting for an event. Otherwise holding down C-g could
367 cause a suspension back to the shell, which is generally
368 undesirable. (#### This doesn't fully work.) */
370 int emacs_is_blocking;
372 /* Handlers which run during sit-for, sleep-for and accept-process-output
373 are not allowed to recursively call these routines. We record here
374 if we are in that situation. */
376 static Lisp_Object recursive_sit_for;
380 /**********************************************************************/
381 /* Command-builder object */
382 /**********************************************************************/
384 #define XCOMMAND_BUILDER(x) \
385 XRECORD (x, command_builder, struct command_builder)
386 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
387 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
388 #define GC_COMMAND_BUILDERP(x) GC_RECORDP (x, command_builder)
389 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
392 mark_command_builder (Lisp_Object obj, void (*markobj) (Lisp_Object))
394 struct command_builder *builder = XCOMMAND_BUILDER (obj);
395 (markobj) (builder->prefix_events);
396 (markobj) (builder->current_events);
397 (markobj) (builder->most_current_event);
398 (markobj) (builder->last_non_munged_event);
399 (markobj) (builder->munge_me[0].first_mungeable_event);
400 (markobj) (builder->munge_me[1].first_mungeable_event);
401 return builder->console;
405 finalize_command_builder (void *header, int for_disksave)
409 xfree (((struct command_builder *) header)->echo_buf);
410 ((struct command_builder *) header)->echo_buf = 0;
414 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
415 mark_command_builder, internal_object_printer,
416 finalize_command_builder, 0, 0,
417 struct command_builder);
420 reset_command_builder_event_chain (struct command_builder *builder)
422 builder->prefix_events = Qnil;
423 builder->current_events = Qnil;
424 builder->most_current_event = Qnil;
425 builder->last_non_munged_event = Qnil;
426 builder->munge_me[0].first_mungeable_event = Qnil;
427 builder->munge_me[1].first_mungeable_event = Qnil;
431 allocate_command_builder (Lisp_Object console)
433 Lisp_Object builder_obj;
434 struct command_builder *builder =
435 alloc_lcrecord_type (struct command_builder, lrecord_command_builder);
437 builder->console = console;
438 reset_command_builder_event_chain (builder);
439 builder->echo_buf_length = 300; /* #### Kludge */
440 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
441 builder->echo_buf[0] = 0;
442 builder->echo_buf_index = -1;
443 builder->echo_buf_index = -1;
444 builder->self_insert_countdown = 0;
446 XSETCOMMAND_BUILDER (builder_obj, builder);
451 command_builder_append_event (struct command_builder *builder,
454 assert (EVENTP (event));
456 if (EVENTP (builder->most_current_event))
457 XSET_EVENT_NEXT (builder->most_current_event, event);
459 builder->current_events = event;
461 builder->most_current_event = event;
462 if (NILP (builder->munge_me[0].first_mungeable_event))
463 builder->munge_me[0].first_mungeable_event = event;
464 if (NILP (builder->munge_me[1].first_mungeable_event))
465 builder->munge_me[1].first_mungeable_event = event;
469 /**********************************************************************/
470 /* Low-level interfaces onto event methods */
471 /**********************************************************************/
473 enum event_stream_operation
475 EVENT_STREAM_PROCESS,
476 EVENT_STREAM_TIMEOUT,
477 EVENT_STREAM_CONSOLE,
482 check_event_stream_ok (enum event_stream_operation op)
484 if (!event_stream && noninteractive)
488 case EVENT_STREAM_PROCESS:
489 error ("Can't start subprocesses in -batch mode");
490 case EVENT_STREAM_TIMEOUT:
491 error ("Can't add timeouts in -batch mode");
492 case EVENT_STREAM_CONSOLE:
493 error ("Can't add consoles in -batch mode");
494 case EVENT_STREAM_READ:
495 error ("Can't read events in -batch mode");
500 else if (!event_stream)
502 error ("event-stream callbacks not initialized (internal error?)");
507 event_stream_event_pending_p (int user)
509 return event_stream && event_stream->event_pending_p (user);
513 maybe_read_quit_event (struct Lisp_Event *event)
515 /* A C-g that came from `sigint_happened' will always come from the
516 controlling terminal. If that doesn't exist, however, then the
517 user manually sent us a SIGINT, and we pretend the C-g came from
518 the selected console. */
521 if (CONSOLEP (Vcontrolling_terminal) &&
522 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
523 con = XCONSOLE (Vcontrolling_terminal);
525 con = XCONSOLE (Fselected_console ());
529 int ch = CONSOLE_QUIT_CHAR (con);
532 character_to_event (ch, event, con, 1, 1);
533 event->channel = make_console (con);
540 event_stream_next_event (struct Lisp_Event *event)
542 Lisp_Object event_obj;
544 check_event_stream_ok (EVENT_STREAM_READ);
546 XSETEVENT (event_obj, event);
548 /* If C-g was pressed, treat it as a character to be read.
549 Note that if C-g was pressed while we were blocking,
550 the SIGINT signal handler will be called. It will
551 set Vquit_flag and write a byte on our "fake pipe",
552 which will unblock us. */
553 if (maybe_read_quit_event (event))
555 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
559 /* If a longjmp() happens in the callback, we're screwed.
560 Let's hope it doesn't. I think the code here is fairly
561 clean and doesn't do this. */
562 emacs_is_blocking = 1;
564 /* Do this if the poll-for-quit timer seems to be taking too
565 much CPU time when idle ... */
566 reset_poll_for_quit ();
568 event_stream->next_event_cb (event);
570 init_poll_for_quit ();
572 emacs_is_blocking = 0;
575 /* timeout events have more info set later, so
576 print the event out in next_event_internal(). */
577 if (event->event_type != timeout_event)
578 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
580 maybe_kbd_translate (event_obj);
584 event_stream_handle_magic_event (struct Lisp_Event *event)
586 check_event_stream_ok (EVENT_STREAM_READ);
587 event_stream->handle_magic_event_cb (event);
591 event_stream_add_timeout (EMACS_TIME timeout)
593 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
594 return event_stream->add_timeout_cb (timeout);
598 event_stream_remove_timeout (int id)
600 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
601 event_stream->remove_timeout_cb (id);
605 event_stream_select_console (struct console *con)
607 check_event_stream_ok (EVENT_STREAM_CONSOLE);
608 if (!con->input_enabled)
610 event_stream->select_console_cb (con);
611 con->input_enabled = 1;
616 event_stream_unselect_console (struct console *con)
618 check_event_stream_ok (EVENT_STREAM_CONSOLE);
619 if (con->input_enabled)
621 event_stream->unselect_console_cb (con);
622 con->input_enabled = 0;
627 event_stream_select_process (struct Lisp_Process *proc)
629 check_event_stream_ok (EVENT_STREAM_PROCESS);
630 if (!get_process_selected_p (proc))
632 event_stream->select_process_cb (proc);
633 set_process_selected_p (proc, 1);
638 event_stream_unselect_process (struct Lisp_Process *proc)
640 check_event_stream_ok (EVENT_STREAM_PROCESS);
641 if (get_process_selected_p (proc))
643 event_stream->unselect_process_cb (proc);
644 set_process_selected_p (proc, 0);
649 event_stream_create_stream_pair (void* inhandle, void* outhandle,
650 Lisp_Object* instream, Lisp_Object* outstream, int flags)
652 check_event_stream_ok (EVENT_STREAM_PROCESS);
653 return event_stream->create_stream_pair_cb
654 (inhandle, outhandle, instream, outstream, flags);
658 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
660 check_event_stream_ok (EVENT_STREAM_PROCESS);
661 return event_stream->delete_stream_pair_cb (instream, outstream);
665 event_stream_quit_p (void)
668 event_stream->quit_p_cb ();
673 /**********************************************************************/
674 /* Character prompting */
675 /**********************************************************************/
678 echo_key_event (struct command_builder *command_builder,
681 /* This function can GC */
683 Bytecount buf_index = command_builder->echo_buf_index;
689 buf_index = 0; /* We're echoing now */
690 clear_echo_area (selected_frame (), Qnil, 0);
693 format_event_object (buf, XEVENT (event), 1);
696 if (len + buf_index + 4 > command_builder->echo_buf_length)
698 e = command_builder->echo_buf + buf_index;
699 memcpy (e, buf, len);
707 command_builder->echo_buf_index = buf_index + len + 1;
711 regenerate_echo_keys_from_this_command_keys (struct command_builder *
716 builder->echo_buf_index = 0;
718 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
719 echo_key_event (builder, event);
723 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
725 /* This function can GC */
726 double echo_keystrokes;
727 struct frame *f = selected_frame ();
728 /* Message turns off echoing unless more keystrokes turn it on again. */
729 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
732 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
733 echo_keystrokes = extract_float (Vecho_keystrokes);
737 if (minibuf_level == 0
738 && echo_keystrokes > 0.0
743 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
744 doesn't work. See check_quit. */
745 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
746 /* input came in, so don't echo. */
750 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
751 /* not echo_buf_index. That doesn't include
752 the terminating " - ". */
753 strlen ((char *) command_builder->echo_buf),
759 reset_key_echo (struct command_builder *command_builder,
760 int remove_echo_area_echo)
762 /* This function can GC */
763 struct frame *f = selected_frame ();
765 command_builder->echo_buf_index = -1;
767 if (remove_echo_area_echo)
768 clear_echo_area (f, Qcommand, 0);
772 /**********************************************************************/
774 /**********************************************************************/
777 maybe_kbd_translate (Lisp_Object event)
780 int did_translate = 0;
782 if (XEVENT_TYPE (event) != key_press_event)
784 if (!HASHTABLEP (Vkeyboard_translate_table))
786 if (EQ (Fhashtable_fullness (Vkeyboard_translate_table), Qzero))
789 c = event_to_character (XEVENT (event), 0, 0, 0);
792 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
794 if (!NILP (traduit) && SYMBOLP (traduit))
796 XEVENT (event)->event.key.keysym = traduit;
797 XEVENT (event)->event.key.modifiers = 0;
800 else if (CHARP (traduit))
802 struct Lisp_Event ev2;
804 /* This used to call Fcharacter_to_event() directly into EVENT,
805 but that can eradicate timestamps and other such stuff.
806 This way is safer. */
808 character_to_event (XCHAR (traduit), &ev2,
809 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
810 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
811 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
818 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
819 Vkeyboard_translate_table, Qnil);
820 if (!NILP (traduit) && SYMBOLP (traduit))
822 XEVENT (event)->event.key.keysym = traduit;
829 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
833 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
834 keystrokes_since_auto_save is equivalent to the difference between
835 num_nonmacro_input_chars and last_auto_save. */
837 /* When an auto-save happens, record the "time", and don't do again soon. */
840 record_auto_save (void)
842 keystrokes_since_auto_save = 0;
845 /* Make an auto save happen as soon as possible at command level. */
848 force_auto_save_soon (void)
850 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
853 record_asynch_buffer_change ();
858 maybe_do_auto_save (void)
860 /* This function can call lisp */
861 keystrokes_since_auto_save++;
862 if (auto_save_interval > 0 &&
863 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
864 !detect_input_pending ())
866 Fdo_auto_save (Qnil, Qnil);
872 print_help (Lisp_Object object)
874 Fprinc (object, Qnil);
879 execute_help_form (struct command_builder *command_builder,
882 /* This function can GC */
883 Lisp_Object help = Qnil;
884 int speccount = specpdl_depth ();
885 Bytecount buf_index = command_builder->echo_buf_index;
886 Lisp_Object echo = ((buf_index <= 0)
888 : make_string (command_builder->echo_buf,
890 struct gcpro gcpro1, gcpro2;
893 record_unwind_protect (save_window_excursion_unwind,
894 Fcurrent_window_configuration (Qnil));
895 reset_key_echo (command_builder, 1);
897 help = Feval (Vhelp_form);
899 internal_with_output_to_temp_buffer ("*Help*",
900 print_help, help, Qnil);
901 Fnext_command_event (event, Qnil);
902 /* Remove the help from the frame */
903 unbind_to (speccount, Qnil);
904 /* Hmmmm. Tricky. The unbind restores an old window configuration,
905 apparently bypassing any setting of windows_structure_changed.
906 So we need to set it so that things get redrawn properly. */
907 /* #### This is massive overkill. Look at doing it better once the
908 new redisplay is fully in place. */
910 Lisp_Object frmcons, devcons, concons;
911 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
913 struct frame *f = XFRAME (XCAR (frmcons));
914 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
919 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
921 /* Discard next key if it is a space */
922 reset_key_echo (command_builder, 1);
923 Fnext_command_event (event, Qnil);
926 command_builder->echo_buf_index = buf_index;
928 memcpy (command_builder->echo_buf,
929 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
934 /**********************************************************************/
936 /**********************************************************************/
939 detect_input_pending (void)
941 /* Always call the event_pending_p hook even if there's an unread
942 character, because that might do some needed ^G detection (on
943 systems without SIGIO, for example).
945 if (event_stream_event_pending_p (1))
947 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
949 if (!NILP (command_event_queue))
953 EVENT_CHAIN_LOOP (event, command_event_queue)
955 if (XEVENT_TYPE (event) != eval_event
956 && XEVENT_TYPE (event) != magic_eval_event)
963 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
964 Return t if command input is currently available with no waiting.
965 Actually, the value is nil only if we can be sure that no input is available.
969 return detect_input_pending () ? Qt : Qnil;
973 /**********************************************************************/
975 /**********************************************************************/
977 /**** Low-level timeout functions. ****
979 These functions maintain a sorted list of one-shot timeouts (where
980 the timeouts are in absolute time). They are intended for use by
981 functions that need to convert a list of absolute timeouts into a
982 series of intervals to wait for. */
984 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
985 used to indicate an absence of a timer. */
986 static int low_level_timeout_id_tick;
988 struct low_level_timeout_blocktype
990 Blocktype_declare (struct low_level_timeout);
991 } *the_low_level_timeout_blocktype;
993 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
994 a unique ID identifying the timeout. */
997 add_low_level_timeout (struct low_level_timeout **timeout_list,
1000 struct low_level_timeout *tm;
1001 struct low_level_timeout *t, **tt;
1003 /* Allocate a new time struct. */
1005 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
1007 if (low_level_timeout_id_tick == 0)
1008 low_level_timeout_id_tick++;
1009 tm->id = low_level_timeout_id_tick++;
1012 /* Add it to the queue. */
1016 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
1027 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
1028 If the timeout is not there, do nothing. */
1031 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
1033 struct low_level_timeout *t, *prev;
1037 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
1041 return; /* couldn't find it */
1044 *timeout_list = t->next;
1045 else prev->next = t->next;
1047 Blocktype_free (the_low_level_timeout_blocktype, t);
1050 /* If there are timeouts on TIMEOUT_LIST, store the relative time
1051 interval to the first timeout on the list into INTERVAL and
1052 return 1. Otherwise, return 0. */
1055 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
1056 EMACS_TIME *interval)
1058 if (!timeout_list) /* no timer events; block indefinitely */
1062 EMACS_TIME current_time;
1064 /* The time to block is the difference between the first
1065 (earliest) timer on the queue and the current time.
1066 If that is negative, then the timer will fire immediately
1067 but we still have to call select(), with a zero-valued
1068 timeout: user events must have precedence over timer events. */
1069 EMACS_GET_TIME (current_time);
1070 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1071 EMACS_SUB_TIME (*interval, timeout_list->time,
1074 EMACS_SET_SECS_USECS (*interval, 0, 0);
1079 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1080 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1081 timeout into TIME_OUT. */
1084 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1085 EMACS_TIME *time_out)
1087 struct low_level_timeout *tm = *timeout_list;
1093 *time_out = tm->time;
1094 *timeout_list = tm->next;
1095 Blocktype_free (the_low_level_timeout_blocktype, tm);
1100 /**** High-level timeout functions. ****/
1102 static int timeout_id_tick;
1104 /* Since timeout structures contain Lisp_Objects, they need to be GC'd
1105 properly. The opaque data type provides a convenient way of doing
1106 this without having to create a new Lisp object, since we can
1107 provide our own mark function. */
1111 int id; /* Id we use to identify the timeout over its lifetime */
1112 int interval_id; /* Id for this particular interval; this may
1113 be different each time the timeout is
1115 Lisp_Object function, object; /* Function and object associated
1117 EMACS_TIME next_signal_time; /* Absolute time when the timeout
1118 is next going to be signalled. */
1119 unsigned int resignal_msecs; /* How far after the next timeout
1120 should the one after that
1124 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1126 static Lisp_Object Vtimeout_free_list;
1129 mark_timeout (Lisp_Object obj, void (*markobj) (Lisp_Object))
1131 struct timeout *tm = (struct timeout *) XOPAQUE_DATA (obj);
1132 (markobj) (tm->function);
1136 /* Generate a timeout and return its ID. */
1139 event_stream_generate_wakeup (unsigned int milliseconds,
1140 unsigned int vanilliseconds,
1141 Lisp_Object function, Lisp_Object object,
1144 Lisp_Object op = allocate_managed_opaque (Vtimeout_free_list, 0);
1145 struct timeout *timeout = (struct timeout *) XOPAQUE_DATA (op);
1146 EMACS_TIME current_time;
1147 EMACS_TIME interval;
1149 timeout->id = timeout_id_tick++;
1150 timeout->resignal_msecs = vanilliseconds;
1151 timeout->function = function;
1152 timeout->object = object;
1154 EMACS_GET_TIME (current_time);
1155 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1156 1000 * (milliseconds % 1000));
1157 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1161 timeout->interval_id =
1162 event_stream_add_async_timeout (timeout->next_signal_time);
1163 pending_async_timeout_list = noseeum_cons (op,
1164 pending_async_timeout_list);
1168 timeout->interval_id =
1169 event_stream_add_timeout (timeout->next_signal_time);
1170 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
1175 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1176 as necessary and return the timeout's ID and function and object slots.
1178 This should be called as a result of receiving notice that a timeout
1179 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1180 identifies this particular firing of the timeout. INTERVAL-ID's and
1181 timeout ID's are in separate number spaces and bear no relation to
1182 each other. The INTERVAL-ID is all that the event callback routines
1183 work with: they work only with one-shot intervals, not with timeouts
1184 that may fire repeatedly.
1186 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1190 event_stream_resignal_wakeup (int interval_id, int async_p,
1191 Lisp_Object *function, Lisp_Object *object)
1193 Lisp_Object op = Qnil, rest;
1194 struct timeout *timeout;
1195 Lisp_Object *timeout_list;
1196 struct gcpro gcpro1;
1199 GCPRO1 (op); /* just in case ... because it's removed from the list
1202 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1204 /* Find the timeout on the list of pending ones. */
1205 LIST_LOOP (rest, *timeout_list)
1207 timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
1208 if (timeout->interval_id == interval_id)
1212 assert (!NILP (rest));
1214 timeout = (struct timeout *) XOPAQUE_DATA (op);
1215 /* We make sure to snarf the data out of the timeout object before
1216 we free it with free_managed_opaque(). */
1218 *function = timeout->function;
1219 *object = timeout->object;
1221 /* Remove this one from the list of pending timeouts */
1222 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1224 /* If this timeout wants to be resignalled, do it now. */
1225 if (timeout->resignal_msecs)
1227 EMACS_TIME current_time;
1228 EMACS_TIME interval;
1230 /* Determine the time that the next resignalling should occur.
1231 We do that by adding the interval time to the last signalled
1232 time until we get a time that's current.
1234 (This way, it doesn't matter if the timeout was signalled
1235 exactly when we asked for it, or at some time later.)
1237 EMACS_GET_TIME (current_time);
1238 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
1239 1000 * (timeout->resignal_msecs % 1000));
1242 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1244 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1247 timeout->interval_id =
1248 event_stream_add_async_timeout (timeout->next_signal_time);
1250 timeout->interval_id =
1251 event_stream_add_timeout (timeout->next_signal_time);
1252 /* Add back onto the list. Note that the effect of this
1253 is to move frequently-hit timeouts to the front of the
1254 list, which is a good thing. */
1255 *timeout_list = noseeum_cons (op, *timeout_list);
1258 free_managed_opaque (Vtimeout_free_list, op);
1265 event_stream_disable_wakeup (int id, int async_p)
1267 struct timeout *timeout = 0;
1269 Lisp_Object *timeout_list;
1272 timeout_list = &pending_async_timeout_list;
1274 timeout_list = &pending_timeout_list;
1276 /* Find the timeout on the list of pending ones, if it's still there. */
1277 LIST_LOOP (rest, *timeout_list)
1279 timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
1280 if (timeout->id == id)
1284 /* If we found it, remove it from the list and disable the pending
1288 Lisp_Object op = XCAR (rest);
1290 delq_no_quit_and_free_cons (op, *timeout_list);
1292 event_stream_remove_async_timeout (timeout->interval_id);
1294 event_stream_remove_timeout (timeout->interval_id);
1295 free_managed_opaque (Vtimeout_free_list, op);
1300 event_stream_wakeup_pending_p (int id, int async_p)
1302 struct timeout *timeout;
1304 Lisp_Object timeout_list;
1309 timeout_list = pending_async_timeout_list;
1311 timeout_list = pending_timeout_list;
1313 /* Find the element on the list of pending ones, if it's still there. */
1314 LIST_LOOP (rest, timeout_list)
1316 timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
1317 if (timeout->id == id)
1328 /**** Asynch. timeout functions (see also signal.c) ****/
1330 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1331 extern int poll_for_quit_id;
1334 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1335 extern int poll_for_sigchld_id;
1339 event_stream_deal_with_async_timeout (int interval_id)
1341 /* This function can GC */
1342 Lisp_Object humpty, dumpty;
1343 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1344 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1347 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1349 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1350 if (id == poll_for_quit_id)
1352 quit_check_signal_happened = 1;
1353 quit_check_signal_tick_count++;
1358 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1359 if (id == poll_for_sigchld_id)
1361 kick_status_notify ();
1366 /* call1 GC-protects its arguments */
1367 call1_trapping_errors ("Error in asynchronous timeout callback",
1372 /**** Lisp-level timeout functions. ****/
1374 static unsigned long
1375 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1377 #ifdef LISP_FLOAT_TYPE
1379 CHECK_INT_OR_FLOAT (secs);
1380 fsecs = XFLOATINT (secs);
1384 fsecs = XINT (secs);
1387 signal_simple_error ("timeout is negative", secs);
1388 if (!allow_0 && fsecs == 0)
1389 signal_simple_error ("timeout is non-positive", secs);
1390 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1392 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1394 return (unsigned long) (1000 * fsecs);
1397 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1398 Add a timeout, to be signaled after the timeout period has elapsed.
1399 SECS is a number of seconds, expressed as an integer or a float.
1400 FUNCTION will be called after that many seconds have elapsed, with one
1401 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1402 then after this timeout expires, `add-timeout' will automatically be called
1403 again with RESIGNAL as the first argument.
1405 This function returns an object which is the id number of this particular
1406 timeout. You can pass that object to `disable-timeout' to turn off the
1407 timeout before it has been signalled.
1409 NOTE: Id numbers as returned by this function are in a distinct namespace
1410 from those returned by `add-async-timeout'. This means that the same id
1411 number could refer to a pending synchronous timeout and a different pending
1412 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1413 to `disable-async-timeout', or vice-versa.
1415 The number of seconds may be expressed as a floating-point number, in which
1416 case some fractional part of a second will be used. Caveat: the usable
1417 timeout granularity will vary from system to system.
1419 Adding a timeout causes a timeout event to be returned by `next-event', and
1420 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1421 loop, the function will not be invoked until the next call to sit-for or
1422 until the return to top-level (the same is true of process filters).
1424 If you need to have a timeout executed even when XEmacs is in the midst of
1425 running Lisp code, use `add-async-timeout'.
1427 WARNING: if you are thinking of calling add-timeout from inside of a
1428 callback function as a way of resignalling a timeout, think again. There
1429 is a race condition. That's why the RESIGNAL argument exists.
1431 (secs, function, object, resignal))
1433 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1434 unsigned long msecs2 = (NILP (resignal) ? 0 :
1435 lisp_number_to_milliseconds (resignal, 0));
1438 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1439 lid = make_int (id);
1440 if (id != XINT (lid)) abort ();
1444 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1445 Disable a timeout from signalling any more.
1446 ID should be a timeout id number as returned by `add-timeout'. If ID
1447 corresponds to a one-shot timeout that has already signalled, nothing
1450 It will not work to call this function on an id number returned by
1451 `add-async-timeout'. Use `disable-async-timeout' for that.
1456 event_stream_disable_wakeup (XINT (id), 0);
1460 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1461 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1462 SECS is a number of seconds, expressed as an integer or a float.
1463 FUNCTION will be called after that many seconds have elapsed, with one
1464 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1465 then after this timeout expires, `add-async-timeout' will automatically be
1466 called again with RESIGNAL as the first argument.
1468 This function returns an object which is the id number of this particular
1469 timeout. You can pass that object to `disable-async-timeout' to turn off
1470 the timeout before it has been signalled.
1472 NOTE: Id numbers as returned by this function are in a distinct namespace
1473 from those returned by `add-timeout'. This means that the same id number
1474 could refer to a pending synchronous timeout and a different pending
1475 asynchronous timeout, and that you cannot pass an id from
1476 `add-async-timeout' to `disable-timeout', or vice-versa.
1478 The number of seconds may be expressed as a floating-point number, in which
1479 case some fractional part of a second will be used. Caveat: the usable
1480 timeout granularity will vary from system to system.
1482 Adding an asynchronous timeout causes the function to be invoked as soon
1483 as the timeout occurs, even if XEmacs is in the midst of executing some
1484 other code. (This is unlike the synchronous timeouts added with
1485 `add-timeout', where the timeout will only be signalled when XEmacs is
1486 waiting for events, i.e. the next return to top-level or invocation of
1487 `sit-for' or related functions.) This means that the function that is
1488 called *must* not signal an error or change any global state (e.g. switch
1489 buffers or windows) except when locking code is in place to make sure
1490 that race conditions don't occur in the interaction between the
1491 asynchronous timeout function and other code.
1493 Under most circumstances, you should use `add-timeout' instead, as it is
1494 much safer. Asynchronous timeouts should only be used when such behavior
1495 is really necessary.
1497 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1498 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1499 asynchronous timeouts will get called immediately. (Multiple occurrences
1500 of the same asynchronous timeout are not queued, however.) While the
1501 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1502 is automatically bound to non-nil, and thus other asynchronous timeouts
1503 will be blocked unless the callback function explicitly sets `inhibit-quit'
1506 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1507 callback function as a way of resignalling a timeout, think again. There
1508 is a race condition. That's why the RESIGNAL argument exists.
1510 (secs, function, object, resignal))
1512 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1513 unsigned long msecs2 = (NILP (resignal) ? 0 :
1514 lisp_number_to_milliseconds (resignal, 0));
1517 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1518 lid = make_int (id);
1519 if (id != XINT (lid)) abort ();
1523 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1524 Disable an asynchronous timeout from signalling any more.
1525 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1526 corresponds to a one-shot timeout that has already signalled, nothing
1529 It will not work to call this function on an id number returned by
1530 `add-timeout'. Use `disable-timeout' for that.
1535 event_stream_disable_wakeup (XINT (id), 1);
1540 /**********************************************************************/
1541 /* enqueuing and dequeuing events */
1542 /**********************************************************************/
1544 /* Add an event to the back of the command-event queue: it will be the next
1545 event read after all pending events. This only works on keyboard,
1546 mouse-click, misc-user, and eval events.
1549 enqueue_command_event (Lisp_Object event)
1551 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1555 dequeue_command_event (void)
1557 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1560 /* put the event on the typeahead queue, unless
1561 the event is the quit char, in which case the `QUIT'
1562 which will occur on the next trip through this loop is
1563 all the processing we should do - leaving it on the queue
1564 would cause the quit to be processed twice.
1567 enqueue_command_event_1 (Lisp_Object event_to_copy)
1569 /* do not call check_quit() here. Vquit_flag was set in
1570 next_event_internal. */
1571 if (NILP (Vquit_flag))
1572 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1576 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1578 Lisp_Object event = Fmake_event (Qnil, Qnil);
1580 XEVENT (event)->event_type = magic_eval_event;
1581 /* channel for magic_eval events is nil */
1582 XEVENT (event)->event.magic_eval.internal_function = fun;
1583 XEVENT (event)->event.magic_eval.object = object;
1584 enqueue_command_event (event);
1587 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1588 Add an eval event to the back of the eval event queue.
1589 When this event is dispatched, FUNCTION (which should be a function
1590 of one argument) will be called with OBJECT as its argument.
1591 See `next-event' for a description of event types and how events
1596 Lisp_Object event = Fmake_event (Qnil, Qnil);
1598 XEVENT (event)->event_type = eval_event;
1599 /* channel for eval events is nil */
1600 XEVENT (event)->event.eval.function = function;
1601 XEVENT (event)->event.eval.object = object;
1602 enqueue_command_event (event);
1608 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1611 Lisp_Object event = Fmake_event (Qnil, Qnil);
1613 XEVENT (event)->event_type = misc_user_event;
1614 XEVENT (event)->channel = channel;
1615 XEVENT (event)->event.misc.function = function;
1616 XEVENT (event)->event.misc.object = object;
1617 XEVENT (event)->event.misc.button = 0;
1618 XEVENT (event)->event.misc.modifiers = 0;
1619 XEVENT (event)->event.misc.x = -1;
1620 XEVENT (event)->event.misc.y = -1;
1621 enqueue_command_event (event);
1627 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1629 int button, int modifiers, int x, int y)
1631 Lisp_Object event = Fmake_event (Qnil, Qnil);
1633 XEVENT (event)->event_type = misc_user_event;
1634 XEVENT (event)->channel = channel;
1635 XEVENT (event)->event.misc.function = function;
1636 XEVENT (event)->event.misc.object = object;
1637 XEVENT (event)->event.misc.button = button;
1638 XEVENT (event)->event.misc.modifiers = modifiers;
1639 XEVENT (event)->event.misc.x = x;
1640 XEVENT (event)->event.misc.y = y;
1641 enqueue_command_event (event);
1647 /**********************************************************************/
1648 /* focus-event handling */
1649 /**********************************************************************/
1653 Ben's capsule lecture on focus:
1655 In FSFmacs `select-frame' never changes the window-manager frame
1656 focus. All it does is change the "selected frame". This is similar
1657 to what happens when we call `select-device' or `select-console'.
1658 Whenever an event comes in (including a keyboard event), its frame is
1659 selected; therefore, evaluating `select-frame' in *scratch* won't
1660 cause any effects because the next received event (in the same frame)
1661 will cause a switch back to the frame displaying *scratch*.
1663 Whenever a focus-change event is received from the window manager, it
1664 generates a `switch-frame' event, which causes the Lisp function
1665 `handle-switch-frame' to get run. This basically just runs
1666 `select-frame' (see below, however).
1668 In FSFmacs, if you want to have an operation run when a frame is
1669 selected, you supply an event binding for `switch-frame' (and then
1670 maybe call `handle-switch-frame', or something ...).
1672 In XEmacs, we *do* change the window-manager frame focus as a result
1673 of `select-frame', but not until the next time an event is received,
1674 so that a function that momentarily changes the selected frame won't
1675 cause WM focus flashing. (#### There's something not quite right here;
1676 this is causing the wrong-cursor-focus problems that you occasionally
1677 see. But the general idea is correct.) This approach is winning for
1678 people who use the explicit-focus model, but is trickier to implement.
1680 We also don't make the `switch-frame' event visible but instead have
1681 `select-frame-hook', which is a better approach.
1683 There is the problem of surrogate minibuffers, where when we enter the
1684 minibuffer, you essentially want to temporarily switch the WM focus to
1685 the frame with the minibuffer, and switch it back when you exit the
1688 FSFmacs solves this with the crockish `redirect-frame-focus', which
1689 says "for keyboard events received from FRAME, act like they're
1690 coming from FOCUS-FRAME". I think what this means is that, when
1691 a keyboard event comes in and the event manager is about to select the
1692 event's frame, if that frame has its focus redirected, the redirected-to
1693 frame is selected instead. That way, if you're in a minibufferless
1694 frame and enter the minibuffer, then all Lisp functions that run see
1695 the selected frame as the minibuffer's frame rather than the minibufferless
1696 frame you came from, so that (e.g.) your typing actually appears in
1697 the minibuffer's frame and things behave sanely.
1699 There's also some weird logic that switches the redirected frame focus
1700 from one frame to another if Lisp code explicitly calls `select-frame'
1701 \(but not if `handle-switch-frame' is called), and saves and restores
1702 the frame focus in window configurations, etc. etc. All of this logic
1703 is heavily #if 0'd, with lots of comments saying "No, this approach
1704 doesn't seem to work, so I'm trying this ... is it reasonable?
1705 Well, I'm not sure ..." that are a red flag indicating crockishness.
1707 Because of our way of doing things, we can avoid all this crock.
1708 Keyboard events never cause a select-frame (who cares what frame
1709 they're associated with? They come from a console, only). We change
1710 the actual WM focus to a surrogate minibuffer frame, so we don't have
1711 to do any internal redirection. In order to get the focus back,
1712 I took the approach in minibuf.el of just checking to see if the
1713 frame we moved to is still the selected frame, and move back to the
1714 old one if so. Conceivably we might have to do the weird "tracking"
1715 that FSFmacs does when `select-frame' is called, but I don't think
1716 so. If the selected frame moved from the minibuffer frame, then
1717 we just leave it there, figuring that someone knows what they're
1718 doing. Because we don't have any redirection recorded anywhere,
1719 it's safe to do this, and we don't end up with unwanted redirection.
1724 run_select_frame_hook (void)
1726 run_hook (Qselect_frame_hook);
1730 run_deselect_frame_hook (void)
1732 #if 0 /* unclean! FSF calls this at all sorts of random places,
1733 including a bunch of places in their mouse.el. If this
1734 is implemented, it has to be done cleanly. */
1735 run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also
1736 called in `call-interactively'.
1737 Does this mean it will be
1738 called twice? Oh well, FSF
1739 bug -- FSF calls it in
1740 `handle-switch-frame',
1741 which is approximately the
1742 same as the caller of this
1745 run_hook (Qdeselect_frame_hook);
1748 /* When select-frame is called and focus_follows_mouse is false, we want
1749 to tell the window system that the focus should be changed to point to
1750 the new frame. However,
1751 sometimes Lisp functions will temporarily change the selected frame
1752 (e.g. to call a function that operates on the selected frame),
1753 and it's annoying if this focus-change happens exactly when
1754 select-frame is called, because then you get some flickering of the
1755 window-manager border and perhaps other undesirable results. We
1756 really only want to change the focus when we're about to retrieve
1757 an event from the user. To do this, we keep track of the frame
1758 where the window-manager focus lies on, and just before waiting
1759 for user events, check the currently selected frame and change
1760 the focus as necessary.
1762 On the other hand, if focus_follows_mouse is true, we need to switch the
1763 selected frame back to the frame with window manager focus just before we
1764 execute the next command in Fcommand_loop_1, just as the selected buffer is
1765 reverted after a set-buffer.
1767 Both cases are handled by this function. It must be called as appropriate
1768 from these two places, depending on the value of focus_follows_mouse. */
1771 investigate_frame_change (void)
1773 Lisp_Object devcons, concons;
1775 /* if the selected frame was changed, change the window-system
1776 focus to the new frame. We don't do it when select-frame was
1777 called, to avoid flickering and other unwanted side effects when
1778 the frame is just changed temporarily. */
1779 DEVICE_LOOP_NO_BREAK (devcons, concons)
1781 struct device *d = XDEVICE (XCAR (devcons));
1782 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1784 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1785 but that can cause us to end up in an infinite loop focusing
1786 between two frames. It seems that since the call to `select-frame'
1787 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1788 value, we need to do so too. */
1789 if (!NILP (sel_frame) &&
1790 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1791 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1792 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1794 /* At this point, we know that the frame has been changed. Now, if
1795 * focus_follows_mouse is not set, we finish off the frame change,
1796 * so that user events will now come from the new frame. Otherwise,
1797 * if focus_follows_mouse is set, no gratuitous frame changing
1798 * should take place. Set the focus back to the frame which was
1799 * originally selected for user input.
1801 if (!focus_follows_mouse)
1803 /* prevent us from issuing the same request more than once */
1804 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1805 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1809 Lisp_Object old_frame = Qnil;
1811 /* #### Do we really want to check OUGHT ??
1812 * It seems to make sense, though I have never seen us
1813 * get here and have it be non-nil.
1815 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1816 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1817 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1818 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1820 /* #### Can old_frame ever be NIL? play it safe.. */
1821 if (!NILP (old_frame))
1823 /* Fselect_frame is not really the right thing: it frobs the
1824 * buffer stack. But there's no easy way to do the right
1825 * thing, and this code already had this problem anyway.
1827 Fselect_frame (old_frame);
1835 cleanup_after_missed_defocusing (Lisp_Object frame)
1837 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1838 Fselect_frame (frame);
1843 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1845 Lisp_Object frame = Fcar (frame_inp_and_dev);
1846 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1847 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1850 if (!DEVICE_LIVE_P (XDEVICE (device)))
1853 d = XDEVICE (device);
1855 /* Any received focus-change notifications render invalid any
1856 pending focus-change requests. */
1857 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1860 Lisp_Object focus_frame;
1862 if (!FRAME_LIVE_P (XFRAME (frame)))
1865 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1867 /* Mark the minibuffer as changed to make sure it gets updated
1868 properly if the echo area is active. */
1870 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1871 MARK_WINDOWS_CHANGED (w);
1874 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1876 /* Oops, we missed a focus-out event. */
1877 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1878 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1880 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1881 if (!EQ (frame, focus_frame))
1883 redisplay_redraw_cursor (XFRAME (frame), 1);
1888 /* We ignore the frame reported in the event. If it's different
1889 from where we think the focus was, oh well -- we messed up.
1890 Nonetheless, we pretend we were right, for sensible behavior. */
1891 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1894 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1896 if (FRAME_LIVE_P (XFRAME (frame)))
1897 redisplay_redraw_cursor (XFRAME (frame), 1);
1902 /* Called from the window-system-specific code when we receive a
1903 notification that the focus lies on a particular frame.
1904 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1908 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1910 Lisp_Object frame = Fcar (frame_inp_and_dev);
1911 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1912 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1916 if (!DEVICE_LIVE_P (XDEVICE (device)))
1919 d = XDEVICE (device);
1923 Lisp_Object focus_frame;
1925 if (!FRAME_LIVE_P (XFRAME (frame)))
1928 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1930 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1931 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1933 /* Oops, we missed a focus-out event. */
1934 Fselect_frame (focus_frame);
1935 /* Do an unwind-protect in case an error occurs in
1936 the deselect-frame-hook */
1937 count = specpdl_depth ();
1938 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1939 run_deselect_frame_hook ();
1940 unbind_to (count, Qnil);
1941 /* the cleanup method changed the focus frame to nil, so
1942 we need to reflect this */
1946 Fselect_frame (frame);
1947 if (!EQ (frame, focus_frame))
1948 run_select_frame_hook ();
1952 /* We ignore the frame reported in the event. If it's different
1953 from where we think the focus was, oh well -- we messed up.
1954 Nonetheless, we pretend we were right, for sensible behavior. */
1955 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1958 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1959 run_deselect_frame_hook ();
1965 /**********************************************************************/
1966 /* retrieving the next event */
1967 /**********************************************************************/
1969 static int in_single_console;
1971 /* #### These functions don't currently do anything. */
1973 single_console_state (void)
1975 in_single_console = 1;
1979 any_console_state (void)
1981 in_single_console = 0;
1985 in_single_console_state (void)
1987 return in_single_console;
1990 /* the number of keyboard characters read. callint.c wants this. */
1991 Charcount num_input_chars;
1994 next_event_internal (Lisp_Object target_event, int allow_queued)
1996 struct gcpro gcpro1;
1997 /* QUIT; This is incorrect - the caller must do this because some
1998 callers (ie, Fnext_event()) do not want to QUIT. */
2000 assert (NILP (XEVENT_NEXT (target_event)));
2002 GCPRO1 (target_event);
2004 /* When focus_follows_mouse is nil, if a frame change took place, we need
2005 * to actually switch window manager focus to the selected window now.
2007 if (!focus_follows_mouse)
2008 investigate_frame_change ();
2010 if (allow_queued && !NILP (command_event_queue))
2012 Lisp_Object event = dequeue_command_event ();
2013 Fcopy_event (event, target_event);
2014 Fdeallocate_event (event);
2015 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
2019 struct Lisp_Event *e = XEVENT (target_event);
2021 /* The command_event_queue was empty. Wait for an event. */
2022 event_stream_next_event (e);
2023 /* If this was a timeout, then we need to extract some data
2024 out of the returned closure and might need to resignal
2026 if (e->event_type == timeout_event)
2028 Lisp_Object tristan, isolde;
2030 e->event.timeout.id_number =
2031 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
2034 e->event.timeout.function = tristan;
2035 e->event.timeout.object = isolde;
2036 /* next_event_internal() doesn't print out timeout events
2037 because of the extra info we just set. */
2038 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
2041 /* If we read a ^G, then set quit-flag but do not discard the ^G.
2042 The callers of next_event_internal() will do one of two things:
2044 -- set Vquit_flag to Qnil. (next-event does this.) This will
2045 cause the ^G to be treated as a normal keystroke.
2046 -- not change Vquit_flag but attempt to enqueue the ^G, at
2047 which point it will be discarded. The next time QUIT is
2048 called, it will notice that Vquit_flag was set.
2051 if (e->event_type == key_press_event &&
2052 event_matches_key_specifier_p
2053 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2063 run_pre_idle_hook (void)
2065 if (!NILP (Vpre_idle_hook)
2066 && !detect_input_pending ())
2067 safe_run_hook_trapping_errors
2068 ("Error in `pre-idle-hook' (setting hook to nil)",
2072 static void push_this_command_keys (Lisp_Object event);
2073 static void push_recent_keys (Lisp_Object event);
2074 static void dribble_out_event (Lisp_Object event);
2075 static void execute_internal_event (Lisp_Object event);
2077 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2078 Return the next available event.
2079 Pass this object to `dispatch-event' to handle it.
2080 In most cases, you will want to use `next-command-event', which returns
2081 the next available "user" event (i.e. keypress, button-press,
2082 button-release, or menu selection) instead of this function.
2084 If EVENT is non-nil, it should be an event object and will be filled in
2085 and returned; otherwise a new event object will be created and returned.
2086 If PROMPT is non-nil, it should be a string and will be displayed in the
2087 echo area while this function is waiting for an event.
2089 The next available event will be
2091 -- any events in `unread-command-events' or `unread-command-event'; else
2092 -- the next event in the currently executing keyboard macro, if any; else
2093 -- an event queued by `enqueue-eval-event', if any; else
2094 -- the next available event from the window system or terminal driver.
2096 In the last case, this function will block until an event is available.
2098 The returned event will be one of the following types:
2100 -- a key-press event.
2101 -- a button-press or button-release event.
2102 -- a misc-user-event, meaning the user selected an item on a menu or used
2104 -- a process event, meaning that output from a subprocess is available.
2105 -- a timeout event, meaning that a timeout has elapsed.
2106 -- an eval event, which simply causes a function to be executed when the
2107 event is dispatched. Eval events are generated by `enqueue-eval-event'
2108 or by certain other conditions happening.
2109 -- a magic event, indicating that some window-system-specific event
2110 happened (such as a focus-change notification) that must be handled
2111 synchronously with other events. `dispatch-event' knows what to do with
2116 /* This function can call lisp */
2117 /* #### We start out using the selected console before an event
2118 is received, for echoing the partially completed command.
2119 This is most definitely wrong -- there needs to be a separate
2120 echo area for each console! */
2121 struct console *con = XCONSOLE (Vselected_console);
2122 struct command_builder *command_builder =
2123 XCOMMAND_BUILDER (con->command_builder);
2124 int store_this_key = 0;
2125 struct gcpro gcpro1;
2126 #ifdef LWLIB_MENUBARS_LUCID
2127 extern int in_menu_callback; /* defined in menubar-x.c */
2128 #endif /* LWLIB_MENUBARS_LUCID */
2131 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2132 We want to read the ^G as an event. */
2134 #ifdef LWLIB_MENUBARS_LUCID
2136 * #### Fix the menu code so this isn't necessary.
2138 * We cannot allow the lwmenu code to be reentered, because the
2139 * code is not written to be reentrant and will crash. Therefore
2140 * paths from the menu callbacks back into the menu code have to
2141 * be blocked. Fnext_event is the normal path into the menu code,
2142 * so we signal an error here.
2144 if (in_menu_callback)
2145 error ("Attempt to call next-event inside menu callback");
2146 #endif /* LWLIB_MENUBARS_LUCID */
2149 event = Fmake_event (Qnil, Qnil);
2151 CHECK_LIVE_EVENT (event);
2156 CHECK_STRING (prompt);
2158 len = XSTRING_LENGTH (prompt);
2159 if (command_builder->echo_buf_length < len)
2160 len = command_builder->echo_buf_length - 1;
2161 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2162 command_builder->echo_buf[len] = 0;
2163 command_builder->echo_buf_index = len;
2164 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2165 command_builder->echo_buf,
2167 command_builder->echo_buf_index,
2171 start_over_and_avoid_hosage:
2173 /* If there is something in unread-command-events, simply return it.
2174 But do some error checking to make sure the user hasn't put something
2175 in the unread-command-events that they shouldn't have.
2176 This does not update this-command-keys and recent-keys.
2178 if (!NILP (Vunread_command_events))
2180 if (!CONSP (Vunread_command_events))
2182 Vunread_command_events = Qnil;
2183 signal_error (Qwrong_type_argument,
2184 list3 (Qconsp, Vunread_command_events,
2185 Qunread_command_events));
2189 Lisp_Object e = XCAR (Vunread_command_events);
2190 Vunread_command_events = XCDR (Vunread_command_events);
2191 if (!EVENTP (e) || !command_event_p (e))
2192 signal_error (Qwrong_type_argument,
2193 list3 (Qcommand_event_p, e, Qunread_command_events));
2196 Fcopy_event (e, event);
2197 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2201 /* Do similar for unread-command-event (obsoleteness support). */
2202 else if (!NILP (Vunread_command_event))
2204 Lisp_Object e = Vunread_command_event;
2205 Vunread_command_event = Qnil;
2207 if (!EVENTP (e) || !command_event_p (e))
2209 signal_error (Qwrong_type_argument,
2210 list3 (Qeventp, e, Qunread_command_event));
2213 Fcopy_event (e, event);
2215 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2218 /* If we're executing a keyboard macro, take the next event from that,
2219 and update this-command-keys and recent-keys.
2220 Note that the unread-command-events take precedence over kbd macros.
2224 if (!NILP (Vexecuting_macro))
2227 pop_kbd_macro_event (event); /* This throws past us at
2230 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2232 /* Otherwise, read a real event, possibly from the
2233 command_event_queue, and update this-command-keys and
2237 run_pre_idle_hook ();
2239 next_event_internal (event, 1);
2240 Vquit_flag = Qnil; /* Read C-g as an event. */
2245 status_notify (); /* Notice process change */
2248 alloca (0); /* Cause a garbage collection now */
2249 /* Since we can free the most stuff here
2250 * (since this is typically called from
2251 * the command-loop top-level). */
2252 #endif /* C_ALLOCA */
2254 if (object_dead_p (XEVENT (event)->channel))
2255 /* event_console_or_selected may crash if the channel is dead.
2256 Best just to eat it and get the next event. */
2257 goto start_over_and_avoid_hosage;
2259 /* OK, now we can stop the selected-console kludge and use the
2260 actual console from the event. */
2261 con = event_console_or_selected (event);
2262 command_builder = XCOMMAND_BUILDER (con->command_builder);
2264 switch (XEVENT_TYPE (event))
2268 case button_release_event:
2269 case misc_user_event:
2270 /* don't echo menu accelerator keys */
2271 reset_key_echo (command_builder, 1);
2273 case button_press_event: /* key or mouse input can trigger prompting */
2274 goto STORE_AND_EXECUTE_KEY;
2275 case key_press_event: /* any key input can trigger autosave */
2279 maybe_do_auto_save ();
2281 STORE_AND_EXECUTE_KEY:
2284 echo_key_event (command_builder, event);
2288 /* Store the last-input-event. The semantics of this is that it is
2289 the thing most recently returned by next-command-event. It need
2290 not have come from the keyboard or a keyboard macro, it may have
2291 come from unread-command-events. It's always a command-event (a
2292 key, click, or menu selection), never a motion or process event.
2294 if (!EVENTP (Vlast_input_event))
2295 Vlast_input_event = Fmake_event (Qnil, Qnil);
2296 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2298 Vlast_input_event = Fmake_event (Qnil, Qnil);
2299 error ("Someone deallocated last-input-event!");
2301 if (! EQ (event, Vlast_input_event))
2302 Fcopy_event (event, Vlast_input_event);
2304 /* last-input-char and last-input-time are derived from
2306 Note that last-input-char will never have its high-bit set, in an
2307 effort to sidestep the ambiguity between M-x and oslash.
2309 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2314 if (!CONSP (Vlast_input_time))
2315 Vlast_input_time = Fcons (Qnil, Qnil);
2316 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2317 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2318 if (!CONSP (Vlast_command_event_time))
2319 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2320 XCAR (Vlast_command_event_time) =
2321 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2322 XCAR (XCDR (Vlast_command_event_time)) =
2323 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2324 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2325 = make_int (EMACS_USECS (t));
2328 /* If this key came from the keyboard or from a keyboard macro, then
2329 it goes into the recent-keys and this-command-keys vectors.
2330 If this key came from the keyboard, and we're defining a keyboard
2331 macro, then it goes into the macro.
2335 push_this_command_keys (event);
2336 if (!inhibit_input_event_recording)
2337 push_recent_keys (event);
2338 dribble_out_event (event);
2339 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2341 if (!EVENTP (command_builder->current_events))
2342 finalize_kbd_macro_chars (con);
2343 store_kbd_macro_event (event);
2346 /* If this is the help char and there is a help form, then execute the
2347 help form and swallow this character. This is the only place where
2348 calling Fnext_event() can cause arbitrary lisp code to run. Note
2349 that execute_help_form() calls Fnext_command_event(), which calls
2350 this function, as well as Fdispatch_event.
2352 if (!NILP (Vhelp_form) &&
2353 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2354 execute_help_form (command_builder, event);
2361 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2362 Return the next available "user" event.
2363 Pass this object to `dispatch-event' to handle it.
2365 If EVENT is non-nil, it should be an event object and will be filled in
2366 and returned; otherwise a new event object will be created and returned.
2367 If PROMPT is non-nil, it should be a string and will be displayed in the
2368 echo area while this function is waiting for an event.
2370 The event returned will be a keyboard, mouse press, or mouse release event.
2371 If there are non-command events available (mouse motion, sub-process output,
2372 etc) then these will be executed (with `dispatch-event') and discarded. This
2373 function is provided as a convenience; it is rougly equivalent to the lisp code
2376 (next-event event prompt)
2377 (not (or (key-press-event-p event)
2378 (button-press-event-p event)
2379 (button-release-event-p event)
2380 (misc-user-event-p event))))
2381 (dispatch-event event))
2383 but it also makes a provision for displaying keystrokes in the echo area.
2387 /* This function can GC */
2388 struct gcpro gcpro1;
2390 maybe_echo_keys (XCOMMAND_BUILDER
2391 (XCONSOLE (Vselected_console)->
2392 command_builder), 0); /* #### This sucks bigtime */
2395 event = Fnext_event (event, prompt);
2396 if (command_event_p (event))
2399 execute_internal_event (event);
2406 reset_current_events (struct command_builder *command_builder)
2408 Lisp_Object event = command_builder->current_events;
2409 reset_command_builder_event_chain (command_builder);
2411 deallocate_event_chain (event);
2414 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2415 Discard any pending "user" events.
2416 Also cancel any kbd macro being defined.
2417 A user event is a key press, button press, button release, or
2418 "misc-user" event (menu selection or scrollbar action).
2422 /* This throws away user-input on the queue, but doesn't process any
2423 events. Calling dispatch_event() here leads to a race condition.
2425 Lisp_Object event = Fmake_event (Qnil, Qnil);
2426 Lisp_Object head = Qnil, tail = Qnil;
2427 Lisp_Object oiq = Vinhibit_quit;
2428 struct gcpro gcpro1, gcpro2;
2429 /* #### not correct here with Vselected_console? Should
2430 discard-input take a console argument, or maybe map over
2432 struct console *con = XCONSOLE (Vselected_console);
2434 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2435 GCPRO2 (event, oiq);
2437 /* If a macro was being defined then we have to mark the modeline
2438 has changed to ensure that it gets updated correctly. */
2439 if (!NILP (con->defining_kbd_macro))
2440 MARK_MODELINE_CHANGED;
2441 con->defining_kbd_macro = Qnil;
2442 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2444 while (!NILP (command_event_queue)
2445 || event_stream_event_pending_p (1))
2447 /* This will take stuff off the command_event_queue, or read it
2448 from the event_stream, but it will not block.
2450 next_event_internal (event, 1);
2451 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2452 It is vitally important that we reset
2453 Vquit_flag here. Otherwise, if we're
2454 reading from a TTY console,
2455 maybe_read_quit_event() will notice
2456 that C-g has been set and send us
2457 another C-g. That will cause us
2458 to get right back here, and read
2459 another C-g, ad infinitum ... */
2461 /* If the event is a user event, ignore it. */
2462 if (!command_event_p (event))
2464 /* Otherwise, chain the event onto our list of events not to ignore,
2465 and keep reading until the queue is empty. This does not mean
2466 that if a subprocess is generating an infinite amount of output,
2467 we will never terminate (*provided* that the behavior of
2468 next_event_cb() is correct -- see the comment in events.h),
2469 because this loop ends as soon as there are no more user events
2470 on the command_event_queue or event_stream.
2472 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2476 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2479 /* Now tack our chain of events back on to the front of the queue.
2480 Actually, since the queue is now drained, we can just replace it.
2481 The effect of this will be that we have deleted all user events
2482 from the input stream without changing the relative ordering of
2483 any other events. (Some events may have been taken from the
2484 event_stream and added to the command_event_queue, however.)
2486 At this time, the command_event_queue will contain only eval_events.
2489 command_event_queue = head;
2490 command_event_queue_tail = tail;
2492 Fdeallocate_event (event);
2495 Vinhibit_quit = oiq;
2500 /**********************************************************************/
2501 /* pausing until an action occurs */
2502 /**********************************************************************/
2504 /* This is used in accept-process-output, sleep-for and sit-for.
2505 Before running any process_events in these routines, we set
2506 recursive_sit_for to Qt, and use this unwind protect to reset it to
2507 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2508 cause it to return immediately.
2510 All of these routines install timeouts, so we clear the installed
2513 Note: It's very easy to break the desired behaviours of these
2514 3 routines. If you make any changes to anything in this area, run
2515 the regression tests at the bottom of the file. -- dmoore */
2519 sit_for_unwind (Lisp_Object timeout_id)
2521 if (!NILP(timeout_id))
2522 Fdisable_timeout (timeout_id);
2524 recursive_sit_for = Qnil;
2528 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2531 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2532 Allow any pending output from subprocesses to be read by Emacs.
2533 It is read into the process' buffers or given to their filter functions.
2534 Non-nil arg PROCESS means do not return until some output has been received
2535 from PROCESS. Nil arg PROCESS means do not return until some output has
2536 been received from any process.
2537 If the second arg is non-nil, it is the maximum number of seconds to wait:
2538 this function will return after that much time even if no input has arrived
2539 from PROCESS. This argument may be a float, meaning wait some fractional
2541 If the third arg is non-nil, it is a number of milliseconds that is added
2542 to the second arg. (This exists only for compatibility.)
2543 Return non-nil iff we received any output before the timeout expired.
2545 (process, timeout_secs, timeout_msecs))
2547 /* This function can GC */
2548 struct gcpro gcpro1, gcpro2;
2549 Lisp_Object event = Qnil;
2550 Lisp_Object result = Qnil;
2551 int timeout_id = -1;
2552 int timeout_enabled = 0;
2554 struct buffer *old_buffer = current_buffer;
2557 /* We preserve the current buffer but nothing else. If a focus
2558 change alters the selected window then the top level event loop
2559 will eventually alter current_buffer to match. In the mean time
2560 we don't want to mess up whatever called this function. */
2562 if (!NILP (process))
2563 CHECK_PROCESS (process);
2565 GCPRO2 (event, process);
2567 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2569 unsigned long msecs = 0;
2570 if (!NILP (timeout_secs))
2571 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2572 if (!NILP (timeout_msecs))
2574 CHECK_NATNUM (timeout_msecs);
2575 msecs += XINT (timeout_msecs);
2579 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2580 timeout_enabled = 1;
2584 event = Fmake_event (Qnil, Qnil);
2586 count = specpdl_depth ();
2587 record_unwind_protect (sit_for_unwind,
2588 timeout_enabled ? make_int (timeout_id) : Qnil);
2589 recursive_sit_for = Qt;
2592 ((NILP (process) && timeout_enabled) ||
2593 (NILP (process) && event_stream_event_pending_p (0)) ||
2595 /* Calling detect_input_pending() is the wrong thing here, because
2596 that considers the Vunread_command_events and command_event_queue.
2597 We don't need to look at the command_event_queue because we are
2598 only interested in process events, which don't go on that. In
2599 fact, we can't read from it anyway, because we put stuff on it.
2601 Note that event_stream->event_pending_p must be called in such
2602 a way that it says whether any events *of any kind* are ready,
2603 not just user events, or (accept-process-output nil) will fail
2604 to dispatch any process events that may be on the queue. It is
2605 not clear to me that this is important, because the top-level
2606 loop will process it, and I don't think that there is ever a
2607 time when one calls accept-process-output with a nil argument
2608 and really need the processes to be handled. */
2610 /* If our timeout has arrived, we move along. */
2611 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2613 timeout_enabled = 0;
2614 done = 1; /* We're done. */
2615 continue; /* Don't call next_event_internal */
2618 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2619 before reading output from the process - this makes it
2620 less likely that the filter will actually be aborted.
2623 next_event_internal (event, 0);
2624 /* If C-g was pressed while we were waiting, Vquit_flag got
2625 set and next_event_internal() also returns C-g. When
2626 we enqueue the C-g below, it will get discarded. The
2627 next time through, QUIT will be called and will signal a quit. */
2628 switch (XEVENT_TYPE (event))
2632 if (NILP (process) ||
2633 EQ (XEVENT (event)->event.process.process, process))
2636 /* RMS's version always returns nil when proc is nil,
2637 and only returns t if input ever arrived on proc. */
2641 execute_internal_event (event);
2645 /* We execute the event even if it's ours, and notice that it's
2647 case pointer_motion_event:
2650 execute_internal_event (event);
2655 enqueue_command_event_1 (event);
2661 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2663 Fdeallocate_event (event);
2665 current_buffer = old_buffer;
2669 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2670 Pause, without updating display, for ARG seconds.
2671 ARG may be a float, meaning pause for some fractional part of a second.
2673 It is recommended that you never call sleep-for from inside of a process
2674 filter function or timer event (either synchronous or asynchronous).
2678 /* This function can GC */
2679 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2681 Lisp_Object event = Qnil;
2683 struct gcpro gcpro1;
2687 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2688 event = Fmake_event (Qnil, Qnil);
2690 count = specpdl_depth ();
2691 record_unwind_protect (sit_for_unwind, make_int (id));
2692 recursive_sit_for = Qt;
2696 /* If our timeout has arrived, we move along. */
2697 if (!event_stream_wakeup_pending_p (id, 0))
2700 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2701 before reading output from the process - this makes it
2702 less likely that the filter will actually be aborted.
2704 /* We're a generator of the command_event_queue, so we can't be a
2705 consumer as well. We don't care about command and eval-events
2708 next_event_internal (event, 0); /* blocks */
2709 /* See the comment in accept-process-output about Vquit_flag */
2710 switch (XEVENT_TYPE (event))
2713 /* We execute the event even if it's ours, and notice that it's
2716 case pointer_motion_event:
2719 execute_internal_event (event);
2724 enqueue_command_event_1 (event);
2730 unbind_to (count, make_int (id));
2731 Fdeallocate_event (event);
2736 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2737 Perform redisplay, then wait ARG seconds or until user input is available.
2738 ARG may be a float, meaning a fractional part of a second.
2739 Optional second arg non-nil means don't redisplay, just wait for input.
2740 Redisplay is preempted as always if user input arrives, and does not
2741 happen if input is available before it starts.
2742 Value is t if waited the full time with no input arriving.
2744 If sit-for is called from within a process filter function or timer
2745 event (either synchronous or asynchronous) it will return immediately.
2747 (seconds, nodisplay))
2749 /* This function can GC */
2750 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2751 Lisp_Object event, result;
2752 struct gcpro gcpro1;
2756 /* The unread-command-events count as pending input */
2757 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2760 /* If the command-builder already has user-input on it (not eval events)
2761 then that means we're done too.
2763 if (!NILP (command_event_queue))
2765 EVENT_CHAIN_LOOP (event, command_event_queue)
2767 if (command_event_p (event))
2772 /* If we're in a macro, or noninteractive, or early in temacs, then
2774 if (noninteractive || !NILP (Vexecuting_macro))
2777 /* Recusive call from a filter function or timeout handler. */
2778 if (!NILP(recursive_sit_for))
2780 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2782 run_pre_idle_hook ();
2789 /* Otherwise, start reading events from the event_stream.
2790 Do this loop at least once even if (sit-for 0) so that we
2791 redisplay when no input pending.
2794 event = Fmake_event (Qnil, Qnil);
2796 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2797 events get processed. The old (pre-19.12) code special-cased this
2798 and didn't generate a wakeup, but the resulting behavior was less than
2799 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2800 the E-Lisp universe. */
2802 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2804 count = specpdl_depth ();
2805 record_unwind_protect (sit_for_unwind, make_int (id));
2806 recursive_sit_for = Qt;
2810 /* If there is no user input pending, then redisplay.
2812 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2814 run_pre_idle_hook ();
2818 /* If our timeout has arrived, we move along. */
2819 if (!event_stream_wakeup_pending_p (id, 0))
2825 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2826 before reading output from the process - this makes it
2827 less likely that the filter will actually be aborted.
2829 /* We're a generator of the command_event_queue, so we can't be a
2830 consumer as well. In fact, we know there's nothing on the
2831 command_event_queue that we didn't just put there.
2833 next_event_internal (event, 0); /* blocks */
2834 /* See the comment in accept-process-output about Vquit_flag */
2836 if (command_event_p (event))
2838 QUIT; /* If the command was C-g check it here
2839 so that we abort out of the sit-for,
2840 not the next command. sleep-for and
2841 accept-process-output continue looping
2842 so they check QUIT again implicitly.*/
2846 switch (XEVENT_TYPE (event))
2850 /* eval-events get delayed until later. */
2851 enqueue_command_event (Fcopy_event (event, Qnil));
2856 /* We execute the event even if it's ours, and notice that it's
2860 execute_internal_event (event);
2867 unbind_to (count, make_int (id));
2869 /* Put back the event (if any) that made Fsit_for() exit before the
2870 timeout. Note that it is being added to the back of the queue, which
2871 would be inappropriate if there were any user events on the queue
2872 already: we would be misordering them. But we know that there are
2873 no user-events on the queue, or else we would not have reached this
2877 enqueue_command_event (event);
2879 Fdeallocate_event (event);
2885 /* This handy little function is used by xselect.c and energize.c to
2886 wait for replies from processes that aren't really processes (that is,
2887 the X server and the Energize server).
2890 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2892 /* This function can GC */
2893 Lisp_Object event = Fmake_event (Qnil, Qnil);
2894 struct gcpro gcpro1;
2897 while (!(*predicate) (predicate_arg))
2899 QUIT; /* next_event_internal() does not QUIT. */
2901 /* We're a generator of the command_event_queue, so we can't be a
2902 consumer as well. Also, we have no reason to consult the
2903 command_event_queue; there are only user and eval-events there,
2904 and we'd just have to put them back anyway.
2906 next_event_internal (event, 0);
2907 /* See the comment in accept-process-output about Vquit_flag */
2908 if (command_event_p (event)
2909 || (XEVENT_TYPE (event) == eval_event)
2910 || (XEVENT_TYPE (event) == magic_eval_event))
2911 enqueue_command_event_1 (event);
2913 execute_internal_event (event);
2919 /**********************************************************************/
2920 /* dispatching events; command builder */
2921 /**********************************************************************/
2924 execute_internal_event (Lisp_Object event)
2926 /* events on dead channels get silently eaten */
2927 if (object_dead_p (XEVENT (event)->channel))
2930 /* This function can GC */
2931 switch (XEVENT_TYPE (event))
2938 call1 (XEVENT (event)->event.eval.function,
2939 XEVENT (event)->event.eval.object);
2943 case magic_eval_event:
2945 (XEVENT (event)->event.magic_eval.internal_function)
2946 (XEVENT (event)->event.magic_eval.object);
2950 case pointer_motion_event:
2952 if (!NILP (Vmouse_motion_handler))
2953 call1 (Vmouse_motion_handler, event);
2959 Lisp_Object p = XEVENT (event)->event.process.process;
2960 Charcount readstatus;
2962 assert (PROCESSP (p));
2963 while ((readstatus = read_process_output (p)) > 0)
2966 ; /* this clauses never gets executed but allows the #ifdefs
2969 else if (readstatus == -1 && errno == EWOULDBLOCK)
2971 #endif /* EWOULDBLOCK */
2973 else if (readstatus == -1 && errno == EAGAIN)
2976 else if ((readstatus == 0 &&
2977 /* Note that we cannot distinguish between no input
2978 available now and a closed pipe.
2979 With luck, a closed pipe will be accompanied by
2980 subprocess termination and SIGCHLD. */
2981 (!network_connection_p (p) ||
2983 When connected to ToolTalk (i.e.
2984 connected_via_filedesc_p()), it's not possible to
2985 reliably determine whether there is a message
2986 waiting for ToolTalk to receive. ToolTalk expects
2987 to have tt_message_receive() called exactly once
2988 every time the file descriptor becomes active, so
2989 the filter function forces this by returning 0.
2990 Emacs must not interpret this as a closed pipe. */
2991 connected_via_filedesc_p (XPROCESS (p))))
2993 /* On some OSs with ptys, when the process on one end of
2994 a pty exits, the other end gets an error reading with
2995 errno = EIO instead of getting an EOF (0 bytes read).
2996 Therefore, if we get an error reading and errno =
2997 EIO, just continue, because the child process has
2998 exited and should clean itself up soon (e.g. when we
3000 || (readstatus == -1 && errno == EIO)
3004 /* Currently, we rely on SIGCHLD to indicate that the
3005 process has terminated. Unfortunately, on some systems
3006 the SIGCHLD gets missed some of the time. So we put an
3007 additional check in status_notify() to see whether a
3008 process has terminated. We must tell status_notify()
3009 to enable that check, and we do so now. */
3010 kick_status_notify ();
3014 /* Deactivate network connection */
3015 Lisp_Object status = Fprocess_status (p);
3016 if (EQ (status, Qopen)
3017 /* In case somebody changes the theory of whether to
3018 return open as opposed to run for network connection
3020 || EQ (status, Qrun))
3021 update_process_status (p, Qexit, 256, 0);
3022 deactivate_process (p);
3025 /* We must call status_notify here to allow the
3026 event_stream->unselect_process_cb to be run if appropriate.
3027 Otherwise, dead fds may be selected for, and we will get a
3028 continuous stream of process events for them. Since we don't
3029 return until all process events have been flushed, we would
3030 get stuck here, processing events on a process whose status
3031 was 'exit. Call this after dispatch-event, or the fds will
3032 have been closed before we read the last data from them.
3033 It's safe for the filter to signal an error because
3034 status_notify() will be called on return to top-level.
3042 struct Lisp_Event *e = XEVENT (event);
3043 if (!NILP (e->event.timeout.function))
3044 call1 (e->event.timeout.function,
3045 e->event.timeout.object);
3050 event_stream_handle_magic_event (XEVENT (event));
3061 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3063 Lisp_Object first_before_suffix =
3064 event_chain_find_previous (Vthis_command_keys, suffix);
3066 if (NILP (first_before_suffix))
3067 Vthis_command_keys = chain;
3069 XSET_EVENT_NEXT (first_before_suffix, chain);
3070 deallocate_event_chain (suffix);
3071 Vthis_command_keys_tail = event_chain_tail (chain);
3075 command_builder_replace_suffix (struct command_builder *builder,
3076 Lisp_Object suffix, Lisp_Object chain)
3078 Lisp_Object first_before_suffix =
3079 event_chain_find_previous (builder->current_events, suffix);
3081 if (NILP (first_before_suffix))
3082 builder->current_events = chain;
3084 XSET_EVENT_NEXT (first_before_suffix, chain);
3085 deallocate_event_chain (suffix);
3086 builder->most_current_event = event_chain_tail (chain);
3090 command_builder_find_leaf_1 (struct command_builder *builder)
3092 Lisp_Object event0 = builder->current_events;
3097 return event_binding (event0, 1);
3100 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3104 widget_value *current, *prev;
3105 widget_value *entries;
3107 current = lw_get_entries (False);
3108 entries = lw_get_entries (True);
3110 if (current != entries)
3112 while (entries != current)
3114 if (entries->name /*&& entries->enabled*/) prev = entries;
3115 entries = entries->next;
3121 /* move to last item */
3123 while (entries->next)
3125 if (entries->name /*&& entries->enabled*/) prev = entries;
3126 entries = entries->next;
3130 if (entries->name /*&& entries->enabled*/)
3135 /* no selectable items in this menu, pop up to previous level */
3144 menu_move_down (void)
3146 widget_value *current;
3149 current = lw_get_entries (False);
3155 if (new->name /*&& new->enabled*/) break;
3158 if (new==current||!(new->name/*||new->enabled*/))
3160 new = lw_get_entries (True);
3161 while (new!=current)
3163 if (new->name /*&& new->enabled*/) break;
3166 if (new==current&&!(new->name /*|| new->enabled*/))
3177 menu_move_left (void)
3179 int level = lw_menu_level ();
3181 widget_value *current;
3189 current = lw_get_entries (False);
3190 if (l > 2 && current->contents)
3191 lw_push_menu (current->contents);
3195 menu_move_right (void)
3197 int level = lw_menu_level ();
3199 widget_value *current;
3207 current = lw_get_entries (False);
3208 if (l > 2 && current->contents)
3209 lw_push_menu (current->contents);
3213 menu_select_item (widget_value *val)
3216 val = lw_get_entries (False);
3218 /* is match a submenu? */
3222 /* enter the submenu */
3225 lw_push_menu (val->contents);
3229 /* Execute the menu entry by calling the menu's `select'
3232 lw_kill_menus (val);
3237 command_builder_operate_menu_accelerator (struct command_builder *builder)
3239 /* this function can GC */
3241 struct console *con = XCONSOLE (Vselected_console);
3242 Lisp_Object evee = builder->most_current_event;
3243 Lisp_Object binding;
3244 widget_value *entries;
3246 extern int lw_menu_accelerate; /* lwlib.c */
3254 t = builder->current_events;
3259 sprintf (buf,"OPERATE (%d): ",i);
3260 write_c_string (buf, Qexternal_debugging_output);
3261 print_internal (t, Qexternal_debugging_output, 1);
3262 write_c_string ("\n", Qexternal_debugging_output);
3263 t = XEVENT_NEXT (t);
3268 /* menu accelerator keys don't go into keyboard macros */
3269 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3270 con->kbd_macro_ptr = con->kbd_macro_end;
3272 /* don't echo menu accelerator keys */
3273 /*reset_key_echo (builder, 1);*/
3275 if (!lw_menu_accelerate)
3277 /* `convert' mouse display to keyboard display
3278 by entering the open submenu
3280 entries = lw_get_entries (False);
3281 if (entries->contents)
3283 lw_push_menu (entries->contents);
3284 lw_display_menu (CurrentTime);
3288 /* compare event to the current menu accelerators */
3290 entries=lw_get_entries (True);
3295 VOID_TO_LISP (accel, entries->accel);
3296 if (entries->name && !NILP (accel))
3298 if (event_matches_key_specifier_p (XEVENT (evee), accel))
3302 menu_select_item (entries);
3304 if (lw_menu_active) lw_display_menu (CurrentTime);
3306 reset_this_command_keys (Vselected_console, 1);
3307 /*reset_command_builder_event_chain (builder);*/
3308 return Vmenu_accelerator_map;
3311 entries = entries->next;
3314 /* try to look up event in menu-accelerator-map */
3316 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
3320 /* beep at user for undefined key */
3325 if (EQ (binding, Qmenu_quit))
3327 /* turn off menus and set quit flag */
3328 lw_kill_menus (NULL);
3331 else if (EQ (binding, Qmenu_up))
3333 int level = lw_menu_level ();
3337 else if (EQ (binding, Qmenu_down))
3339 int level = lw_menu_level ();
3343 menu_select_item (NULL);
3345 else if (EQ (binding, Qmenu_left))
3347 int level = lw_menu_level ();
3351 lw_display_menu (CurrentTime);
3356 else if (EQ (binding, Qmenu_right))
3358 int level = lw_menu_level ();
3360 lw_get_entries (False)->contents)
3362 widget_value *current = lw_get_entries (False);
3363 if (current->contents)
3364 menu_select_item (NULL);
3369 else if (EQ (binding, Qmenu_select))
3370 menu_select_item (NULL);
3371 else if (EQ (binding, Qmenu_escape))
3373 int level = lw_menu_level ();
3378 lw_display_menu (CurrentTime);
3382 /* turn off menus quietly */
3383 lw_kill_menus (NULL);
3386 else if (KEYMAPP (binding))
3389 reset_this_command_keys (Vselected_console, 1);
3390 /*reset_command_builder_event_chain (builder);*/
3395 /* turn off menus and execute binding */
3396 lw_kill_menus (NULL);
3397 reset_this_command_keys (Vselected_console, 1);
3398 /*reset_command_builder_event_chain (builder);*/
3403 if (lw_menu_active) lw_display_menu (CurrentTime);
3405 reset_this_command_keys (Vselected_console, 1);
3406 /*reset_command_builder_event_chain (builder);*/
3408 return Vmenu_accelerator_map;
3412 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
3414 Vmenu_accelerator_prefix = Qnil;
3415 Vmenu_accelerator_modifiers = Qnil;
3416 Vmenu_accelerator_enabled = Qnil;
3417 if (!NILP (errordata))
3419 Lisp_Object args[2];
3421 args[0] = build_string ("Error in menu accelerators (setting to nil)");
3422 /* #### This should call
3423 (with-output-to-string (display-error errordata))
3424 but that stuff is all in Lisp currently. */
3425 args[1] = errordata;
3426 warn_when_safe_lispobj
3428 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
3429 Qnil, -1, 2, args));
3436 menu_accelerator_safe_compare (Lisp_Object event0)
3438 if (CONSP (Vmenu_accelerator_prefix))
3441 t=Vmenu_accelerator_prefix;
3444 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
3447 event0 = XEVENT_NEXT (event0);
3452 else if (NILP (event0))
3454 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
3455 event0 = XEVENT_NEXT (event0);
3462 menu_accelerator_safe_mod_compare (Lisp_Object cons)
3464 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
3470 command_builder_find_menu_accelerator (struct command_builder *builder)
3472 /* this function can GC */
3473 Lisp_Object event0 = builder->current_events;
3474 struct console *con = XCONSOLE (Vselected_console);
3475 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3476 Widget menubar_widget;
3478 /* compare entries in event0 against the menu prefix */
3480 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
3481 XEVENT (event0)->event_type != key_press_event)
3484 if (!NILP (Vmenu_accelerator_prefix))
3486 event0 = condition_case_1 (Qerror,
3487 menu_accelerator_safe_compare,
3489 menu_accelerator_junk_on_error,
3496 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3498 && CONSP (Vmenu_accelerator_modifiers))
3501 Lisp_Object last = Qnil;
3502 struct gcpro gcpro1;
3506 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
3508 val = lw_get_all_values (id);
3511 val = val->contents;
3513 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
3516 while (!NILP (Fcdr (last)))
3519 Fsetcdr (last, Fcons (Qnil, Qnil));
3523 fake = Fcons (Qnil, fake);
3530 VOID_TO_LISP (accel, val->accel);
3531 if (val->name && !NILP (accel))
3533 Fsetcar (last, accel);
3534 Fsetcar (fake, event0);
3535 matchp = condition_case_1 (Qerror,
3536 menu_accelerator_safe_mod_compare,
3538 menu_accelerator_junk_on_error,
3544 lw_set_menu (menubar_widget, val);
3545 /* yah - yet another hack.
3546 pretend emacs timestamp is the same as an X timestamp,
3547 which for the moment it is. (read events.h)
3549 lw_map_menu (XEVENT (event0)->timestamp);
3552 lw_push_menu (val->contents);
3554 lw_display_menu (CurrentTime);
3556 /* menu accelerator keys don't go into keyboard macros */
3557 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3558 con->kbd_macro_ptr = con->kbd_macro_end;
3560 /* don't echo menu accelerator keys */
3561 /*reset_key_echo (builder, 1);*/
3562 reset_this_command_keys (Vselected_console, 1);
3565 return Vmenu_accelerator_map;
3578 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
3579 Make the menubar active. Menu items can be selected using menu accelerators
3580 or by actions defined in menu-accelerator-map.
3584 struct console *con = XCONSOLE (Vselected_console);
3585 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3589 if (NILP (f->menubar_data))
3590 error ("Frame has no menubar.");
3592 id = XPOPUP_DATA (f->menubar_data)->id;
3593 val = lw_get_all_values (id);
3594 val = val->contents;
3595 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
3596 lw_map_menu (CurrentTime);
3598 lw_display_menu (CurrentTime);
3600 /* menu accelerator keys don't go into keyboard macros */
3601 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3602 con->kbd_macro_ptr = con->kbd_macro_end;
3606 #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */
3608 /* See if we can do function-key-map or key-translation-map translation
3609 on the current events in the command builder. If so, do this, and
3610 return the resulting binding, if any. */
3613 munge_keymap_translate (struct command_builder *builder,
3614 enum munge_me_out_the_door munge,
3615 int has_normal_binding_p)
3619 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3621 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3626 if (KEYMAPP (result))
3628 if (NILP (builder->last_non_munged_event)
3629 && !has_normal_binding_p)
3630 builder->last_non_munged_event = builder->most_current_event;
3633 builder->last_non_munged_event = Qnil;
3635 if (!KEYMAPP (result) &&
3636 !VECTORP (result) &&
3639 struct gcpro gcpro1;
3641 result = call1 (result, Qnil);
3647 if (KEYMAPP (result))
3650 if (VECTORP (result) || STRINGP (result))
3652 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3656 /* If the first_mungeable_event of the other munger is
3657 within the events we're munging, then it will point to
3658 deallocated events afterwards, which is bad -- so make it
3659 point at the beginning of the munged events. */
3660 EVENT_CHAIN_LOOP (tempev, suffix)
3662 Lisp_Object *mungeable_event =
3663 &builder->munge_me[1 - munge].first_mungeable_event;
3664 if (EQ (tempev, *mungeable_event))
3666 *mungeable_event = new_chain;
3671 n = event_chain_count (suffix);
3672 command_builder_replace_suffix (builder, suffix, new_chain);
3673 builder->munge_me[munge].first_mungeable_event = Qnil;
3674 /* Now hork this-command-keys as well. */
3676 /* We just assume that the events we just replaced are
3677 sitting in copied form at the end of this-command-keys.
3678 If the user did weird things with `dispatch-event' this
3679 may not be the case, but at least we make sure we won't
3681 new_chain = copy_event_chain (new_chain);
3682 tckn = event_chain_count (Vthis_command_keys);
3685 this_command_keys_replace_suffix
3686 (event_chain_nth (Vthis_command_keys, tckn - n),
3690 result = command_builder_find_leaf_1 (builder);
3694 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3695 "Invalid binding in function-key-map" :
3696 "Invalid binding in key-translation-map"),
3703 /* Compare the current state of the command builder against the local and
3704 global keymaps, and return the binding. If there is no match, try again,
3705 case-insensitively. The return value will be one of:
3706 -- nil (there is no binding)
3707 -- a keymap (part of a command has been specified)
3708 -- a command (anything that satisfies `commandp'; this includes
3709 some symbols, lists, subrs, strings, vectors, and
3710 compiled-function objects)
3713 command_builder_find_leaf (struct command_builder *builder,
3714 int allow_misc_user_events_p)
3716 /* This function can GC */
3718 Lisp_Object evee = builder->current_events;
3720 if (XEVENT_TYPE (evee) == misc_user_event)
3722 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3723 return list2 (XEVENT (evee)->event.eval.function,
3724 XEVENT (evee)->event.eval.object);
3729 /* if we're currently in a menu accelerator, check there for further events */
3730 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3733 return command_builder_operate_menu_accelerator (builder);
3738 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3739 result = command_builder_find_menu_accelerator (builder);
3742 result = command_builder_find_leaf_1 (builder);
3743 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3745 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3746 result = command_builder_find_menu_accelerator (builder);
3750 /* Check to see if we have a potential function-key-map match. */
3753 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3754 regenerate_echo_keys_from_this_command_keys (builder);
3756 /* Check to see if we have a potential key-translation-map match. */
3758 Lisp_Object key_translate_result =
3759 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3761 if (!NILP (key_translate_result))
3763 result = key_translate_result;
3764 regenerate_echo_keys_from_this_command_keys (builder);
3771 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3773 /* If we didn't find a binding, and the last event in the sequence is
3774 a shifted character, then try again with the lowercase version. */
3776 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3777 && !NILP (Vretry_undefined_key_binding_unshifted))
3779 Lisp_Object terminal = builder->most_current_event;
3780 struct key_data* key = & XEVENT (terminal)->event.key;
3782 if ((key->modifiers & MOD_SHIFT)
3783 || (CHAR_OR_CHAR_INTP (key->keysym)
3784 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3786 struct Lisp_Event terminal_copy = *XEVENT (terminal);
3788 if (key->modifiers & MOD_SHIFT)
3789 key->modifiers &= (~ MOD_SHIFT);
3791 key->keysym = make_char (c + 'a' - 'A');
3793 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3796 /* If there was no match with the lower-case version either,
3797 then put back the upper-case event for the error
3798 message. But make sure that function-key-map didn't
3799 change things out from under us. */
3800 if (EQ (terminal, builder->most_current_event))
3801 *XEVENT (terminal) = terminal_copy;
3805 /* help-char is `auto-bound' in every keymap */
3806 if (!NILP (Vprefix_help_command) &&
3807 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3809 return Vprefix_help_command;
3812 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3813 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3814 && !NILP (Vcomposed_character_default_binding))
3816 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3817 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3818 return Vcomposed_character_default_binding;
3820 #endif /* HAVE_XIM */
3822 /* If we read extra events attempting to match a function key but end
3823 up failing, then we release those events back to the command loop
3824 and fail on the original lookup. The released events will then be
3825 reprocessed in the context of the first part having failed. */
3826 if (!NILP (builder->last_non_munged_event))
3828 Lisp_Object event0 = builder->last_non_munged_event;
3830 /* Put the commands back on the event queue. */
3831 enqueue_event_chain (XEVENT_NEXT (event0),
3832 &command_event_queue,
3833 &command_event_queue_tail);
3835 /* Then remove them from the command builder. */
3836 XSET_EVENT_NEXT (event0, Qnil);
3837 builder->most_current_event = event0;
3838 builder->last_non_munged_event = Qnil;
3845 /* Every time a command-event (a key, button, or menu selection) is read by
3846 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3847 and in Vthis_command_keys. (Eval-events are not stored there.)
3849 Every time a command is invoked, Vlast_command_event is set to the last
3850 event in the sequence.
3852 This means that Vthis_command_keys is really about "input read since the
3853 last command was executed" rather than about "what keys invoked this
3854 command." This is a little counterintuitive, but that's the way it
3857 As an extra kink, the function read-key-sequence resets/updates the
3858 last-command-event and this-command-keys. It doesn't append to the
3859 command-keys as read-char does. Such are the pitfalls of having to
3860 maintain compatibility with a program for which the only specification
3863 (We could implement recent_keys_ring and Vthis_command_keys as the same
3867 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3868 Return a vector of recent keyboard or mouse button events read.
3869 If NUMBER is non-nil, not more than NUMBER events will be returned.
3870 Change number of events stored using `set-recent-keys-ring-size'.
3872 This copies the event objects into a new vector; it is safe to keep and
3877 struct gcpro gcpro1;
3878 Lisp_Object val = Qnil;
3880 int start, nkeys, i, j;
3884 nwanted = recent_keys_ring_size;
3887 CHECK_NATNUM (number);
3888 nwanted = XINT (number);
3891 /* Create the keys ring vector, if none present. */
3892 if (NILP (Vrecent_keys_ring))
3894 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3895 /* And return nothing in particular. */
3896 return make_vector (0, Qnil);
3899 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3900 /* This means the vector has not yet wrapped */
3902 nkeys = recent_keys_ring_index;
3907 nkeys = recent_keys_ring_size;
3908 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3911 if (nwanted < nkeys)
3913 start += nkeys - nwanted;
3914 if (start >= recent_keys_ring_size)
3915 start -= recent_keys_ring_size;
3921 val = make_vector (nwanted, Qnil);
3923 for (i = 0, j = start; i < nkeys; i++)
3925 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3929 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3930 if (++j >= recent_keys_ring_size)
3938 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3939 The maximum number of events `recent-keys' can return.
3943 return make_int (recent_keys_ring_size);
3946 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3947 Set the maximum number of events to be stored internally.
3951 Lisp_Object new_vector = Qnil;
3952 int i, j, nkeys, start, min;
3953 struct gcpro gcpro1;
3954 GCPRO1 (new_vector);
3957 if (XINT (size) <= 0)
3958 error ("Recent keys ring size must be positive");
3959 if (XINT (size) == recent_keys_ring_size)
3962 new_vector = make_vector (XINT (size), Qnil);
3964 if (NILP (Vrecent_keys_ring))
3966 Vrecent_keys_ring = new_vector;
3970 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3971 /* This means the vector has not yet wrapped */
3973 nkeys = recent_keys_ring_index;
3978 nkeys = recent_keys_ring_size;
3979 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3982 if (XINT (size) > nkeys)
3987 for (i = 0, j = start; i < min; i++)
3989 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3990 if (++j >= recent_keys_ring_size)
3993 recent_keys_ring_size = XINT (size);
3994 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3996 Vrecent_keys_ring = new_vector;
4002 /* Vthis_command_keys having value Qnil means that the next time
4003 push_this_command_keys is called, it should start over.
4004 The times at which the command-keys are reset
4005 (instead of merely being augmented) are pretty conterintuitive.
4008 -- We do not reset this-command-keys when we finish reading a
4009 command. This is because some commands (e.g. C-u) act
4010 like command prefixes; they signal this by setting prefix-arg
4012 -- Therefore, we reset this-command-keys when we finish
4013 executing a command, unless prefix-arg is set.
4014 -- However, if we ever do a non-local exit out of a command
4015 loop (e.g. an error in a command), we need to reset
4016 this-command-keys. We do this by calling reset_this_command_keys()
4017 from cmdloop.c, whenever an error causes an invocation of the
4018 default error handler, and whenever there's a throw to top-level.)
4022 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
4024 struct command_builder *command_builder =
4025 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4027 reset_key_echo (command_builder, clear_echo_area_p);
4029 deallocate_event_chain (Vthis_command_keys);
4030 Vthis_command_keys = Qnil;
4031 Vthis_command_keys_tail = Qnil;
4033 reset_current_events (command_builder);
4037 push_this_command_keys (Lisp_Object event)
4039 Lisp_Object new = Fmake_event (Qnil, Qnil);
4041 Fcopy_event (event, new);
4042 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
4045 /* The following two functions are used in call-interactively,
4046 for the @ and e specifications. We used to just use
4047 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
4048 but FSF does it more generally so we follow their lead. */
4051 extract_this_command_keys_nth_mouse_event (int n)
4055 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4058 && (XEVENT_TYPE (event) == button_press_event
4059 || XEVENT_TYPE (event) == button_release_event
4060 || XEVENT_TYPE (event) == misc_user_event))
4064 /* must copy to avoid an abort() in next_event_internal() */
4065 if (!NILP (XEVENT_NEXT (event)))
4066 return Fcopy_event (event, Qnil);
4078 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
4081 int len = XVECTOR_LENGTH (vector);
4083 for (i = 0; i < len; i++)
4085 Lisp_Object event = XVECTOR_DATA (vector)[i];
4087 switch (XEVENT_TYPE (event))
4089 case button_press_event :
4090 case button_release_event :
4091 case misc_user_event :
4105 push_recent_keys (Lisp_Object event)
4109 if (NILP (Vrecent_keys_ring))
4110 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
4112 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
4116 e = Fmake_event (Qnil, Qnil);
4117 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
4119 Fcopy_event (event, e);
4120 if (++recent_keys_ring_index == recent_keys_ring_size)
4121 recent_keys_ring_index = 0;
4126 current_events_into_vector (struct command_builder *command_builder)
4130 int n = event_chain_count (command_builder->current_events);
4132 /* Copy the vector and the events in it. */
4133 /* No need to copy the events, since they're already copies, and
4134 nobody other than the command-builder has pointers to them */
4135 vector = make_vector (n, Qnil);
4137 EVENT_CHAIN_LOOP (event, command_builder->current_events)
4138 XVECTOR_DATA (vector)[n++] = event;
4139 reset_command_builder_event_chain (command_builder);
4145 Given the current state of the command builder and a new command event
4146 that has just been dispatched:
4148 -- add the event to the event chain forming the current command
4149 (doing meta-translation as necessary)
4150 -- return the binding of this event chain; this will be one of:
4151 -- nil (there is no binding)
4152 -- a keymap (part of a command has been specified)
4153 -- a command (anything that satisfies `commandp'; this includes
4154 some symbols, lists, subrs, strings, vectors, and
4155 compiled-function objects)
4158 lookup_command_event (struct command_builder *command_builder,
4159 Lisp_Object event, int allow_misc_user_events_p)
4161 /* This function can GC */
4162 struct frame *f = selected_frame ();
4163 /* Clear output from previous command execution */
4164 if (!EQ (Qcommand, echo_area_status (f))
4165 /* but don't let mouse-up clear what mouse-down just printed */
4166 && (XEVENT (event)->event_type != button_release_event))
4167 clear_echo_area (f, Qnil, 0);
4169 /* Add the given event to the command builder.
4170 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
4171 vectors to translate "ESC x" to "M-x" (for any "x" of course).
4174 Lisp_Object recent = command_builder->most_current_event;
4177 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
4179 struct Lisp_Event *e;
4180 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
4181 DoubleThink the recent-keys and this-command-keys as well. */
4183 /* Modify the previous most-recently-pushed event on the command
4184 builder to be a copy of this one with the meta-bit set instead of
4185 pushing a new event.
4187 Fcopy_event (event, recent);
4188 e = XEVENT (recent);
4189 if (e->event_type == key_press_event)
4190 e->event.key.modifiers |= MOD_META;
4191 else if (e->event_type == button_press_event
4192 || e->event_type == button_release_event)
4193 e->event.button.modifiers |= MOD_META;
4198 int tckn = event_chain_count (Vthis_command_keys);
4200 /* ??? very strange if it's < 2. */
4201 this_command_keys_replace_suffix
4202 (event_chain_nth (Vthis_command_keys, tckn - 2),
4203 Fcopy_event (recent, Qnil));
4206 regenerate_echo_keys_from_this_command_keys (command_builder);
4210 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
4212 command_builder_append_event (command_builder, event);
4217 Lisp_Object leaf = command_builder_find_leaf (command_builder,
4218 allow_misc_user_events_p);
4219 struct gcpro gcpro1;
4224 if (!lw_menu_active)
4226 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
4227 if (STRINGP (prompt))
4229 /* Append keymap prompt to key echo buffer */
4230 int buf_index = command_builder->echo_buf_index;
4231 Bytecount len = XSTRING_LENGTH (prompt);
4233 if (len + buf_index + 1 <= command_builder->echo_buf_length)
4235 Bufbyte *echo = command_builder->echo_buf + buf_index;
4236 memcpy (echo, XSTRING_DATA (prompt), len);
4239 maybe_echo_keys (command_builder, 1);
4242 maybe_echo_keys (command_builder, 0);
4244 else if (!NILP (Vquit_flag)) {
4245 Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
4246 struct Lisp_Event *e = XEVENT (quit_event);
4247 /* if quit happened during menu acceleration, pretend we read it */
4248 struct console *con = XCONSOLE (Fselected_console ());
4249 int ch = CONSOLE_QUIT_CHAR (con);
4251 character_to_event (ch, e, con, 1, 1);
4252 e->channel = make_console (con);
4254 enqueue_command_event (quit_event);
4258 else if (!NILP (leaf))
4260 if (EQ (Qcommand, echo_area_status (f))
4261 && command_builder->echo_buf_index > 0)
4263 /* If we had been echoing keys, echo the last one (without
4264 the trailing dash) and redisplay before executing the
4266 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
4267 maybe_echo_keys (command_builder, 1);
4268 Fsit_for (Qzero, Qt);
4271 RETURN_UNGCPRO (leaf);
4276 execute_command_event (struct command_builder *command_builder,
4279 /* This function can GC */
4280 struct console *con = XCONSOLE (command_builder->console);
4281 struct gcpro gcpro1;
4283 GCPRO1 (event); /* event may be freshly created */
4284 reset_current_events (command_builder);
4286 switch (XEVENT (event)->event_type)
4288 case key_press_event:
4289 Vcurrent_mouse_event = Qnil;
4291 case button_press_event:
4292 case button_release_event:
4293 case misc_user_event:
4294 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
4299 /* Store the last-command-event. The semantics of this is that it
4300 is the last event most recently involved in command-lookup. */
4301 if (!EVENTP (Vlast_command_event))
4302 Vlast_command_event = Fmake_event (Qnil, Qnil);
4303 if (XEVENT (Vlast_command_event)->event_type == dead_event)
4305 Vlast_command_event = Fmake_event (Qnil, Qnil);
4306 error ("Someone deallocated the last-command-event!");
4309 if (! EQ (event, Vlast_command_event))
4310 Fcopy_event (event, Vlast_command_event);
4312 /* Note that last-command-char will never have its high-bit set, in
4313 an effort to sidestep the ambiguity between M-x and oslash. */
4314 Vlast_command_char = Fevent_to_character (Vlast_command_event,
4317 /* Actually call the command, with all sorts of hair to preserve or clear
4318 the echo-area and region as appropriate and call the pre- and post-
4321 int old_kbd_macro = con->kbd_macro_end;
4322 struct window *w = XWINDOW (Fselected_window (Qnil));
4324 /* We're executing a new command, so the old value is irrelevant. */
4325 zmacs_region_stays = 0;
4327 /* If the previous command tried to force a specific window-start,
4328 reset the flag in case this command moves point far away from
4329 that position. Also, reset the window's buffer's change
4330 information so that we don't trigger an incremental update. */
4334 buffer_reset_changes (XBUFFER (w->buffer));
4337 pre_command_hook ();
4339 if (XEVENT (event)->event_type == misc_user_event)
4341 call1 (XEVENT (event)->event.eval.function,
4342 XEVENT (event)->event.eval.object);
4346 Fcommand_execute (Vthis_command, Qnil, Qnil);
4349 post_command_hook ();
4351 #if 0 /* #### here was an attempted fix that didn't work */
4352 if (XEVENT (event)->event_type == misc_user_event)
4356 if (!NILP (con->prefix_arg))
4358 /* Commands that set the prefix arg don't update last-command, don't
4359 reset the echoing state, and don't go into keyboard macros unless
4360 followed by another command. */
4361 maybe_echo_keys (command_builder, 0);
4363 /* If we're recording a keyboard macro, and the last command
4364 executed set a prefix argument, then decrement the pointer to
4365 the "last character really in the macro" to be just before this
4366 command. This is so that the ^U in "^U ^X )" doesn't go onto
4367 the end of macro. */
4368 if (!NILP (con->defining_kbd_macro))
4369 con->kbd_macro_end = old_kbd_macro;
4373 /* Start a new command next time */
4374 Vlast_command = Vthis_command;
4375 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
4376 so we don't either */
4377 reset_this_command_keys (make_console (con), 0);
4384 /* Run the pre command hook. */
4387 pre_command_hook (void)
4389 last_point_position = BUF_PT (current_buffer);
4390 XSETBUFFER (last_point_position_buffer, current_buffer);
4391 /* This function can GC */
4392 safe_run_hook_trapping_errors
4393 ("Error in `pre-command-hook' (setting hook to nil)",
4394 Qpre_command_hook, 1);
4397 /* Run the post command hook. */
4400 post_command_hook (void)
4402 /* This function can GC */
4403 /* Turn off region highlighting unless this command requested that
4404 it be left on, or we're in the minibuffer. We don't turn it off
4405 when we're in the minibuffer so that things like M-x write-region
4408 This could be done via a function on the post-command-hook, but
4409 we don't want the user to accidentally remove it.
4412 Lisp_Object win = Fselected_window (Qnil);
4415 /* If the last command deleted the frame, `win' might be nil.
4416 It seems safest to do nothing in this case. */
4417 /* ### This doesn't really fix the problem,
4418 if delete-frame is called by some hook */
4423 if (! zmacs_region_stays
4424 && (!MINI_WINDOW_P (XWINDOW (win))
4425 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
4426 zmacs_deactivate_region ();
4428 zmacs_update_region ();
4430 safe_run_hook_trapping_errors
4431 ("Error in `post-command-hook' (setting hook to nil)",
4432 Qpost_command_hook, 1);
4434 #ifdef DEFERRED_ACTION_CRAP
4435 if (!NILP (Vdeferred_action_list))
4436 call0 (Vdeferred_action_function);
4439 #ifdef ILL_CONCEIVED_HOOK
4440 if (NILP (Vunread_command_events)
4441 && NILP (Vexecuting_macro)
4442 && !NILP (Vpost_command_idle_hook)
4443 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
4445 safe_run_hook_trapping_errors
4446 ("Error in `post-command-idle-hook' (setting hook to nil)",
4447 Qpost_command_idle_hook, 1);
4451 if (!NILP (current_buffer->mark_active))
4453 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
4455 current_buffer->mark_active = Qnil;
4456 run_hook (intern ("deactivate-mark-hook"));
4458 else if (current_buffer != prev_buffer ||
4459 BUF_MODIFF (current_buffer) != prev_modiff)
4460 run_hook (intern ("activate-mark-hook"));
4462 #endif /* FSFmacs */
4464 /* #### Kludge!!! This is necessary to make sure that things
4465 are properly positioned even if post-command-hook moves point.
4466 #### There should be a cleaner way of handling this. */
4467 call0 (Qauto_show_make_point_visible);
4471 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4472 Given an event object as returned by `next-event', execute it.
4474 Key-press, button-press, and button-release events get accumulated
4475 until a complete key sequence (see `read-key-sequence') is reached,
4476 at which point the sequence is looked up in the current keymaps and
4479 Mouse motion events cause the low-level handling function stored in
4480 `mouse-motion-handler' to be called. (There are very few circumstances
4481 under which you should change this handler. Use `mode-motion-hook'
4484 Menu, timeout, and eval events cause the associated function or handler
4487 Process events cause the subprocess's output to be read and acted upon
4488 appropriately (see `start-process').
4490 Magic events are handled as necessary.
4494 /* This function can GC */
4495 struct command_builder *command_builder;
4496 struct Lisp_Event *ev;
4497 Lisp_Object console;
4498 Lisp_Object channel;
4500 CHECK_LIVE_EVENT (event);
4501 ev = XEVENT (event);
4503 /* events on dead channels get silently eaten */
4504 channel = EVENT_CHANNEL (ev);
4505 if (object_dead_p (channel))
4508 /* Some events don't have channels (e.g. eval events). */
4509 console = CDFW_CONSOLE (channel);
4511 console = Vselected_console;
4512 else if (!EQ (console, Vselected_console))
4513 Fselect_console (console);
4515 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4516 switch (XEVENT (event)->event_type)
4518 case button_press_event:
4519 case button_release_event:
4520 case key_press_event:
4522 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4525 /* Incomplete key sequence */
4529 /* At this point, we know that the sequence is not bound to a
4530 command. Normally, we beep and print a message informing the
4531 user of this. But we do not beep or print a message when:
4533 o the last event in this sequence is a mouse-up event; or
4534 o the last event in this sequence is a mouse-down event and
4535 there is a binding for the mouse-up version.
4537 That is, if the sequence ``C-x button1'' is typed, and is not
4538 bound to a command, but the sequence ``C-x button1up'' is bound
4539 to a command, we do not complain about the ``C-x button1''
4540 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4541 bound to a command, then we complain about the ``C-x button1''
4542 sequence, but later will *not* complain about the
4543 ``C-x button1up'' sequence, which would be redundant.
4545 This is pretty hairy, but I think it's the most intuitive
4548 Lisp_Object terminal = command_builder->most_current_event;
4550 if (XEVENT_TYPE (terminal) == button_press_event)
4553 /* Temporarily pretend the last event was an "up" instead of a
4554 "down", and look up its binding. */
4555 XEVENT_TYPE (terminal) = button_release_event;
4556 /* If the "up" version is bound, don't complain. */
4558 = !NILP (command_builder_find_leaf (command_builder, 0));
4559 /* Undo the temporary changes we just made. */
4560 XEVENT_TYPE (terminal) = button_press_event;
4563 /* Pretend this press was not seen (treat as a prefix) */
4564 if (EQ (command_builder->current_events, terminal))
4566 reset_current_events (command_builder);
4572 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4573 if (EQ (XEVENT_NEXT (eve), terminal))
4576 Fdeallocate_event (command_builder->
4577 most_current_event);
4578 XSET_EVENT_NEXT (eve, Qnil);
4579 command_builder->most_current_event = eve;
4581 maybe_echo_keys (command_builder, 1);
4586 /* Complain that the typed sequence is not defined, if this is the
4587 kind of sequence that warrants a complaint. */
4588 XCONSOLE (console)->defining_kbd_macro = Qnil;
4589 XCONSOLE (console)->prefix_arg = Qnil;
4590 /* Don't complain about undefined button-release events */
4591 if (XEVENT_TYPE (terminal) != button_release_event)
4593 Lisp_Object keys = current_events_into_vector (command_builder);
4594 struct gcpro gcpro1;
4596 /* Run the pre-command-hook before barfing about an undefined
4598 Vthis_command = Qnil;
4600 pre_command_hook ();
4602 /* The post-command-hook doesn't run. */
4603 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4605 /* Reset the command builder for reading the next sequence. */
4606 reset_this_command_keys (console, 1);
4608 else /* key sequence is bound to a command */
4610 Vthis_command = leaf;
4611 /* Don't push an undo boundary if the command set the prefix arg,
4612 or if we are executing a keyboard macro, or if in the
4613 minibuffer. If the command we are about to execute is
4614 self-insert, it's tricky: up to 20 consecutive self-inserts may
4615 be done without an undo boundary. This counter is reset as
4616 soon as a command other than self-insert-command is executed.
4618 if (! EQ (leaf, Qself_insert_command))
4619 command_builder->self_insert_countdown = 0;
4620 if (NILP (XCONSOLE (console)->prefix_arg)
4621 && NILP (Vexecuting_macro)
4623 /* This was done in the days when there was no undo
4624 in the minibuffer. If we don't disable this code,
4625 then each instance of "undo" undoes everything in
4627 && !EQ (minibuf_window, Fselected_window (Qnil))
4629 && command_builder->self_insert_countdown == 0)
4632 if (EQ (leaf, Qself_insert_command))
4634 if (--command_builder->self_insert_countdown < 0)
4635 command_builder->self_insert_countdown = 20;
4637 execute_command_event
4639 internal_equal (event, command_builder-> most_current_event, 0)
4641 /* Use the translated event that was most recently seen.
4642 This way, last-command-event becomes f1 instead of
4643 the P from ESC O P. But we must copy it, else we'll
4644 lose when the command-builder events are deallocated. */
4645 : Fcopy_event (command_builder-> most_current_event, Qnil));
4649 case misc_user_event:
4653 We could just always use the menu item entry, whatever it is, but
4654 this might break some Lisp code that expects `this-command' to
4655 always contain a symbol. So only store it if this is a simple
4656 `call-interactively' sort of menu item.
4658 But this is bogus. `this-command' could be a string or vector
4659 anyway (for keyboard macros). There's even one instance
4660 (in pending-del.el) of `this-command' getting set to a cons
4661 (a lambda expression). So in the `eval' case I'll just
4662 convert it into a lambda expression.
4664 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4665 && SYMBOLP (XEVENT (event)->event.eval.object))
4666 Vthis_command = XEVENT (event)->event.eval.object;
4667 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4669 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4670 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4671 /* A scrollbar command or the like. */
4672 Vthis_command = XEVENT (event)->event.eval.function;
4675 Vthis_command = Qnil;
4677 /* clear the echo area */
4678 reset_key_echo (command_builder, 1);
4680 command_builder->self_insert_countdown = 0;
4681 if (NILP (XCONSOLE (console)->prefix_arg)
4682 && NILP (Vexecuting_macro)
4683 && !EQ (minibuf_window, Fselected_window (Qnil)))
4685 execute_command_event (command_builder, event);
4690 execute_internal_event (event);
4697 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4698 Read a sequence of keystrokes or mouse clicks.
4699 Returns a vector of the event objects read. The vector and the event
4700 objects it contains are freshly created (and will not be side-effected
4701 by subsequent calls to this function).
4703 The sequence read is sufficient to specify a non-prefix command starting
4704 from the current local and global keymaps. A C-g typed while in this
4705 function is treated like any other character, and `quit-flag' is not set.
4707 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4708 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4709 as a continuation of the previous key.
4711 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4712 convert the last event to lower case. (Normally any upper case event
4713 is converted to lower case if the original event is undefined and the lower
4714 case equivalent is defined.) This argument is provided mostly for
4715 FSF compatibility; the equivalent effect can be achieved more generally
4716 by binding `retry-undefined-key-binding-unshifted' to nil around the
4717 call to `read-key-sequence'.
4719 A C-g typed while in this function is treated like any other character,
4720 and `quit-flag' is not set.
4722 If the user selects a menu item while we are prompting for a key-sequence,
4723 the returned value will be a vector of a single menu-selection event.
4724 An error will be signalled if you pass this value to `lookup-key' or a
4727 `read-key-sequence' checks `function-key-map' for function key
4728 sequences, where they wouldn't conflict with ordinary bindings. See
4729 `function-key-map' for more details.
4731 (prompt, continue_echo, dont_downcase_last))
4733 /* This function can GC */
4734 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4738 struct command_builder *command_builder =
4739 XCOMMAND_BUILDER (con->command_builder);
4741 Lisp_Object event = Fmake_event (Qnil, Qnil);
4742 int speccount = specpdl_depth ();
4743 struct gcpro gcpro1;
4747 CHECK_STRING (prompt);
4748 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4751 if (NILP (continue_echo))
4752 reset_this_command_keys (make_console (con), 1);
4754 specbind (Qinhibit_quit, Qt);
4756 if (!NILP (dont_downcase_last))
4757 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4761 Fnext_event (event, prompt);
4762 /* restore the selected-console damage */
4763 con = event_console_or_selected (event);
4764 command_builder = XCOMMAND_BUILDER (con->command_builder);
4765 if (! command_event_p (event))
4766 execute_internal_event (event);
4769 if (XEVENT (event)->event_type == misc_user_event)
4770 reset_current_events (command_builder);
4771 result = lookup_command_event (command_builder, event, 1);
4772 if (!KEYMAPP (result))
4774 result = current_events_into_vector (command_builder);
4775 reset_key_echo (command_builder, 0);
4782 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4783 Fdeallocate_event (event);
4784 RETURN_UNGCPRO (unbind_to (speccount, result));
4787 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4788 Return a vector of the keyboard or mouse button events that were used
4789 to invoke this command. This copies the vector and the events; it is safe
4790 to keep and modify them.
4798 if (NILP (Vthis_command_keys))
4799 return make_vector (0, Qnil);
4801 len = event_chain_count (Vthis_command_keys);
4803 result = make_vector (len, Qnil);
4805 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4806 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4810 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4811 Used for complicated reasons in `universal-argument-other-key'.
4813 `universal-argument-other-key' rereads the event just typed.
4814 It then gets translated through `function-key-map'.
4815 The translated event gets included in the echo area and in
4816 the value of `this-command-keys' in addition to the raw original event.
4819 Calling this function directs the translated event to replace
4820 the original event, so that only one version of the event actually
4821 appears in the echo area and in the value of `this-command-keys.'.
4825 /* #### I don't understand this at all, so currently it does nothing.
4826 If there is ever a problem, maybe someone should investigate. */
4832 dribble_out_event (Lisp_Object event)
4834 if (NILP (Vdribble_file))
4837 if (XEVENT (event)->event_type == key_press_event &&
4838 !XEVENT (event)->event.key.modifiers)
4840 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4841 if (CHARP (XEVENT (event)->event.key.keysym))
4843 Emchar ch = XCHAR (keysym);
4844 Bufbyte str[MAX_EMCHAR_LEN];
4847 len = set_charptr_emchar (str, ch);
4848 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4850 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4851 /* one-char key events are printed with just the key name */
4852 Fprinc (keysym, Vdribble_file);
4853 else if (EQ (keysym, Qreturn))
4854 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4855 else if (EQ (keysym, Qspace))
4856 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4858 Fprinc (event, Vdribble_file);
4861 Fprinc (event, Vdribble_file);
4862 Lstream_flush (XLSTREAM (Vdribble_file));
4865 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4866 "FOpen dribble file: ", /*
4867 Start writing all keyboard characters to a dribble file called FILE.
4868 If FILE is nil, close any open dribble file.
4872 /* This function can GC */
4873 /* XEmacs change: always close existing dribble file. */
4874 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4875 if (!NILP (Vdribble_file))
4877 Lstream_close (XLSTREAM (Vdribble_file));
4878 Vdribble_file = Qnil;
4884 file = Fexpand_file_name (file, Qnil);
4885 fd = open ((char*) XSTRING_DATA (file),
4886 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4889 error ("Unable to create dribble file");
4890 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4893 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4894 Fget_coding_system (Qescape_quoted));
4901 /************************************************************************/
4902 /* initialization */
4903 /************************************************************************/
4906 syms_of_event_stream (void)
4908 defsymbol (&Qdisabled, "disabled");
4909 defsymbol (&Qcommand_event_p, "command-event-p");
4911 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
4912 "Undefined keystroke sequence", Qerror);
4913 defsymbol (&Qcommand_execute, "command-execute");
4915 DEFSUBR (Frecent_keys);
4916 DEFSUBR (Frecent_keys_ring_size);
4917 DEFSUBR (Fset_recent_keys_ring_size);
4918 DEFSUBR (Finput_pending_p);
4919 DEFSUBR (Fenqueue_eval_event);
4920 DEFSUBR (Fnext_event);
4921 DEFSUBR (Fnext_command_event);
4922 DEFSUBR (Fdiscard_input);
4924 DEFSUBR (Fsleep_for);
4925 DEFSUBR (Faccept_process_output);
4926 DEFSUBR (Fadd_timeout);
4927 DEFSUBR (Fdisable_timeout);
4928 DEFSUBR (Fadd_async_timeout);
4929 DEFSUBR (Fdisable_async_timeout);
4930 DEFSUBR (Fdispatch_event);
4931 DEFSUBR (Fread_key_sequence);
4932 DEFSUBR (Fthis_command_keys);
4933 DEFSUBR (Freset_this_command_lengths);
4934 DEFSUBR (Fopen_dribble_file);
4935 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
4936 DEFSUBR (Faccelerate_menu);
4939 defsymbol (&Qpre_command_hook, "pre-command-hook");
4940 defsymbol (&Qpost_command_hook, "post-command-hook");
4941 defsymbol (&Qunread_command_events, "unread-command-events");
4942 defsymbol (&Qunread_command_event, "unread-command-event");
4943 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4944 #ifdef ILL_CONCEIVED_HOOK
4945 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4947 #ifdef DEFERRED_ACTION_CRAP
4948 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4950 defsymbol (&Qretry_undefined_key_binding_unshifted,
4951 "retry-undefined-key-binding-unshifted");
4952 defsymbol (&Qauto_show_make_point_visible,
4953 "auto-show-make-point-visible");
4955 defsymbol (&Qmenu_force, "menu-force");
4956 defsymbol (&Qmenu_fallback, "menu-fallback");
4958 defsymbol (&Qmenu_quit, "menu-quit");
4959 defsymbol (&Qmenu_up, "menu-up");
4960 defsymbol (&Qmenu_down, "menu-down");
4961 defsymbol (&Qmenu_left, "menu-left");
4962 defsymbol (&Qmenu_right, "menu-right");
4963 defsymbol (&Qmenu_select, "menu-select");
4964 defsymbol (&Qmenu_escape, "menu-escape");
4966 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4970 vars_of_event_stream (void)
4972 #ifdef HAVE_X_WINDOWS
4973 vars_of_event_Xt ();
4975 #if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS))
4976 vars_of_event_tty ();
4978 #ifdef HAVE_MS_WINDOWS
4979 vars_of_event_mswindows ();
4982 recent_keys_ring_index = 0;
4983 recent_keys_ring_size = 100;
4984 Vrecent_keys_ring = Qnil;
4985 staticpro (&Vrecent_keys_ring);
4987 Vthis_command_keys = Qnil;
4988 staticpro (&Vthis_command_keys);
4989 Vthis_command_keys_tail = Qnil;
4991 num_input_chars = 0;
4993 command_event_queue = Qnil;
4994 staticpro (&command_event_queue);
4995 command_event_queue_tail = Qnil;
4997 Vlast_selected_frame = Qnil;
4998 staticpro (&Vlast_selected_frame);
5000 pending_timeout_list = Qnil;
5001 staticpro (&pending_timeout_list);
5003 pending_async_timeout_list = Qnil;
5004 staticpro (&pending_async_timeout_list);
5006 Vtimeout_free_list = make_opaque_list (sizeof (struct timeout),
5008 staticpro (&Vtimeout_free_list);
5010 the_low_level_timeout_blocktype =
5011 Blocktype_new (struct low_level_timeout_blocktype);
5013 something_happened = 0;
5015 last_point_position_buffer = Qnil;
5016 staticpro (&last_point_position_buffer);
5018 recursive_sit_for = Qnil;
5020 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
5021 *Nonzero means echo unfinished commands after this many seconds of pause.
5023 Vecho_keystrokes = make_int (1);
5025 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
5026 *Number of keyboard input characters between auto-saves.
5027 Zero means disable autosaving due to number of characters typed.
5028 See also the variable `auto-save-timeout'.
5030 auto_save_interval = 300;
5032 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
5033 Function or functions to run before every command.
5034 This may examine the `this-command' variable to find out what command
5035 is about to be run, or may change it to cause a different command to run.
5036 Function on this hook must be careful to avoid signalling errors!
5038 Vpre_command_hook = Qnil;
5040 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
5041 Function or functions to run after every command.
5042 This may examine the `this-command' variable to find out what command
5045 Vpost_command_hook = Qnil;
5047 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
5048 Normal hook run when XEmacs it about to be idle.
5049 This occurs whenever it is going to block, waiting for an event.
5050 This generally happens as a result of a call to `next-event',
5051 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
5052 `x-get-selection', or various Energize-specific commands.
5053 Errors running the hook are caught and ignored.
5055 Vpre_idle_hook = Qnil;
5057 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
5058 *Variable to control XEmacs behavior with respect to focus changing.
5059 If this variable is set to t, then XEmacs will not gratuitously change
5060 the keyboard focus. XEmacs cannot in general detect when this mode is
5061 use by the window manager, so it is up to the user to set it.
5063 focus_follows_mouse = 0;
5065 #ifdef ILL_CONCEIVED_HOOK
5066 /* Ill-conceived because it's not run in all sorts of cases
5067 where XEmacs is blocking. That's what `pre-idle-hook'
5068 is designed to solve. */
5069 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
5070 Normal hook run after each command is executed, if idle.
5071 `post-command-idle-delay' specifies a time in microseconds that XEmacs
5072 must be idle for in order for the functions on this hook to be called.
5073 Errors running the hook are caught and ignored.
5075 Vpost_command_idle_hook = Qnil;
5077 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
5078 Delay time before running `post-command-idle-hook'.
5079 This is measured in microseconds.
5081 post_command_idle_delay = 5000;
5082 #endif /* ILL_CONCEIVED_HOOK */
5084 #ifdef DEFERRED_ACTION_CRAP
5085 /* Random FSFmacs crap. There is absolutely nothing to gain,
5086 and a great deal to lose, in using this in place of just
5087 setting `post-command-hook'. */
5088 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
5089 List of deferred actions to be performed at a later time.
5090 The precise format isn't relevant here; we just check whether it is nil.
5092 Vdeferred_action_list = Qnil;
5094 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
5095 Function to call to handle deferred actions, after each command.
5096 This function is called with no arguments after each command
5097 whenever `deferred-action-list' is non-nil.
5099 Vdeferred_action_function = Qnil;
5100 #endif /* DEFERRED_ACTION_CRAP */
5102 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
5103 Last keyboard or mouse button event that was part of a command. This
5104 variable is off limits: you may not set its value or modify the event that
5105 is its value, as it is destructively modified by `read-key-sequence'. If
5106 you want to keep a pointer to this value, you must use `copy-event'.
5108 Vlast_command_event = Qnil;
5110 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
5111 If the value of `last-command-event' is a keyboard event, then
5112 this is the nearest ASCII equivalent to it. This is the value that
5113 `self-insert-command' will put in the buffer. Remember that there is
5114 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5115 of keyboard events is much larger, so writing code that examines this
5116 variable to determine what key has been typed is bad practice, unless
5117 you are certain that it will be one of a small set of characters.
5119 Vlast_command_char = Qnil;
5121 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
5122 Last keyboard or mouse button event received. This variable is off
5123 limits: you may not set its value or modify the event that is its value, as
5124 it is destructively modified by `next-event'. If you want to keep a pointer
5125 to this value, you must use `copy-event'.
5127 Vlast_input_event = Qnil;
5129 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
5130 The mouse-button event which invoked this command, or nil.
5131 This is usually what `(interactive "e")' returns.
5133 Vcurrent_mouse_event = Qnil;
5135 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
5136 If the value of `last-input-event' is a keyboard event, then
5137 this is the nearest ASCII equivalent to it. Remember that there is
5138 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5139 of keyboard events is much larger, so writing code that examines this
5140 variable to determine what key has been typed is bad practice, unless
5141 you are certain that it will be one of a small set of characters.
5143 Vlast_input_char = Qnil;
5145 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
5146 The time (in seconds since Jan 1, 1970) of the last-command-event,
5147 represented as a cons of two 16-bit integers. This is destructively
5148 modified, so copy it if you want to keep it.
5150 Vlast_input_time = Qnil;
5152 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
5153 The time (in seconds since Jan 1, 1970) of the last-command-event,
5154 represented as a list of three integers. The first integer contains
5155 the most significant 16 bits of the number of seconds, and the second
5156 integer contains the least significant 16 bits. The third integer
5157 contains the remainder number of microseconds, if the current system
5158 supports microsecond clock resolution. This list is destructively
5159 modified, so copy it if you want to keep it.
5161 Vlast_command_event_time = Qnil;
5163 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
5164 List of event objects to be read as next command input events.
5165 This can be used to simulate the receipt of events from the user.
5166 Normally this is nil.
5167 Events are removed from the front of this list.
5169 Vunread_command_events = Qnil;
5171 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
5172 Obsolete. Use `unread-command-events' instead.
5174 Vunread_command_event = Qnil;
5176 DEFVAR_LISP ("last-command", &Vlast_command /*
5177 The last command executed. Normally a symbol with a function definition,
5178 but can be whatever was found in the keymap, or whatever the variable
5179 `this-command' was set to by that command.
5181 Vlast_command = Qnil;
5183 DEFVAR_LISP ("this-command", &Vthis_command /*
5184 The command now being executed.
5185 The command can set this variable; whatever is put here
5186 will be in `last-command' during the following command.
5188 Vthis_command = Qnil;
5190 DEFVAR_LISP ("help-char", &Vhelp_char /*
5191 Character to recognize as meaning Help.
5192 When it is read, do `(eval help-form)', and display result if it's a string.
5193 If the value of `help-form' is nil, this char can be read normally.
5194 This can be any form recognized as a single key specifier.
5195 The help-char cannot be a negative number in XEmacs.
5197 Vhelp_char = make_char (8); /* C-h */
5199 DEFVAR_LISP ("help-form", &Vhelp_form /*
5200 Form to execute when character help-char is read.
5201 If the form returns a string, that string is displayed.
5202 If `help-form' is nil, the help char is not recognized.
5206 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
5207 Command to run when `help-char' character follows a prefix key.
5208 This command is used only when there is no actual binding
5209 for that character after that prefix key.
5211 Vprefix_help_command = Qnil;
5213 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
5214 Hash table used as translate table for keyboard input.
5215 Use `keyboard-translate' to portably add entries to this table.
5216 Each key-press event is looked up in this table as follows:
5218 -- If an entry maps a symbol to a symbol, then a key-press event whose
5219 keysym is the former symbol (with any modifiers at all) gets its
5220 keysym changed and its modifiers left alone. This is useful for
5221 dealing with non-standard X keyboards, such as the grievous damage
5222 that Sun has inflicted upon the world.
5223 -- If an entry maps a character to a character, then a key-press event
5224 matching the former character gets converted to a key-press event
5225 matching the latter character. This is useful on ASCII terminals
5226 for (e.g.) making C-\\ look like C-s, to get around flow-control
5228 -- If an entry maps a character to a symbol, then a key-press event
5229 matching the character gets converted to a key-press event whose
5230 keysym is the given symbol and which has no modifiers.
5233 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
5234 &Vretry_undefined_key_binding_unshifted /*
5235 If a key-sequence which ends with a shifted keystroke is undefined
5236 and this variable is non-nil then the command lookup is retried again
5237 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
5238 If lookup still fails, a normal error is signalled. In general,
5239 you should *bind* this, not set it.
5241 Vretry_undefined_key_binding_unshifted = Qt;
5244 DEFVAR_LISP ("composed-character-default-binding",
5245 &Vcomposed_character_default_binding /*
5246 The default keybinding to use for key events from composed input.
5247 Window systems frequently have ways to allow the user to compose
5248 single characters in a language using multiple keystrokes.
5249 XEmacs sees these as single character keypress events.
5251 Vcomposed_character_default_binding = Qself_insert_command;
5252 #endif /* HAVE_XIM */
5254 Vcontrolling_terminal = Qnil;
5255 staticpro (&Vcontrolling_terminal);
5257 Vdribble_file = Qnil;
5258 staticpro (&Vdribble_file);
5261 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
5262 If non-zero, display debug information about Emacs events that XEmacs sees.
5263 Information is displayed on stderr.
5265 Before the event, the source of the event is displayed in parentheses,
5266 and is one of the following:
5268 \(real) A real event from the window system or
5269 terminal driver, as far as XEmacs can tell.
5271 \(keyboard macro) An event generated from a keyboard macro.
5273 \(unread-command-events) An event taken from `unread-command-events'.
5275 \(unread-command-event) An event taken from `unread-command-event'.
5277 \(command event queue) An event taken from an internal queue.
5278 Events end up on this queue when
5279 `enqueue-eval-event' is called or when
5280 user or eval events are received while
5281 XEmacs is blocking (e.g. in `sit-for',
5282 `sleep-for', or `accept-process-output',
5283 or while waiting for the reply to an
5286 \(->keyboard-translate-table) The result of an event translated through
5287 keyboard-translate-table. Note that in
5288 this case, two events are printed even
5289 though only one is really generated.
5291 \(SIGINT) A faked C-g resulting when XEmacs receives
5292 a SIGINT (e.g. C-c was pressed in XEmacs'
5293 controlling terminal or the signal was
5294 explicitly sent to the XEmacs process).
5296 debug_emacs_events = 0;
5299 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
5300 Non-nil inhibits recording of input-events to recent-keys ring.
5302 inhibit_input_event_recording = 0;
5304 DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /*
5305 Prefix key(s) that must be typed before menu accelerators will be activated.
5306 Set this to a value acceptable by define-key.
5308 Vmenu_accelerator_prefix = Qnil;
5310 DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /*
5311 Modifier keys which must be pressed to get to the top level menu accelerators.
5312 This is a list of modifier key symbols. All modifier keys must be held down
5313 while a valid menu accelerator key is pressed in order for the top level
5314 menu to become active.
5316 See also menu-accelerator-enabled and menu-accelerator-prefix.
5318 Vmenu_accelerator_modifiers = list1 (Qmeta);
5320 DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /*
5321 Whether menu accelerator keys can cause the menubar to become active.
5322 If 'menu-force or 'menu-fallback, then menu accelerator keys can
5323 be used to activate the top level menu. Once the menubar becomes active, the
5324 accelerator keys can be used regardless of the value of this variable.
5326 menu-force is used to indicate that the menu accelerator key takes
5327 precedence over bindings in the current keymap(s). menu-fallback means
5328 that bindings in the current keymap take precedence over menu accelerator keys.
5329 Thus a top level menu with an accelerator of "T" would be activated on a
5330 keypress of Meta-t if menu-accelerator-enabled is menu-force.
5331 However, if menu-accelerator-enabled is menu-fallback, then
5332 Meta-t will not activate the menubar and will instead run the function
5333 transpose-words, to which it is normally bound.
5335 See also menu-accelerator-modifiers and menu-accelerator-prefix.
5337 Vmenu_accelerator_enabled = Qnil;
5341 complex_vars_of_event_stream (void)
5343 Vkeyboard_translate_table = Fmake_hashtable (make_int (100), Qnil);
5345 DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
5346 Keymap for use when the menubar is active.
5347 The actions menu-quit, menu-up, menu-down, menu-left, menu-right,
5348 menu-select and menu-escape can be mapped to keys in this map.
5350 menu-quit Immediately deactivate the menubar and any open submenus without
5352 menu-up Move the menu cursor up one row in the current menu. If the
5353 move extends past the top of the menu, wrap around to the bottom.
5354 menu-down Move the menu cursor down one row in the current menu. If the
5355 move extends past the bottom of the menu, wrap around to the top.
5356 If executed while the cursor is in the top level menu, move down
5357 into the selected menu.
5358 menu-left Move the cursor from a submenu into the parent menu. If executed
5359 while the cursor is in the top level menu, move the cursor to the
5360 left. If the move extends past the left edge of the menu, wrap
5361 around to the right edge.
5362 menu-right Move the cursor into a submenu. If the cursor is located in the
5363 top level menu or is not currently on a submenu heading, then move
5364 the cursor to the next top level menu entry. If the move extends
5365 past the right edge of the menu, wrap around to the left edge.
5366 menu-select Activate the item under the cursor. If the cursor is located on
5367 a submenu heading, then move the cursor into the submenu.
5368 menu-escape Pop up to the next level of menus. Moves from a submenu into its
5369 parent menu. From the top level menu, this deactivates the
5372 This keymap can also contain normal key-command bindings, in which case the
5373 menubar is deactivated and the corresponding command is executed.
5375 The action bindings used by the menu accelerator code are designed to mimic
5376 the actions of menu traversal keys in a commonly used PC operating system.
5378 Vmenu_accelerator_map = Fmake_keymap(Qnil);
5382 init_event_stream (void)
5386 #ifdef HAVE_UNIXOID_EVENT_LOOP
5387 /* if (strcmp (display_use, "mswindows") != 0)*/
5388 init_event_unixoid ();
5390 #ifdef HAVE_X_WINDOWS
5391 if (!strcmp (display_use, "x"))
5392 init_event_Xt_late ();
5395 #ifdef HAVE_MS_WINDOWS
5396 if (!strcmp (display_use, "mswindows"))
5397 init_event_mswindows_late ();
5401 /* For TTY's, use the Xt event loop if we can; it allows
5402 us to later open an X connection. */
5403 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5404 init_event_Xt_late ();
5405 #elif defined (HAVE_TTY)
5406 init_event_tty_late ();
5407 #elif defined (HAVE_MS_WINDOWS)
5408 init_event_mswindows_late ();
5411 init_interrupts_late ();
5417 useful testcases for v18/v19 compatibility:
5421 (setq unread-command-event (character-to-event ?A (allocate-event)))
5422 (setq x (list (read-char)
5423 ; (read-key-sequence "") ; try it with and without this
5424 last-command-char last-input-char
5425 (recent-keys) (this-command-keys))))
5426 (global-set-key "\^Q" 'foo)
5428 without the read-key-sequence:
5429 ^Q ==> (65 17 65 [... ^Q] [^Q])
5430 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
5431 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
5433 with the read-key-sequence:
5434 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
5435 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
5436 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
5438 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5440 ;(setq x (list (read-char) quit-flag))^J^G
5441 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5442 ;for BOTH, x should get set to (7 t), but no result should be printed.
5444 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5445 ;in *scratch*, type (sit-for 20)^J
5446 ;wait a couple of seconds, move cursor to foo, type "a"
5447 ;a should be inserted in foo. Cursor highlighting should not change in
5450 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5452 ;repeat also with (accept-process-output nil 20)
5454 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5457 (list (condition-case c
5462 (tst)^Ja^G ==> ((quit) 97) with no signal
5463 (tst)^J^Ga ==> ((quit) 97) with no signal
5464 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
5466 ; with sit-for only do the 2nd test.
5467 ; Do all 3 tests with (accept-proccess-output nil 20)
5470 (setq enable-recursive-minibuffers t
5471 minibuffer-max-depth nil)
5472 ESC ESC ESC ESC - there are now two minibuffers active
5473 C-g C-g C-g - there should be active 0, not 1
5475 C-x C-f ~ / ? - wait for "Making completion list..." to display
5476 C-g - wait for "Quit" to display
5477 C-g - minibuffer should not be active
5478 however C-g before "Quit" is displayed should leave minibuffer active.
5480 ;do it all in both v18 and v19 and make sure all results are the same.
5481 ;all of these cases matter a lot, but some in quite subtle ways.
5485 Additional test cases for accept-process-output, sleep-for, sit-for.
5486 Be sure you do all of the above checking for C-g and focus, too!
5488 ; Make sure that timer handlers are run during, not after sit-for:
5489 (defun timer-check ()
5490 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5492 (message "after sit-for"))
5494 ; The first message should appear after 2 seconds, and the final message
5495 ; 3 seconds after that.
5496 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5500 ; Make sure that process filters are run during, not after sit-for.
5502 (message "sit-for = %s" (sit-for 30)))
5503 (add-hook 'post-command-hook 'fubar)
5505 ; Now type M-x shell RET
5506 ; wait for the shell prompt then send: ls RET
5507 ; the output of ls should fill immediately, and not wait 30 seconds.
5509 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5513 ; Make sure that recursive invocations return immediately:
5514 (defmacro test-diff-time (start end)
5515 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5516 (- (cadr ,end) (cadr ,start))
5517 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5519 (defun testee (ignore)
5523 (let ((start (current-time))
5525 (add-timeout 2 'testee nil)
5527 (add-timeout 2 'testee nil)
5529 (add-timeout 2 'testee nil)
5530 (accept-process-output nil 5)
5531 (setq end (current-time))
5532 (test-diff-time start end)))
5534 (test-them) should sit for 15 seconds.
5535 Repeat with testee set to sleep-for and accept-process-output.
5536 These should each delay 36 seconds.