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 universal-argument and figure out how an
51 arbitrary command can influence the next command (universal-argument
52 or universal-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 auxiliary 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 (!HASH_TABLEP (Vkeyboard_translate_table))
786 if (EQ (Fhash_table_count (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 (build_string ("*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));
2327 /* If this key came from the keyboard or from a keyboard macro, then
2328 it goes into the recent-keys and this-command-keys vectors.
2329 If this key came from the keyboard, and we're defining a keyboard
2330 macro, then it goes into the macro.
2334 push_this_command_keys (event);
2335 if (!inhibit_input_event_recording)
2336 push_recent_keys (event);
2337 dribble_out_event (event);
2338 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2340 if (!EVENTP (command_builder->current_events))
2341 finalize_kbd_macro_chars (con);
2342 store_kbd_macro_event (event);
2345 /* If this is the help char and there is a help form, then execute the
2346 help form and swallow this character. This is the only place where
2347 calling Fnext_event() can cause arbitrary lisp code to run. Note
2348 that execute_help_form() calls Fnext_command_event(), which calls
2349 this function, as well as Fdispatch_event.
2351 if (!NILP (Vhelp_form) &&
2352 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2353 execute_help_form (command_builder, event);
2360 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2361 Return the next available "user" event.
2362 Pass this object to `dispatch-event' to handle it.
2364 If EVENT is non-nil, it should be an event object and will be filled in
2365 and returned; otherwise a new event object will be created and returned.
2366 If PROMPT is non-nil, it should be a string and will be displayed in the
2367 echo area while this function is waiting for an event.
2369 The event returned will be a keyboard, mouse press, or mouse release event.
2370 If there are non-command events available (mouse motion, sub-process output,
2371 etc) then these will be executed (with `dispatch-event') and discarded. This
2372 function is provided as a convenience; it is roughly equivalent to the lisp code
2375 (next-event event prompt)
2376 (not (or (key-press-event-p event)
2377 (button-press-event-p event)
2378 (button-release-event-p event)
2379 (misc-user-event-p event))))
2380 (dispatch-event event))
2382 but it also makes a provision for displaying keystrokes in the echo area.
2386 /* This function can GC */
2387 struct gcpro gcpro1;
2389 maybe_echo_keys (XCOMMAND_BUILDER
2390 (XCONSOLE (Vselected_console)->
2391 command_builder), 0); /* #### This sucks bigtime */
2394 event = Fnext_event (event, prompt);
2395 if (command_event_p (event))
2398 execute_internal_event (event);
2405 reset_current_events (struct command_builder *command_builder)
2407 Lisp_Object event = command_builder->current_events;
2408 reset_command_builder_event_chain (command_builder);
2410 deallocate_event_chain (event);
2413 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2414 Discard any pending "user" events.
2415 Also cancel any kbd macro being defined.
2416 A user event is a key press, button press, button release, or
2417 "misc-user" event (menu selection or scrollbar action).
2421 /* This throws away user-input on the queue, but doesn't process any
2422 events. Calling dispatch_event() here leads to a race condition.
2424 Lisp_Object event = Fmake_event (Qnil, Qnil);
2425 Lisp_Object head = Qnil, tail = Qnil;
2426 Lisp_Object oiq = Vinhibit_quit;
2427 struct gcpro gcpro1, gcpro2;
2428 /* #### not correct here with Vselected_console? Should
2429 discard-input take a console argument, or maybe map over
2431 struct console *con = XCONSOLE (Vselected_console);
2433 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2434 GCPRO2 (event, oiq);
2436 /* If a macro was being defined then we have to mark the modeline
2437 has changed to ensure that it gets updated correctly. */
2438 if (!NILP (con->defining_kbd_macro))
2439 MARK_MODELINE_CHANGED;
2440 con->defining_kbd_macro = Qnil;
2441 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2443 while (!NILP (command_event_queue)
2444 || event_stream_event_pending_p (1))
2446 /* This will take stuff off the command_event_queue, or read it
2447 from the event_stream, but it will not block.
2449 next_event_internal (event, 1);
2450 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2451 It is vitally important that we reset
2452 Vquit_flag here. Otherwise, if we're
2453 reading from a TTY console,
2454 maybe_read_quit_event() will notice
2455 that C-g has been set and send us
2456 another C-g. That will cause us
2457 to get right back here, and read
2458 another C-g, ad infinitum ... */
2460 /* If the event is a user event, ignore it. */
2461 if (!command_event_p (event))
2463 /* Otherwise, chain the event onto our list of events not to ignore,
2464 and keep reading until the queue is empty. This does not mean
2465 that if a subprocess is generating an infinite amount of output,
2466 we will never terminate (*provided* that the behavior of
2467 next_event_cb() is correct -- see the comment in events.h),
2468 because this loop ends as soon as there are no more user events
2469 on the command_event_queue or event_stream.
2471 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2475 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2478 /* Now tack our chain of events back on to the front of the queue.
2479 Actually, since the queue is now drained, we can just replace it.
2480 The effect of this will be that we have deleted all user events
2481 from the input stream without changing the relative ordering of
2482 any other events. (Some events may have been taken from the
2483 event_stream and added to the command_event_queue, however.)
2485 At this time, the command_event_queue will contain only eval_events.
2488 command_event_queue = head;
2489 command_event_queue_tail = tail;
2491 Fdeallocate_event (event);
2494 Vinhibit_quit = oiq;
2499 /**********************************************************************/
2500 /* pausing until an action occurs */
2501 /**********************************************************************/
2503 /* This is used in accept-process-output, sleep-for and sit-for.
2504 Before running any process_events in these routines, we set
2505 recursive_sit_for to Qt, and use this unwind protect to reset it to
2506 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2507 cause it to return immediately.
2509 All of these routines install timeouts, so we clear the installed
2512 Note: It's very easy to break the desired behaviors of these
2513 3 routines. If you make any changes to anything in this area, run
2514 the regression tests at the bottom of the file. -- dmoore */
2518 sit_for_unwind (Lisp_Object timeout_id)
2520 if (!NILP(timeout_id))
2521 Fdisable_timeout (timeout_id);
2523 recursive_sit_for = Qnil;
2527 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2530 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2531 Allow any pending output from subprocesses to be read by Emacs.
2532 It is read into the process' buffers or given to their filter functions.
2533 Non-nil arg PROCESS means do not return until some output has been received
2534 from PROCESS. Nil arg PROCESS means do not return until some output has
2535 been received from any process.
2536 If the second arg is non-nil, it is the maximum number of seconds to wait:
2537 this function will return after that much time even if no input has arrived
2538 from PROCESS. This argument may be a float, meaning wait some fractional
2540 If the third arg is non-nil, it is a number of milliseconds that is added
2541 to the second arg. (This exists only for compatibility.)
2542 Return non-nil iff we received any output before the timeout expired.
2544 (process, timeout_secs, timeout_msecs))
2546 /* This function can GC */
2547 struct gcpro gcpro1, gcpro2;
2548 Lisp_Object event = Qnil;
2549 Lisp_Object result = Qnil;
2550 int timeout_id = -1;
2551 int timeout_enabled = 0;
2553 struct buffer *old_buffer = current_buffer;
2556 /* We preserve the current buffer but nothing else. If a focus
2557 change alters the selected window then the top level event loop
2558 will eventually alter current_buffer to match. In the mean time
2559 we don't want to mess up whatever called this function. */
2561 if (!NILP (process))
2562 CHECK_PROCESS (process);
2564 GCPRO2 (event, process);
2566 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2568 unsigned long msecs = 0;
2569 if (!NILP (timeout_secs))
2570 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2571 if (!NILP (timeout_msecs))
2573 CHECK_NATNUM (timeout_msecs);
2574 msecs += XINT (timeout_msecs);
2578 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2579 timeout_enabled = 1;
2583 event = Fmake_event (Qnil, Qnil);
2585 count = specpdl_depth ();
2586 record_unwind_protect (sit_for_unwind,
2587 timeout_enabled ? make_int (timeout_id) : Qnil);
2588 recursive_sit_for = Qt;
2591 ((NILP (process) && timeout_enabled) ||
2592 (NILP (process) && event_stream_event_pending_p (0)) ||
2594 /* Calling detect_input_pending() is the wrong thing here, because
2595 that considers the Vunread_command_events and command_event_queue.
2596 We don't need to look at the command_event_queue because we are
2597 only interested in process events, which don't go on that. In
2598 fact, we can't read from it anyway, because we put stuff on it.
2600 Note that event_stream->event_pending_p must be called in such
2601 a way that it says whether any events *of any kind* are ready,
2602 not just user events, or (accept-process-output nil) will fail
2603 to dispatch any process events that may be on the queue. It is
2604 not clear to me that this is important, because the top-level
2605 loop will process it, and I don't think that there is ever a
2606 time when one calls accept-process-output with a nil argument
2607 and really need the processes to be handled. */
2609 /* If our timeout has arrived, we move along. */
2610 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2612 timeout_enabled = 0;
2613 done = 1; /* We're done. */
2614 continue; /* Don't call next_event_internal */
2617 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2618 before reading output from the process - this makes it
2619 less likely that the filter will actually be aborted.
2622 next_event_internal (event, 0);
2623 /* If C-g was pressed while we were waiting, Vquit_flag got
2624 set and next_event_internal() also returns C-g. When
2625 we enqueue the C-g below, it will get discarded. The
2626 next time through, QUIT will be called and will signal a quit. */
2627 switch (XEVENT_TYPE (event))
2631 if (NILP (process) ||
2632 EQ (XEVENT (event)->event.process.process, process))
2635 /* RMS's version always returns nil when proc is nil,
2636 and only returns t if input ever arrived on proc. */
2640 execute_internal_event (event);
2644 /* We execute the event even if it's ours, and notice that it's
2646 case pointer_motion_event:
2649 execute_internal_event (event);
2654 enqueue_command_event_1 (event);
2660 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2662 Fdeallocate_event (event);
2664 current_buffer = old_buffer;
2668 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2669 Pause, without updating display, for ARG seconds.
2670 ARG may be a float, meaning pause for some fractional part of a second.
2672 It is recommended that you never call sleep-for from inside of a process
2673 filter function or timer event (either synchronous or asynchronous).
2677 /* This function can GC */
2678 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2680 Lisp_Object event = Qnil;
2682 struct gcpro gcpro1;
2686 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2687 event = Fmake_event (Qnil, Qnil);
2689 count = specpdl_depth ();
2690 record_unwind_protect (sit_for_unwind, make_int (id));
2691 recursive_sit_for = Qt;
2695 /* If our timeout has arrived, we move along. */
2696 if (!event_stream_wakeup_pending_p (id, 0))
2699 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2700 before reading output from the process - this makes it
2701 less likely that the filter will actually be aborted.
2703 /* We're a generator of the command_event_queue, so we can't be a
2704 consumer as well. We don't care about command and eval-events
2707 next_event_internal (event, 0); /* blocks */
2708 /* See the comment in accept-process-output about Vquit_flag */
2709 switch (XEVENT_TYPE (event))
2712 /* We execute the event even if it's ours, and notice that it's
2715 case pointer_motion_event:
2718 execute_internal_event (event);
2723 enqueue_command_event_1 (event);
2729 unbind_to (count, make_int (id));
2730 Fdeallocate_event (event);
2735 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2736 Perform redisplay, then wait ARG seconds or until user input is available.
2737 ARG may be a float, meaning a fractional part of a second.
2738 Optional second arg non-nil means don't redisplay, just wait for input.
2739 Redisplay is preempted as always if user input arrives, and does not
2740 happen if input is available before it starts.
2741 Value is t if waited the full time with no input arriving.
2743 If sit-for is called from within a process filter function or timer
2744 event (either synchronous or asynchronous) it will return immediately.
2746 (seconds, nodisplay))
2748 /* This function can GC */
2749 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2750 Lisp_Object event, result;
2751 struct gcpro gcpro1;
2755 /* The unread-command-events count as pending input */
2756 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2759 /* If the command-builder already has user-input on it (not eval events)
2760 then that means we're done too.
2762 if (!NILP (command_event_queue))
2764 EVENT_CHAIN_LOOP (event, command_event_queue)
2766 if (command_event_p (event))
2771 /* If we're in a macro, or noninteractive, or early in temacs, then
2773 if (noninteractive || !NILP (Vexecuting_macro))
2776 /* Recursive call from a filter function or timeout handler. */
2777 if (!NILP(recursive_sit_for))
2779 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2781 run_pre_idle_hook ();
2788 /* Otherwise, start reading events from the event_stream.
2789 Do this loop at least once even if (sit-for 0) so that we
2790 redisplay when no input pending.
2793 event = Fmake_event (Qnil, Qnil);
2795 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2796 events get processed. The old (pre-19.12) code special-cased this
2797 and didn't generate a wakeup, but the resulting behavior was less than
2798 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2799 the E-Lisp universe. */
2801 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2803 count = specpdl_depth ();
2804 record_unwind_protect (sit_for_unwind, make_int (id));
2805 recursive_sit_for = Qt;
2809 /* If there is no user input pending, then redisplay.
2811 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2813 run_pre_idle_hook ();
2817 /* If our timeout has arrived, we move along. */
2818 if (!event_stream_wakeup_pending_p (id, 0))
2824 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2825 before reading output from the process - this makes it
2826 less likely that the filter will actually be aborted.
2828 /* We're a generator of the command_event_queue, so we can't be a
2829 consumer as well. In fact, we know there's nothing on the
2830 command_event_queue that we didn't just put there.
2832 next_event_internal (event, 0); /* blocks */
2833 /* See the comment in accept-process-output about Vquit_flag */
2835 if (command_event_p (event))
2837 QUIT; /* If the command was C-g check it here
2838 so that we abort out of the sit-for,
2839 not the next command. sleep-for and
2840 accept-process-output continue looping
2841 so they check QUIT again implicitly.*/
2845 switch (XEVENT_TYPE (event))
2849 /* eval-events get delayed until later. */
2850 enqueue_command_event (Fcopy_event (event, Qnil));
2855 /* We execute the event even if it's ours, and notice that it's
2859 execute_internal_event (event);
2866 unbind_to (count, make_int (id));
2868 /* Put back the event (if any) that made Fsit_for() exit before the
2869 timeout. Note that it is being added to the back of the queue, which
2870 would be inappropriate if there were any user events on the queue
2871 already: we would be misordering them. But we know that there are
2872 no user-events on the queue, or else we would not have reached this
2876 enqueue_command_event (event);
2878 Fdeallocate_event (event);
2884 /* This handy little function is used by xselect.c and energize.c to
2885 wait for replies from processes that aren't really processes (that is,
2886 the X server and the Energize server).
2889 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2891 /* This function can GC */
2892 Lisp_Object event = Fmake_event (Qnil, Qnil);
2893 struct gcpro gcpro1;
2896 while (!(*predicate) (predicate_arg))
2898 QUIT; /* next_event_internal() does not QUIT. */
2900 /* We're a generator of the command_event_queue, so we can't be a
2901 consumer as well. Also, we have no reason to consult the
2902 command_event_queue; there are only user and eval-events there,
2903 and we'd just have to put them back anyway.
2905 next_event_internal (event, 0);
2906 /* See the comment in accept-process-output about Vquit_flag */
2907 if (command_event_p (event)
2908 || (XEVENT_TYPE (event) == eval_event)
2909 || (XEVENT_TYPE (event) == magic_eval_event))
2910 enqueue_command_event_1 (event);
2912 execute_internal_event (event);
2918 /**********************************************************************/
2919 /* dispatching events; command builder */
2920 /**********************************************************************/
2923 execute_internal_event (Lisp_Object event)
2925 /* events on dead channels get silently eaten */
2926 if (object_dead_p (XEVENT (event)->channel))
2929 /* This function can GC */
2930 switch (XEVENT_TYPE (event))
2937 call1 (XEVENT (event)->event.eval.function,
2938 XEVENT (event)->event.eval.object);
2942 case magic_eval_event:
2944 (XEVENT (event)->event.magic_eval.internal_function)
2945 (XEVENT (event)->event.magic_eval.object);
2949 case pointer_motion_event:
2951 if (!NILP (Vmouse_motion_handler))
2952 call1 (Vmouse_motion_handler, event);
2958 Lisp_Object p = XEVENT (event)->event.process.process;
2959 Charcount readstatus;
2961 assert (PROCESSP (p));
2962 while ((readstatus = read_process_output (p)) > 0)
2965 ; /* this clauses never gets executed but allows the #ifdefs
2968 else if (readstatus == -1 && errno == EWOULDBLOCK)
2970 #endif /* EWOULDBLOCK */
2972 else if (readstatus == -1 && errno == EAGAIN)
2975 else if ((readstatus == 0 &&
2976 /* Note that we cannot distinguish between no input
2977 available now and a closed pipe.
2978 With luck, a closed pipe will be accompanied by
2979 subprocess termination and SIGCHLD. */
2980 (!network_connection_p (p) ||
2982 When connected to ToolTalk (i.e.
2983 connected_via_filedesc_p()), it's not possible to
2984 reliably determine whether there is a message
2985 waiting for ToolTalk to receive. ToolTalk expects
2986 to have tt_message_receive() called exactly once
2987 every time the file descriptor becomes active, so
2988 the filter function forces this by returning 0.
2989 Emacs must not interpret this as a closed pipe. */
2990 connected_via_filedesc_p (XPROCESS (p))))
2992 /* On some OSs with ptys, when the process on one end of
2993 a pty exits, the other end gets an error reading with
2994 errno = EIO instead of getting an EOF (0 bytes read).
2995 Therefore, if we get an error reading and errno =
2996 EIO, just continue, because the child process has
2997 exited and should clean itself up soon (e.g. when we
2999 || (readstatus == -1 && errno == EIO)
3003 /* Currently, we rely on SIGCHLD to indicate that the
3004 process has terminated. Unfortunately, on some systems
3005 the SIGCHLD gets missed some of the time. So we put an
3006 additional check in status_notify() to see whether a
3007 process has terminated. We must tell status_notify()
3008 to enable that check, and we do so now. */
3009 kick_status_notify ();
3013 /* Deactivate network connection */
3014 Lisp_Object status = Fprocess_status (p);
3015 if (EQ (status, Qopen)
3016 /* In case somebody changes the theory of whether to
3017 return open as opposed to run for network connection
3019 || EQ (status, Qrun))
3020 update_process_status (p, Qexit, 256, 0);
3021 deactivate_process (p);
3024 /* We must call status_notify here to allow the
3025 event_stream->unselect_process_cb to be run if appropriate.
3026 Otherwise, dead fds may be selected for, and we will get a
3027 continuous stream of process events for them. Since we don't
3028 return until all process events have been flushed, we would
3029 get stuck here, processing events on a process whose status
3030 was 'exit. Call this after dispatch-event, or the fds will
3031 have been closed before we read the last data from them.
3032 It's safe for the filter to signal an error because
3033 status_notify() will be called on return to top-level.
3041 struct Lisp_Event *e = XEVENT (event);
3042 if (!NILP (e->event.timeout.function))
3043 call1 (e->event.timeout.function,
3044 e->event.timeout.object);
3049 event_stream_handle_magic_event (XEVENT (event));
3060 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3062 Lisp_Object first_before_suffix =
3063 event_chain_find_previous (Vthis_command_keys, suffix);
3065 if (NILP (first_before_suffix))
3066 Vthis_command_keys = chain;
3068 XSET_EVENT_NEXT (first_before_suffix, chain);
3069 deallocate_event_chain (suffix);
3070 Vthis_command_keys_tail = event_chain_tail (chain);
3074 command_builder_replace_suffix (struct command_builder *builder,
3075 Lisp_Object suffix, Lisp_Object chain)
3077 Lisp_Object first_before_suffix =
3078 event_chain_find_previous (builder->current_events, suffix);
3080 if (NILP (first_before_suffix))
3081 builder->current_events = chain;
3083 XSET_EVENT_NEXT (first_before_suffix, chain);
3084 deallocate_event_chain (suffix);
3085 builder->most_current_event = event_chain_tail (chain);
3089 command_builder_find_leaf_1 (struct command_builder *builder)
3091 Lisp_Object event0 = builder->current_events;
3096 return event_binding (event0, 1);
3099 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3103 widget_value *current, *prev;
3104 widget_value *entries;
3106 current = lw_get_entries (False);
3107 entries = lw_get_entries (True);
3109 if (current != entries)
3111 while (entries != current)
3113 if (entries->name /*&& entries->enabled*/) prev = entries;
3114 entries = entries->next;
3120 /* move to last item */
3122 while (entries->next)
3124 if (entries->name /*&& entries->enabled*/) prev = entries;
3125 entries = entries->next;
3129 if (entries->name /*&& entries->enabled*/)
3134 /* no selectable items in this menu, pop up to previous level */
3143 menu_move_down (void)
3145 widget_value *current;
3148 current = lw_get_entries (False);
3154 if (new->name /*&& new->enabled*/) break;
3157 if (new==current||!(new->name/*||new->enabled*/))
3159 new = lw_get_entries (True);
3160 while (new!=current)
3162 if (new->name /*&& new->enabled*/) break;
3165 if (new==current&&!(new->name /*|| new->enabled*/))
3176 menu_move_left (void)
3178 int level = lw_menu_level ();
3180 widget_value *current;
3188 current = lw_get_entries (False);
3189 if (l > 2 && current->contents)
3190 lw_push_menu (current->contents);
3194 menu_move_right (void)
3196 int level = lw_menu_level ();
3198 widget_value *current;
3206 current = lw_get_entries (False);
3207 if (l > 2 && current->contents)
3208 lw_push_menu (current->contents);
3212 menu_select_item (widget_value *val)
3215 val = lw_get_entries (False);
3217 /* is match a submenu? */
3221 /* enter the submenu */
3224 lw_push_menu (val->contents);
3228 /* Execute the menu entry by calling the menu's `select'
3231 lw_kill_menus (val);
3236 command_builder_operate_menu_accelerator (struct command_builder *builder)
3238 /* this function can GC */
3240 struct console *con = XCONSOLE (Vselected_console);
3241 Lisp_Object evee = builder->most_current_event;
3242 Lisp_Object binding;
3243 widget_value *entries;
3245 extern int lw_menu_accelerate; /* lwlib.c */
3253 t = builder->current_events;
3258 sprintf (buf,"OPERATE (%d): ",i);
3259 write_c_string (buf, Qexternal_debugging_output);
3260 print_internal (t, Qexternal_debugging_output, 1);
3261 write_c_string ("\n", Qexternal_debugging_output);
3262 t = XEVENT_NEXT (t);
3267 /* menu accelerator keys don't go into keyboard macros */
3268 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3269 con->kbd_macro_ptr = con->kbd_macro_end;
3271 /* don't echo menu accelerator keys */
3272 /*reset_key_echo (builder, 1);*/
3274 if (!lw_menu_accelerate)
3276 /* `convert' mouse display to keyboard display
3277 by entering the open submenu
3279 entries = lw_get_entries (False);
3280 if (entries->contents)
3282 lw_push_menu (entries->contents);
3283 lw_display_menu (CurrentTime);
3287 /* compare event to the current menu accelerators */
3289 entries=lw_get_entries (True);
3294 VOID_TO_LISP (accel, entries->accel);
3295 if (entries->name && !NILP (accel))
3297 if (event_matches_key_specifier_p (XEVENT (evee), accel))
3301 menu_select_item (entries);
3303 if (lw_menu_active) lw_display_menu (CurrentTime);
3305 reset_this_command_keys (Vselected_console, 1);
3306 /*reset_command_builder_event_chain (builder);*/
3307 return Vmenu_accelerator_map;
3310 entries = entries->next;
3313 /* try to look up event in menu-accelerator-map */
3315 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
3319 /* beep at user for undefined key */
3324 if (EQ (binding, Qmenu_quit))
3326 /* turn off menus and set quit flag */
3327 lw_kill_menus (NULL);
3330 else if (EQ (binding, Qmenu_up))
3332 int level = lw_menu_level ();
3336 else if (EQ (binding, Qmenu_down))
3338 int level = lw_menu_level ();
3342 menu_select_item (NULL);
3344 else if (EQ (binding, Qmenu_left))
3346 int level = lw_menu_level ();
3350 lw_display_menu (CurrentTime);
3355 else if (EQ (binding, Qmenu_right))
3357 int level = lw_menu_level ();
3359 lw_get_entries (False)->contents)
3361 widget_value *current = lw_get_entries (False);
3362 if (current->contents)
3363 menu_select_item (NULL);
3368 else if (EQ (binding, Qmenu_select))
3369 menu_select_item (NULL);
3370 else if (EQ (binding, Qmenu_escape))
3372 int level = lw_menu_level ();
3377 lw_display_menu (CurrentTime);
3381 /* turn off menus quietly */
3382 lw_kill_menus (NULL);
3385 else if (KEYMAPP (binding))
3388 reset_this_command_keys (Vselected_console, 1);
3389 /*reset_command_builder_event_chain (builder);*/
3394 /* turn off menus and execute binding */
3395 lw_kill_menus (NULL);
3396 reset_this_command_keys (Vselected_console, 1);
3397 /*reset_command_builder_event_chain (builder);*/
3402 if (lw_menu_active) lw_display_menu (CurrentTime);
3404 reset_this_command_keys (Vselected_console, 1);
3405 /*reset_command_builder_event_chain (builder);*/
3407 return Vmenu_accelerator_map;
3411 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
3413 Vmenu_accelerator_prefix = Qnil;
3414 Vmenu_accelerator_modifiers = Qnil;
3415 Vmenu_accelerator_enabled = Qnil;
3416 if (!NILP (errordata))
3418 Lisp_Object args[2];
3420 args[0] = build_string ("Error in menu accelerators (setting to nil)");
3421 /* #### This should call
3422 (with-output-to-string (display-error errordata))
3423 but that stuff is all in Lisp currently. */
3424 args[1] = errordata;
3425 warn_when_safe_lispobj
3427 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
3428 Qnil, -1, 2, args));
3435 menu_accelerator_safe_compare (Lisp_Object event0)
3437 if (CONSP (Vmenu_accelerator_prefix))
3440 t=Vmenu_accelerator_prefix;
3443 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
3446 event0 = XEVENT_NEXT (event0);
3451 else if (NILP (event0))
3453 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
3454 event0 = XEVENT_NEXT (event0);
3461 menu_accelerator_safe_mod_compare (Lisp_Object cons)
3463 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
3469 command_builder_find_menu_accelerator (struct command_builder *builder)
3471 /* this function can GC */
3472 Lisp_Object event0 = builder->current_events;
3473 struct console *con = XCONSOLE (Vselected_console);
3474 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3475 Widget menubar_widget;
3477 /* compare entries in event0 against the menu prefix */
3479 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
3480 XEVENT (event0)->event_type != key_press_event)
3483 if (!NILP (Vmenu_accelerator_prefix))
3485 event0 = condition_case_1 (Qerror,
3486 menu_accelerator_safe_compare,
3488 menu_accelerator_junk_on_error,
3495 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3497 && CONSP (Vmenu_accelerator_modifiers))
3500 Lisp_Object last = Qnil;
3501 struct gcpro gcpro1;
3505 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
3507 val = lw_get_all_values (id);
3510 val = val->contents;
3512 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
3515 while (!NILP (Fcdr (last)))
3518 Fsetcdr (last, Fcons (Qnil, Qnil));
3522 fake = Fcons (Qnil, fake);
3529 VOID_TO_LISP (accel, val->accel);
3530 if (val->name && !NILP (accel))
3532 Fsetcar (last, accel);
3533 Fsetcar (fake, event0);
3534 matchp = condition_case_1 (Qerror,
3535 menu_accelerator_safe_mod_compare,
3537 menu_accelerator_junk_on_error,
3543 lw_set_menu (menubar_widget, val);
3544 /* yah - yet another hack.
3545 pretend emacs timestamp is the same as an X timestamp,
3546 which for the moment it is. (read events.h)
3548 lw_map_menu (XEVENT (event0)->timestamp);
3551 lw_push_menu (val->contents);
3553 lw_display_menu (CurrentTime);
3555 /* menu accelerator keys don't go into keyboard macros */
3556 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3557 con->kbd_macro_ptr = con->kbd_macro_end;
3559 /* don't echo menu accelerator keys */
3560 /*reset_key_echo (builder, 1);*/
3561 reset_this_command_keys (Vselected_console, 1);
3564 return Vmenu_accelerator_map;
3577 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
3578 Make the menubar active. Menu items can be selected using menu accelerators
3579 or by actions defined in menu-accelerator-map.
3583 struct console *con = XCONSOLE (Vselected_console);
3584 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3588 if (NILP (f->menubar_data))
3589 error ("Frame has no menubar.");
3591 id = XPOPUP_DATA (f->menubar_data)->id;
3592 val = lw_get_all_values (id);
3593 val = val->contents;
3594 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
3595 lw_map_menu (CurrentTime);
3597 lw_display_menu (CurrentTime);
3599 /* menu accelerator keys don't go into keyboard macros */
3600 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3601 con->kbd_macro_ptr = con->kbd_macro_end;
3605 #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */
3607 /* See if we can do function-key-map or key-translation-map translation
3608 on the current events in the command builder. If so, do this, and
3609 return the resulting binding, if any. */
3612 munge_keymap_translate (struct command_builder *builder,
3613 enum munge_me_out_the_door munge,
3614 int has_normal_binding_p)
3618 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3620 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3625 if (KEYMAPP (result))
3627 if (NILP (builder->last_non_munged_event)
3628 && !has_normal_binding_p)
3629 builder->last_non_munged_event = builder->most_current_event;
3632 builder->last_non_munged_event = Qnil;
3634 if (!KEYMAPP (result) &&
3635 !VECTORP (result) &&
3638 struct gcpro gcpro1;
3640 result = call1 (result, Qnil);
3646 if (KEYMAPP (result))
3649 if (VECTORP (result) || STRINGP (result))
3651 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3655 /* If the first_mungeable_event of the other munger is
3656 within the events we're munging, then it will point to
3657 deallocated events afterwards, which is bad -- so make it
3658 point at the beginning of the munged events. */
3659 EVENT_CHAIN_LOOP (tempev, suffix)
3661 Lisp_Object *mungeable_event =
3662 &builder->munge_me[1 - munge].first_mungeable_event;
3663 if (EQ (tempev, *mungeable_event))
3665 *mungeable_event = new_chain;
3670 n = event_chain_count (suffix);
3671 command_builder_replace_suffix (builder, suffix, new_chain);
3672 builder->munge_me[munge].first_mungeable_event = Qnil;
3673 /* Now hork this-command-keys as well. */
3675 /* We just assume that the events we just replaced are
3676 sitting in copied form at the end of this-command-keys.
3677 If the user did weird things with `dispatch-event' this
3678 may not be the case, but at least we make sure we won't
3680 new_chain = copy_event_chain (new_chain);
3681 tckn = event_chain_count (Vthis_command_keys);
3684 this_command_keys_replace_suffix
3685 (event_chain_nth (Vthis_command_keys, tckn - n),
3689 result = command_builder_find_leaf_1 (builder);
3693 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3694 "Invalid binding in function-key-map" :
3695 "Invalid binding in key-translation-map"),
3702 /* Compare the current state of the command builder against the local and
3703 global keymaps, and return the binding. If there is no match, try again,
3704 case-insensitively. The return value will be one of:
3705 -- nil (there is no binding)
3706 -- a keymap (part of a command has been specified)
3707 -- a command (anything that satisfies `commandp'; this includes
3708 some symbols, lists, subrs, strings, vectors, and
3709 compiled-function objects)
3712 command_builder_find_leaf (struct command_builder *builder,
3713 int allow_misc_user_events_p)
3715 /* This function can GC */
3717 Lisp_Object evee = builder->current_events;
3719 if (XEVENT_TYPE (evee) == misc_user_event)
3721 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3722 return list2 (XEVENT (evee)->event.eval.function,
3723 XEVENT (evee)->event.eval.object);
3728 /* if we're currently in a menu accelerator, check there for further events */
3729 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3732 return command_builder_operate_menu_accelerator (builder);
3737 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3738 result = command_builder_find_menu_accelerator (builder);
3741 result = command_builder_find_leaf_1 (builder);
3742 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3744 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3745 result = command_builder_find_menu_accelerator (builder);
3749 /* Check to see if we have a potential function-key-map match. */
3752 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3753 regenerate_echo_keys_from_this_command_keys (builder);
3755 /* Check to see if we have a potential key-translation-map match. */
3757 Lisp_Object key_translate_result =
3758 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3760 if (!NILP (key_translate_result))
3762 result = key_translate_result;
3763 regenerate_echo_keys_from_this_command_keys (builder);
3770 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3772 /* If we didn't find a binding, and the last event in the sequence is
3773 a shifted character, then try again with the lowercase version. */
3775 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3776 && !NILP (Vretry_undefined_key_binding_unshifted))
3778 Lisp_Object terminal = builder->most_current_event;
3779 struct key_data* key = & XEVENT (terminal)->event.key;
3781 if ((key->modifiers & MOD_SHIFT)
3782 || (CHAR_OR_CHAR_INTP (key->keysym)
3783 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3785 struct Lisp_Event terminal_copy = *XEVENT (terminal);
3787 if (key->modifiers & MOD_SHIFT)
3788 key->modifiers &= (~ MOD_SHIFT);
3790 key->keysym = make_char (c + 'a' - 'A');
3792 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3795 /* If there was no match with the lower-case version either,
3796 then put back the upper-case event for the error
3797 message. But make sure that function-key-map didn't
3798 change things out from under us. */
3799 if (EQ (terminal, builder->most_current_event))
3800 *XEVENT (terminal) = terminal_copy;
3804 /* help-char is `auto-bound' in every keymap */
3805 if (!NILP (Vprefix_help_command) &&
3806 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3808 return Vprefix_help_command;
3811 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3812 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3813 && !NILP (Vcomposed_character_default_binding))
3815 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3816 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3817 return Vcomposed_character_default_binding;
3819 #endif /* HAVE_XIM */
3821 /* If we read extra events attempting to match a function key but end
3822 up failing, then we release those events back to the command loop
3823 and fail on the original lookup. The released events will then be
3824 reprocessed in the context of the first part having failed. */
3825 if (!NILP (builder->last_non_munged_event))
3827 Lisp_Object event0 = builder->last_non_munged_event;
3829 /* Put the commands back on the event queue. */
3830 enqueue_event_chain (XEVENT_NEXT (event0),
3831 &command_event_queue,
3832 &command_event_queue_tail);
3834 /* Then remove them from the command builder. */
3835 XSET_EVENT_NEXT (event0, Qnil);
3836 builder->most_current_event = event0;
3837 builder->last_non_munged_event = Qnil;
3844 /* Every time a command-event (a key, button, or menu selection) is read by
3845 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3846 and in Vthis_command_keys. (Eval-events are not stored there.)
3848 Every time a command is invoked, Vlast_command_event is set to the last
3849 event in the sequence.
3851 This means that Vthis_command_keys is really about "input read since the
3852 last command was executed" rather than about "what keys invoked this
3853 command." This is a little counterintuitive, but that's the way it
3856 As an extra kink, the function read-key-sequence resets/updates the
3857 last-command-event and this-command-keys. It doesn't append to the
3858 command-keys as read-char does. Such are the pitfalls of having to
3859 maintain compatibility with a program for which the only specification
3862 (We could implement recent_keys_ring and Vthis_command_keys as the same
3866 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3867 Return a vector of recent keyboard or mouse button events read.
3868 If NUMBER is non-nil, not more than NUMBER events will be returned.
3869 Change number of events stored using `set-recent-keys-ring-size'.
3871 This copies the event objects into a new vector; it is safe to keep and
3876 struct gcpro gcpro1;
3877 Lisp_Object val = Qnil;
3879 int start, nkeys, i, j;
3883 nwanted = recent_keys_ring_size;
3886 CHECK_NATNUM (number);
3887 nwanted = XINT (number);
3890 /* Create the keys ring vector, if none present. */
3891 if (NILP (Vrecent_keys_ring))
3893 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3894 /* And return nothing in particular. */
3895 return make_vector (0, Qnil);
3898 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3899 /* This means the vector has not yet wrapped */
3901 nkeys = recent_keys_ring_index;
3906 nkeys = recent_keys_ring_size;
3907 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3910 if (nwanted < nkeys)
3912 start += nkeys - nwanted;
3913 if (start >= recent_keys_ring_size)
3914 start -= recent_keys_ring_size;
3920 val = make_vector (nwanted, Qnil);
3922 for (i = 0, j = start; i < nkeys; i++)
3924 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3928 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3929 if (++j >= recent_keys_ring_size)
3937 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3938 The maximum number of events `recent-keys' can return.
3942 return make_int (recent_keys_ring_size);
3945 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3946 Set the maximum number of events to be stored internally.
3950 Lisp_Object new_vector = Qnil;
3951 int i, j, nkeys, start, min;
3952 struct gcpro gcpro1;
3953 GCPRO1 (new_vector);
3956 if (XINT (size) <= 0)
3957 error ("Recent keys ring size must be positive");
3958 if (XINT (size) == recent_keys_ring_size)
3961 new_vector = make_vector (XINT (size), Qnil);
3963 if (NILP (Vrecent_keys_ring))
3965 Vrecent_keys_ring = new_vector;
3969 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3970 /* This means the vector has not yet wrapped */
3972 nkeys = recent_keys_ring_index;
3977 nkeys = recent_keys_ring_size;
3978 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3981 if (XINT (size) > nkeys)
3986 for (i = 0, j = start; i < min; i++)
3988 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3989 if (++j >= recent_keys_ring_size)
3992 recent_keys_ring_size = XINT (size);
3993 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3995 Vrecent_keys_ring = new_vector;
4001 /* Vthis_command_keys having value Qnil means that the next time
4002 push_this_command_keys is called, it should start over.
4003 The times at which the command-keys are reset
4004 (instead of merely being augmented) are pretty counterintuitive.
4007 -- We do not reset this-command-keys when we finish reading a
4008 command. This is because some commands (e.g. C-u) act
4009 like command prefixes; they signal this by setting prefix-arg
4011 -- Therefore, we reset this-command-keys when we finish
4012 executing a command, unless prefix-arg is set.
4013 -- However, if we ever do a non-local exit out of a command
4014 loop (e.g. an error in a command), we need to reset
4015 this-command-keys. We do this by calling reset_this_command_keys()
4016 from cmdloop.c, whenever an error causes an invocation of the
4017 default error handler, and whenever there's a throw to top-level.)
4021 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
4023 struct command_builder *command_builder =
4024 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4026 reset_key_echo (command_builder, clear_echo_area_p);
4028 deallocate_event_chain (Vthis_command_keys);
4029 Vthis_command_keys = Qnil;
4030 Vthis_command_keys_tail = Qnil;
4032 reset_current_events (command_builder);
4036 push_this_command_keys (Lisp_Object event)
4038 Lisp_Object new = Fmake_event (Qnil, Qnil);
4040 Fcopy_event (event, new);
4041 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
4044 /* The following two functions are used in call-interactively,
4045 for the @ and e specifications. We used to just use
4046 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
4047 but FSF does it more generally so we follow their lead. */
4050 extract_this_command_keys_nth_mouse_event (int n)
4054 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4057 && (XEVENT_TYPE (event) == button_press_event
4058 || XEVENT_TYPE (event) == button_release_event
4059 || XEVENT_TYPE (event) == misc_user_event))
4063 /* must copy to avoid an abort() in next_event_internal() */
4064 if (!NILP (XEVENT_NEXT (event)))
4065 return Fcopy_event (event, Qnil);
4077 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
4080 int len = XVECTOR_LENGTH (vector);
4082 for (i = 0; i < len; i++)
4084 Lisp_Object event = XVECTOR_DATA (vector)[i];
4086 switch (XEVENT_TYPE (event))
4088 case button_press_event :
4089 case button_release_event :
4090 case misc_user_event :
4104 push_recent_keys (Lisp_Object event)
4108 if (NILP (Vrecent_keys_ring))
4109 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
4111 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
4115 e = Fmake_event (Qnil, Qnil);
4116 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
4118 Fcopy_event (event, e);
4119 if (++recent_keys_ring_index == recent_keys_ring_size)
4120 recent_keys_ring_index = 0;
4125 current_events_into_vector (struct command_builder *command_builder)
4129 int n = event_chain_count (command_builder->current_events);
4131 /* Copy the vector and the events in it. */
4132 /* No need to copy the events, since they're already copies, and
4133 nobody other than the command-builder has pointers to them */
4134 vector = make_vector (n, Qnil);
4136 EVENT_CHAIN_LOOP (event, command_builder->current_events)
4137 XVECTOR_DATA (vector)[n++] = event;
4138 reset_command_builder_event_chain (command_builder);
4144 Given the current state of the command builder and a new command event
4145 that has just been dispatched:
4147 -- add the event to the event chain forming the current command
4148 (doing meta-translation as necessary)
4149 -- return the binding of this event chain; this will be one of:
4150 -- nil (there is no binding)
4151 -- a keymap (part of a command has been specified)
4152 -- a command (anything that satisfies `commandp'; this includes
4153 some symbols, lists, subrs, strings, vectors, and
4154 compiled-function objects)
4157 lookup_command_event (struct command_builder *command_builder,
4158 Lisp_Object event, int allow_misc_user_events_p)
4160 /* This function can GC */
4161 struct frame *f = selected_frame ();
4162 /* Clear output from previous command execution */
4163 if (!EQ (Qcommand, echo_area_status (f))
4164 /* but don't let mouse-up clear what mouse-down just printed */
4165 && (XEVENT (event)->event_type != button_release_event))
4166 clear_echo_area (f, Qnil, 0);
4168 /* Add the given event to the command builder.
4169 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
4170 vectors to translate "ESC x" to "M-x" (for any "x" of course).
4173 Lisp_Object recent = command_builder->most_current_event;
4176 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
4178 struct Lisp_Event *e;
4179 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
4180 DoubleThink the recent-keys and this-command-keys as well. */
4182 /* Modify the previous most-recently-pushed event on the command
4183 builder to be a copy of this one with the meta-bit set instead of
4184 pushing a new event.
4186 Fcopy_event (event, recent);
4187 e = XEVENT (recent);
4188 if (e->event_type == key_press_event)
4189 e->event.key.modifiers |= MOD_META;
4190 else if (e->event_type == button_press_event
4191 || e->event_type == button_release_event)
4192 e->event.button.modifiers |= MOD_META;
4197 int tckn = event_chain_count (Vthis_command_keys);
4199 /* ??? very strange if it's < 2. */
4200 this_command_keys_replace_suffix
4201 (event_chain_nth (Vthis_command_keys, tckn - 2),
4202 Fcopy_event (recent, Qnil));
4205 regenerate_echo_keys_from_this_command_keys (command_builder);
4209 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
4211 command_builder_append_event (command_builder, event);
4216 Lisp_Object leaf = command_builder_find_leaf (command_builder,
4217 allow_misc_user_events_p);
4218 struct gcpro gcpro1;
4223 if (!lw_menu_active)
4225 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
4226 if (STRINGP (prompt))
4228 /* Append keymap prompt to key echo buffer */
4229 int buf_index = command_builder->echo_buf_index;
4230 Bytecount len = XSTRING_LENGTH (prompt);
4232 if (len + buf_index + 1 <= command_builder->echo_buf_length)
4234 Bufbyte *echo = command_builder->echo_buf + buf_index;
4235 memcpy (echo, XSTRING_DATA (prompt), len);
4238 maybe_echo_keys (command_builder, 1);
4241 maybe_echo_keys (command_builder, 0);
4243 else if (!NILP (Vquit_flag)) {
4244 Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
4245 struct Lisp_Event *e = XEVENT (quit_event);
4246 /* if quit happened during menu acceleration, pretend we read it */
4247 struct console *con = XCONSOLE (Fselected_console ());
4248 int ch = CONSOLE_QUIT_CHAR (con);
4250 character_to_event (ch, e, con, 1, 1);
4251 e->channel = make_console (con);
4253 enqueue_command_event (quit_event);
4257 else if (!NILP (leaf))
4259 if (EQ (Qcommand, echo_area_status (f))
4260 && command_builder->echo_buf_index > 0)
4262 /* If we had been echoing keys, echo the last one (without
4263 the trailing dash) and redisplay before executing the
4265 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
4266 maybe_echo_keys (command_builder, 1);
4267 Fsit_for (Qzero, Qt);
4270 RETURN_UNGCPRO (leaf);
4275 execute_command_event (struct command_builder *command_builder,
4278 /* This function can GC */
4279 struct console *con = XCONSOLE (command_builder->console);
4280 struct gcpro gcpro1;
4282 GCPRO1 (event); /* event may be freshly created */
4283 reset_current_events (command_builder);
4285 switch (XEVENT (event)->event_type)
4287 case key_press_event:
4288 Vcurrent_mouse_event = Qnil;
4290 case button_press_event:
4291 case button_release_event:
4292 case misc_user_event:
4293 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
4298 /* Store the last-command-event. The semantics of this is that it
4299 is the last event most recently involved in command-lookup. */
4300 if (!EVENTP (Vlast_command_event))
4301 Vlast_command_event = Fmake_event (Qnil, Qnil);
4302 if (XEVENT (Vlast_command_event)->event_type == dead_event)
4304 Vlast_command_event = Fmake_event (Qnil, Qnil);
4305 error ("Someone deallocated the last-command-event!");
4308 if (! EQ (event, Vlast_command_event))
4309 Fcopy_event (event, Vlast_command_event);
4311 /* Note that last-command-char will never have its high-bit set, in
4312 an effort to sidestep the ambiguity between M-x and oslash. */
4313 Vlast_command_char = Fevent_to_character (Vlast_command_event,
4316 /* Actually call the command, with all sorts of hair to preserve or clear
4317 the echo-area and region as appropriate and call the pre- and post-
4320 int old_kbd_macro = con->kbd_macro_end;
4321 struct window *w = XWINDOW (Fselected_window (Qnil));
4323 /* We're executing a new command, so the old value is irrelevant. */
4324 zmacs_region_stays = 0;
4326 /* If the previous command tried to force a specific window-start,
4327 reset the flag in case this command moves point far away from
4328 that position. Also, reset the window's buffer's change
4329 information so that we don't trigger an incremental update. */
4333 buffer_reset_changes (XBUFFER (w->buffer));
4336 pre_command_hook ();
4338 if (XEVENT (event)->event_type == misc_user_event)
4340 call1 (XEVENT (event)->event.eval.function,
4341 XEVENT (event)->event.eval.object);
4345 Fcommand_execute (Vthis_command, Qnil, Qnil);
4348 post_command_hook ();
4350 #if 0 /* #### here was an attempted fix that didn't work */
4351 if (XEVENT (event)->event_type == misc_user_event)
4355 if (!NILP (con->prefix_arg))
4357 /* Commands that set the prefix arg don't update last-command, don't
4358 reset the echoing state, and don't go into keyboard macros unless
4359 followed by another command. */
4360 maybe_echo_keys (command_builder, 0);
4362 /* If we're recording a keyboard macro, and the last command
4363 executed set a prefix argument, then decrement the pointer to
4364 the "last character really in the macro" to be just before this
4365 command. This is so that the ^U in "^U ^X )" doesn't go onto
4366 the end of macro. */
4367 if (!NILP (con->defining_kbd_macro))
4368 con->kbd_macro_end = old_kbd_macro;
4372 /* Start a new command next time */
4373 Vlast_command = Vthis_command;
4374 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
4375 so we don't either */
4376 reset_this_command_keys (make_console (con), 0);
4383 /* Run the pre command hook. */
4386 pre_command_hook (void)
4388 last_point_position = BUF_PT (current_buffer);
4389 XSETBUFFER (last_point_position_buffer, current_buffer);
4390 /* This function can GC */
4391 safe_run_hook_trapping_errors
4392 ("Error in `pre-command-hook' (setting hook to nil)",
4393 Qpre_command_hook, 1);
4396 /* Run the post command hook. */
4399 post_command_hook (void)
4401 /* This function can GC */
4402 /* Turn off region highlighting unless this command requested that
4403 it be left on, or we're in the minibuffer. We don't turn it off
4404 when we're in the minibuffer so that things like M-x write-region
4407 This could be done via a function on the post-command-hook, but
4408 we don't want the user to accidentally remove it.
4411 Lisp_Object win = Fselected_window (Qnil);
4414 /* If the last command deleted the frame, `win' might be nil.
4415 It seems safest to do nothing in this case. */
4416 /* ### This doesn't really fix the problem,
4417 if delete-frame is called by some hook */
4422 if (! zmacs_region_stays
4423 && (!MINI_WINDOW_P (XWINDOW (win))
4424 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
4425 zmacs_deactivate_region ();
4427 zmacs_update_region ();
4429 safe_run_hook_trapping_errors
4430 ("Error in `post-command-hook' (setting hook to nil)",
4431 Qpost_command_hook, 1);
4433 #ifdef DEFERRED_ACTION_CRAP
4434 if (!NILP (Vdeferred_action_list))
4435 call0 (Vdeferred_action_function);
4438 #ifdef ILL_CONCEIVED_HOOK
4439 if (NILP (Vunread_command_events)
4440 && NILP (Vexecuting_macro)
4441 && !NILP (Vpost_command_idle_hook)
4442 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
4444 safe_run_hook_trapping_errors
4445 ("Error in `post-command-idle-hook' (setting hook to nil)",
4446 Qpost_command_idle_hook, 1);
4450 if (!NILP (current_buffer->mark_active))
4452 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
4454 current_buffer->mark_active = Qnil;
4455 run_hook (intern ("deactivate-mark-hook"));
4457 else if (current_buffer != prev_buffer ||
4458 BUF_MODIFF (current_buffer) != prev_modiff)
4459 run_hook (intern ("activate-mark-hook"));
4461 #endif /* FSFmacs */
4463 /* #### Kludge!!! This is necessary to make sure that things
4464 are properly positioned even if post-command-hook moves point.
4465 #### There should be a cleaner way of handling this. */
4466 call0 (Qauto_show_make_point_visible);
4470 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4471 Given an event object as returned by `next-event', execute it.
4473 Key-press, button-press, and button-release events get accumulated
4474 until a complete key sequence (see `read-key-sequence') is reached,
4475 at which point the sequence is looked up in the current keymaps and
4478 Mouse motion events cause the low-level handling function stored in
4479 `mouse-motion-handler' to be called. (There are very few circumstances
4480 under which you should change this handler. Use `mode-motion-hook'
4483 Menu, timeout, and eval events cause the associated function or handler
4486 Process events cause the subprocess's output to be read and acted upon
4487 appropriately (see `start-process').
4489 Magic events are handled as necessary.
4493 /* This function can GC */
4494 struct command_builder *command_builder;
4495 struct Lisp_Event *ev;
4496 Lisp_Object console;
4497 Lisp_Object channel;
4499 CHECK_LIVE_EVENT (event);
4500 ev = XEVENT (event);
4502 /* events on dead channels get silently eaten */
4503 channel = EVENT_CHANNEL (ev);
4504 if (object_dead_p (channel))
4507 /* Some events don't have channels (e.g. eval events). */
4508 console = CDFW_CONSOLE (channel);
4510 console = Vselected_console;
4511 else if (!EQ (console, Vselected_console))
4512 Fselect_console (console);
4514 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4515 switch (XEVENT (event)->event_type)
4517 case button_press_event:
4518 case button_release_event:
4519 case key_press_event:
4521 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4524 /* Incomplete key sequence */
4528 /* At this point, we know that the sequence is not bound to a
4529 command. Normally, we beep and print a message informing the
4530 user of this. But we do not beep or print a message when:
4532 o the last event in this sequence is a mouse-up event; or
4533 o the last event in this sequence is a mouse-down event and
4534 there is a binding for the mouse-up version.
4536 That is, if the sequence ``C-x button1'' is typed, and is not
4537 bound to a command, but the sequence ``C-x button1up'' is bound
4538 to a command, we do not complain about the ``C-x button1''
4539 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4540 bound to a command, then we complain about the ``C-x button1''
4541 sequence, but later will *not* complain about the
4542 ``C-x button1up'' sequence, which would be redundant.
4544 This is pretty hairy, but I think it's the most intuitive
4547 Lisp_Object terminal = command_builder->most_current_event;
4549 if (XEVENT_TYPE (terminal) == button_press_event)
4552 /* Temporarily pretend the last event was an "up" instead of a
4553 "down", and look up its binding. */
4554 XEVENT_TYPE (terminal) = button_release_event;
4555 /* If the "up" version is bound, don't complain. */
4557 = !NILP (command_builder_find_leaf (command_builder, 0));
4558 /* Undo the temporary changes we just made. */
4559 XEVENT_TYPE (terminal) = button_press_event;
4562 /* Pretend this press was not seen (treat as a prefix) */
4563 if (EQ (command_builder->current_events, terminal))
4565 reset_current_events (command_builder);
4571 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4572 if (EQ (XEVENT_NEXT (eve), terminal))
4575 Fdeallocate_event (command_builder->
4576 most_current_event);
4577 XSET_EVENT_NEXT (eve, Qnil);
4578 command_builder->most_current_event = eve;
4580 maybe_echo_keys (command_builder, 1);
4585 /* Complain that the typed sequence is not defined, if this is the
4586 kind of sequence that warrants a complaint. */
4587 XCONSOLE (console)->defining_kbd_macro = Qnil;
4588 XCONSOLE (console)->prefix_arg = Qnil;
4589 /* Don't complain about undefined button-release events */
4590 if (XEVENT_TYPE (terminal) != button_release_event)
4592 Lisp_Object keys = current_events_into_vector (command_builder);
4593 struct gcpro gcpro1;
4595 /* Run the pre-command-hook before barfing about an undefined
4597 Vthis_command = Qnil;
4599 pre_command_hook ();
4601 /* The post-command-hook doesn't run. */
4602 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4604 /* Reset the command builder for reading the next sequence. */
4605 reset_this_command_keys (console, 1);
4607 else /* key sequence is bound to a command */
4609 Vthis_command = leaf;
4610 /* Don't push an undo boundary if the command set the prefix arg,
4611 or if we are executing a keyboard macro, or if in the
4612 minibuffer. If the command we are about to execute is
4613 self-insert, it's tricky: up to 20 consecutive self-inserts may
4614 be done without an undo boundary. This counter is reset as
4615 soon as a command other than self-insert-command is executed.
4617 if (! EQ (leaf, Qself_insert_command))
4618 command_builder->self_insert_countdown = 0;
4619 if (NILP (XCONSOLE (console)->prefix_arg)
4620 && NILP (Vexecuting_macro)
4622 /* This was done in the days when there was no undo
4623 in the minibuffer. If we don't disable this code,
4624 then each instance of "undo" undoes everything in
4626 && !EQ (minibuf_window, Fselected_window (Qnil))
4628 && command_builder->self_insert_countdown == 0)
4631 if (EQ (leaf, Qself_insert_command))
4633 if (--command_builder->self_insert_countdown < 0)
4634 command_builder->self_insert_countdown = 20;
4636 execute_command_event
4638 internal_equal (event, command_builder-> most_current_event, 0)
4640 /* Use the translated event that was most recently seen.
4641 This way, last-command-event becomes f1 instead of
4642 the P from ESC O P. But we must copy it, else we'll
4643 lose when the command-builder events are deallocated. */
4644 : Fcopy_event (command_builder-> most_current_event, Qnil));
4648 case misc_user_event:
4652 We could just always use the menu item entry, whatever it is, but
4653 this might break some Lisp code that expects `this-command' to
4654 always contain a symbol. So only store it if this is a simple
4655 `call-interactively' sort of menu item.
4657 But this is bogus. `this-command' could be a string or vector
4658 anyway (for keyboard macros). There's even one instance
4659 (in pending-del.el) of `this-command' getting set to a cons
4660 (a lambda expression). So in the `eval' case I'll just
4661 convert it into a lambda expression.
4663 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4664 && SYMBOLP (XEVENT (event)->event.eval.object))
4665 Vthis_command = XEVENT (event)->event.eval.object;
4666 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4668 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4669 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4670 /* A scrollbar command or the like. */
4671 Vthis_command = XEVENT (event)->event.eval.function;
4674 Vthis_command = Qnil;
4676 /* clear the echo area */
4677 reset_key_echo (command_builder, 1);
4679 command_builder->self_insert_countdown = 0;
4680 if (NILP (XCONSOLE (console)->prefix_arg)
4681 && NILP (Vexecuting_macro)
4682 && !EQ (minibuf_window, Fselected_window (Qnil)))
4684 execute_command_event (command_builder, event);
4689 execute_internal_event (event);
4696 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4697 Read a sequence of keystrokes or mouse clicks.
4698 Returns a vector of the event objects read. The vector and the event
4699 objects it contains are freshly created (and will not be side-effected
4700 by subsequent calls to this function).
4702 The sequence read is sufficient to specify a non-prefix command starting
4703 from the current local and global keymaps. A C-g typed while in this
4704 function is treated like any other character, and `quit-flag' is not set.
4706 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4707 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4708 as a continuation of the previous key.
4710 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4711 convert the last event to lower case. (Normally any upper case event
4712 is converted to lower case if the original event is undefined and the lower
4713 case equivalent is defined.) This argument is provided mostly for
4714 FSF compatibility; the equivalent effect can be achieved more generally
4715 by binding `retry-undefined-key-binding-unshifted' to nil around the
4716 call to `read-key-sequence'.
4718 A C-g typed while in this function is treated like any other character,
4719 and `quit-flag' is not set.
4721 If the user selects a menu item while we are prompting for a key-sequence,
4722 the returned value will be a vector of a single menu-selection event.
4723 An error will be signalled if you pass this value to `lookup-key' or a
4726 `read-key-sequence' checks `function-key-map' for function key
4727 sequences, where they wouldn't conflict with ordinary bindings. See
4728 `function-key-map' for more details.
4730 (prompt, continue_echo, dont_downcase_last))
4732 /* This function can GC */
4733 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4737 struct command_builder *command_builder =
4738 XCOMMAND_BUILDER (con->command_builder);
4740 Lisp_Object event = Fmake_event (Qnil, Qnil);
4741 int speccount = specpdl_depth ();
4742 struct gcpro gcpro1;
4746 CHECK_STRING (prompt);
4747 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4750 if (NILP (continue_echo))
4751 reset_this_command_keys (make_console (con), 1);
4753 specbind (Qinhibit_quit, Qt);
4755 if (!NILP (dont_downcase_last))
4756 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4760 Fnext_event (event, prompt);
4761 /* restore the selected-console damage */
4762 con = event_console_or_selected (event);
4763 command_builder = XCOMMAND_BUILDER (con->command_builder);
4764 if (! command_event_p (event))
4765 execute_internal_event (event);
4768 if (XEVENT (event)->event_type == misc_user_event)
4769 reset_current_events (command_builder);
4770 result = lookup_command_event (command_builder, event, 1);
4771 if (!KEYMAPP (result))
4773 result = current_events_into_vector (command_builder);
4774 reset_key_echo (command_builder, 0);
4781 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4782 Fdeallocate_event (event);
4783 RETURN_UNGCPRO (unbind_to (speccount, result));
4786 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4787 Return a vector of the keyboard or mouse button events that were used
4788 to invoke this command. This copies the vector and the events; it is safe
4789 to keep and modify them.
4797 if (NILP (Vthis_command_keys))
4798 return make_vector (0, Qnil);
4800 len = event_chain_count (Vthis_command_keys);
4802 result = make_vector (len, Qnil);
4804 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4805 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4809 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4810 Used for complicated reasons in `universal-argument-other-key'.
4812 `universal-argument-other-key' rereads the event just typed.
4813 It then gets translated through `function-key-map'.
4814 The translated event gets included in the echo area and in
4815 the value of `this-command-keys' in addition to the raw original event.
4818 Calling this function directs the translated event to replace
4819 the original event, so that only one version of the event actually
4820 appears in the echo area and in the value of `this-command-keys.'.
4824 /* #### I don't understand this at all, so currently it does nothing.
4825 If there is ever a problem, maybe someone should investigate. */
4831 dribble_out_event (Lisp_Object event)
4833 if (NILP (Vdribble_file))
4836 if (XEVENT (event)->event_type == key_press_event &&
4837 !XEVENT (event)->event.key.modifiers)
4839 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4840 if (CHARP (XEVENT (event)->event.key.keysym))
4842 Emchar ch = XCHAR (keysym);
4843 Bufbyte str[MAX_EMCHAR_LEN];
4846 len = set_charptr_emchar (str, ch);
4847 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4849 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4850 /* one-char key events are printed with just the key name */
4851 Fprinc (keysym, Vdribble_file);
4852 else if (EQ (keysym, Qreturn))
4853 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4854 else if (EQ (keysym, Qspace))
4855 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4857 Fprinc (event, Vdribble_file);
4860 Fprinc (event, Vdribble_file);
4861 Lstream_flush (XLSTREAM (Vdribble_file));
4864 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4865 "FOpen dribble file: ", /*
4866 Start writing all keyboard characters to a dribble file called FILE.
4867 If FILE is nil, close any open dribble file.
4871 /* This function can GC */
4872 /* XEmacs change: always close existing dribble file. */
4873 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4874 if (!NILP (Vdribble_file))
4876 Lstream_close (XLSTREAM (Vdribble_file));
4877 Vdribble_file = Qnil;
4883 file = Fexpand_file_name (file, Qnil);
4884 fd = open ((char*) XSTRING_DATA (file),
4885 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4888 error ("Unable to create dribble file");
4889 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4892 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4893 Fget_coding_system (Qescape_quoted));
4900 /************************************************************************/
4901 /* initialization */
4902 /************************************************************************/
4905 syms_of_event_stream (void)
4907 defsymbol (&Qdisabled, "disabled");
4908 defsymbol (&Qcommand_event_p, "command-event-p");
4910 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
4911 "Undefined keystroke sequence", Qerror);
4912 defsymbol (&Qcommand_execute, "command-execute");
4914 DEFSUBR (Frecent_keys);
4915 DEFSUBR (Frecent_keys_ring_size);
4916 DEFSUBR (Fset_recent_keys_ring_size);
4917 DEFSUBR (Finput_pending_p);
4918 DEFSUBR (Fenqueue_eval_event);
4919 DEFSUBR (Fnext_event);
4920 DEFSUBR (Fnext_command_event);
4921 DEFSUBR (Fdiscard_input);
4923 DEFSUBR (Fsleep_for);
4924 DEFSUBR (Faccept_process_output);
4925 DEFSUBR (Fadd_timeout);
4926 DEFSUBR (Fdisable_timeout);
4927 DEFSUBR (Fadd_async_timeout);
4928 DEFSUBR (Fdisable_async_timeout);
4929 DEFSUBR (Fdispatch_event);
4930 DEFSUBR (Fread_key_sequence);
4931 DEFSUBR (Fthis_command_keys);
4932 DEFSUBR (Freset_this_command_lengths);
4933 DEFSUBR (Fopen_dribble_file);
4934 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
4935 DEFSUBR (Faccelerate_menu);
4938 defsymbol (&Qpre_command_hook, "pre-command-hook");
4939 defsymbol (&Qpost_command_hook, "post-command-hook");
4940 defsymbol (&Qunread_command_events, "unread-command-events");
4941 defsymbol (&Qunread_command_event, "unread-command-event");
4942 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4943 #ifdef ILL_CONCEIVED_HOOK
4944 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4946 #ifdef DEFERRED_ACTION_CRAP
4947 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4949 defsymbol (&Qretry_undefined_key_binding_unshifted,
4950 "retry-undefined-key-binding-unshifted");
4951 defsymbol (&Qauto_show_make_point_visible,
4952 "auto-show-make-point-visible");
4954 defsymbol (&Qmenu_force, "menu-force");
4955 defsymbol (&Qmenu_fallback, "menu-fallback");
4957 defsymbol (&Qmenu_quit, "menu-quit");
4958 defsymbol (&Qmenu_up, "menu-up");
4959 defsymbol (&Qmenu_down, "menu-down");
4960 defsymbol (&Qmenu_left, "menu-left");
4961 defsymbol (&Qmenu_right, "menu-right");
4962 defsymbol (&Qmenu_select, "menu-select");
4963 defsymbol (&Qmenu_escape, "menu-escape");
4965 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4969 vars_of_event_stream (void)
4971 recent_keys_ring_index = 0;
4972 recent_keys_ring_size = 100;
4973 Vrecent_keys_ring = Qnil;
4974 staticpro (&Vrecent_keys_ring);
4976 Vthis_command_keys = Qnil;
4977 staticpro (&Vthis_command_keys);
4978 Vthis_command_keys_tail = Qnil;
4980 num_input_chars = 0;
4982 command_event_queue = Qnil;
4983 staticpro (&command_event_queue);
4984 command_event_queue_tail = Qnil;
4986 Vlast_selected_frame = Qnil;
4987 staticpro (&Vlast_selected_frame);
4989 pending_timeout_list = Qnil;
4990 staticpro (&pending_timeout_list);
4992 pending_async_timeout_list = Qnil;
4993 staticpro (&pending_async_timeout_list);
4995 Vtimeout_free_list = make_opaque_list (sizeof (struct timeout),
4997 staticpro (&Vtimeout_free_list);
4999 the_low_level_timeout_blocktype =
5000 Blocktype_new (struct low_level_timeout_blocktype);
5002 something_happened = 0;
5004 last_point_position_buffer = Qnil;
5005 staticpro (&last_point_position_buffer);
5007 recursive_sit_for = Qnil;
5009 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
5010 *Nonzero means echo unfinished commands after this many seconds of pause.
5012 Vecho_keystrokes = make_int (1);
5014 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
5015 *Number of keyboard input characters between auto-saves.
5016 Zero means disable autosaving due to number of characters typed.
5017 See also the variable `auto-save-timeout'.
5019 auto_save_interval = 300;
5021 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
5022 Function or functions to run before every command.
5023 This may examine the `this-command' variable to find out what command
5024 is about to be run, or may change it to cause a different command to run.
5025 Function on this hook must be careful to avoid signalling errors!
5027 Vpre_command_hook = Qnil;
5029 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
5030 Function or functions to run after every command.
5031 This may examine the `this-command' variable to find out what command
5034 Vpost_command_hook = Qnil;
5036 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
5037 Normal hook run when XEmacs it about to be idle.
5038 This occurs whenever it is going to block, waiting for an event.
5039 This generally happens as a result of a call to `next-event',
5040 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
5041 `x-get-selection', or various Energize-specific commands.
5042 Errors running the hook are caught and ignored.
5044 Vpre_idle_hook = Qnil;
5046 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
5047 *Variable to control XEmacs behavior with respect to focus changing.
5048 If this variable is set to t, then XEmacs will not gratuitously change
5049 the keyboard focus. XEmacs cannot in general detect when this mode is
5050 use by the window manager, so it is up to the user to set it.
5052 focus_follows_mouse = 0;
5054 #ifdef ILL_CONCEIVED_HOOK
5055 /* Ill-conceived because it's not run in all sorts of cases
5056 where XEmacs is blocking. That's what `pre-idle-hook'
5057 is designed to solve. */
5058 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
5059 Normal hook run after each command is executed, if idle.
5060 `post-command-idle-delay' specifies a time in microseconds that XEmacs
5061 must be idle for in order for the functions on this hook to be called.
5062 Errors running the hook are caught and ignored.
5064 Vpost_command_idle_hook = Qnil;
5066 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
5067 Delay time before running `post-command-idle-hook'.
5068 This is measured in microseconds.
5070 post_command_idle_delay = 5000;
5071 #endif /* ILL_CONCEIVED_HOOK */
5073 #ifdef DEFERRED_ACTION_CRAP
5074 /* Random FSFmacs crap. There is absolutely nothing to gain,
5075 and a great deal to lose, in using this in place of just
5076 setting `post-command-hook'. */
5077 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
5078 List of deferred actions to be performed at a later time.
5079 The precise format isn't relevant here; we just check whether it is nil.
5081 Vdeferred_action_list = Qnil;
5083 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
5084 Function to call to handle deferred actions, after each command.
5085 This function is called with no arguments after each command
5086 whenever `deferred-action-list' is non-nil.
5088 Vdeferred_action_function = Qnil;
5089 #endif /* DEFERRED_ACTION_CRAP */
5091 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
5092 Last keyboard or mouse button event that was part of a command. This
5093 variable is off limits: you may not set its value or modify the event that
5094 is its value, as it is destructively modified by `read-key-sequence'. If
5095 you want to keep a pointer to this value, you must use `copy-event'.
5097 Vlast_command_event = Qnil;
5099 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
5100 If the value of `last-command-event' is a keyboard event, then
5101 this is the nearest ASCII equivalent to it. This is the value that
5102 `self-insert-command' will put in the buffer. Remember that there is
5103 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5104 of keyboard events is much larger, so writing code that examines this
5105 variable to determine what key has been typed is bad practice, unless
5106 you are certain that it will be one of a small set of characters.
5108 Vlast_command_char = Qnil;
5110 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
5111 Last keyboard or mouse button event received. This variable is off
5112 limits: you may not set its value or modify the event that is its value, as
5113 it is destructively modified by `next-event'. If you want to keep a pointer
5114 to this value, you must use `copy-event'.
5116 Vlast_input_event = Qnil;
5118 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
5119 The mouse-button event which invoked this command, or nil.
5120 This is usually what `(interactive "e")' returns.
5122 Vcurrent_mouse_event = Qnil;
5124 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
5125 If the value of `last-input-event' is a keyboard event, then
5126 this is the nearest ASCII equivalent to it. Remember that there is
5127 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5128 of keyboard events is much larger, so writing code that examines this
5129 variable to determine what key has been typed is bad practice, unless
5130 you are certain that it will be one of a small set of characters.
5132 Vlast_input_char = Qnil;
5134 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
5135 The time (in seconds since Jan 1, 1970) of the last-command-event,
5136 represented as a cons of two 16-bit integers. This is destructively
5137 modified, so copy it if you want to keep it.
5139 Vlast_input_time = Qnil;
5141 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
5142 The time (in seconds since Jan 1, 1970) of the last-command-event,
5143 represented as a list of three integers. The first integer contains
5144 the most significant 16 bits of the number of seconds, and the second
5145 integer contains the least significant 16 bits. The third integer
5146 contains the remainder number of microseconds, if the current system
5147 supports microsecond clock resolution. This list is destructively
5148 modified, so copy it if you want to keep it.
5150 Vlast_command_event_time = Qnil;
5152 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
5153 List of event objects to be read as next command input events.
5154 This can be used to simulate the receipt of events from the user.
5155 Normally this is nil.
5156 Events are removed from the front of this list.
5158 Vunread_command_events = Qnil;
5160 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
5161 Obsolete. Use `unread-command-events' instead.
5163 Vunread_command_event = Qnil;
5165 DEFVAR_LISP ("last-command", &Vlast_command /*
5166 The last command executed. Normally a symbol with a function definition,
5167 but can be whatever was found in the keymap, or whatever the variable
5168 `this-command' was set to by that command.
5170 Vlast_command = Qnil;
5172 DEFVAR_LISP ("this-command", &Vthis_command /*
5173 The command now being executed.
5174 The command can set this variable; whatever is put here
5175 will be in `last-command' during the following command.
5177 Vthis_command = Qnil;
5179 DEFVAR_LISP ("help-char", &Vhelp_char /*
5180 Character to recognize as meaning Help.
5181 When it is read, do `(eval help-form)', and display result if it's a string.
5182 If the value of `help-form' is nil, this char can be read normally.
5183 This can be any form recognized as a single key specifier.
5184 The help-char cannot be a negative number in XEmacs.
5186 Vhelp_char = make_char (8); /* C-h */
5188 DEFVAR_LISP ("help-form", &Vhelp_form /*
5189 Form to execute when character help-char is read.
5190 If the form returns a string, that string is displayed.
5191 If `help-form' is nil, the help char is not recognized.
5195 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
5196 Command to run when `help-char' character follows a prefix key.
5197 This command is used only when there is no actual binding
5198 for that character after that prefix key.
5200 Vprefix_help_command = Qnil;
5202 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
5203 Hash table used as translate table for keyboard input.
5204 Use `keyboard-translate' to portably add entries to this table.
5205 Each key-press event is looked up in this table as follows:
5207 -- If an entry maps a symbol to a symbol, then a key-press event whose
5208 keysym is the former symbol (with any modifiers at all) gets its
5209 keysym changed and its modifiers left alone. This is useful for
5210 dealing with non-standard X keyboards, such as the grievous damage
5211 that Sun has inflicted upon the world.
5212 -- If an entry maps a character to a character, then a key-press event
5213 matching the former character gets converted to a key-press event
5214 matching the latter character. This is useful on ASCII terminals
5215 for (e.g.) making C-\\ look like C-s, to get around flow-control
5217 -- If an entry maps a character to a symbol, then a key-press event
5218 matching the character gets converted to a key-press event whose
5219 keysym is the given symbol and which has no modifiers.
5222 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
5223 &Vretry_undefined_key_binding_unshifted /*
5224 If a key-sequence which ends with a shifted keystroke is undefined
5225 and this variable is non-nil then the command lookup is retried again
5226 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
5227 If lookup still fails, a normal error is signalled. In general,
5228 you should *bind* this, not set it.
5230 Vretry_undefined_key_binding_unshifted = Qt;
5233 DEFVAR_LISP ("composed-character-default-binding",
5234 &Vcomposed_character_default_binding /*
5235 The default keybinding to use for key events from composed input.
5236 Window systems frequently have ways to allow the user to compose
5237 single characters in a language using multiple keystrokes.
5238 XEmacs sees these as single character keypress events.
5240 Vcomposed_character_default_binding = Qself_insert_command;
5241 #endif /* HAVE_XIM */
5243 Vcontrolling_terminal = Qnil;
5244 staticpro (&Vcontrolling_terminal);
5246 Vdribble_file = Qnil;
5247 staticpro (&Vdribble_file);
5250 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
5251 If non-zero, display debug information about Emacs events that XEmacs sees.
5252 Information is displayed on stderr.
5254 Before the event, the source of the event is displayed in parentheses,
5255 and is one of the following:
5257 \(real) A real event from the window system or
5258 terminal driver, as far as XEmacs can tell.
5260 \(keyboard macro) An event generated from a keyboard macro.
5262 \(unread-command-events) An event taken from `unread-command-events'.
5264 \(unread-command-event) An event taken from `unread-command-event'.
5266 \(command event queue) An event taken from an internal queue.
5267 Events end up on this queue when
5268 `enqueue-eval-event' is called or when
5269 user or eval events are received while
5270 XEmacs is blocking (e.g. in `sit-for',
5271 `sleep-for', or `accept-process-output',
5272 or while waiting for the reply to an
5275 \(->keyboard-translate-table) The result of an event translated through
5276 keyboard-translate-table. Note that in
5277 this case, two events are printed even
5278 though only one is really generated.
5280 \(SIGINT) A faked C-g resulting when XEmacs receives
5281 a SIGINT (e.g. C-c was pressed in XEmacs'
5282 controlling terminal or the signal was
5283 explicitly sent to the XEmacs process).
5285 debug_emacs_events = 0;
5288 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
5289 Non-nil inhibits recording of input-events to recent-keys ring.
5291 inhibit_input_event_recording = 0;
5293 DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /*
5294 Prefix key(s) that must be typed before menu accelerators will be activated.
5295 Set this to a value acceptable by define-key.
5297 Vmenu_accelerator_prefix = Qnil;
5299 DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /*
5300 Modifier keys which must be pressed to get to the top level menu accelerators.
5301 This is a list of modifier key symbols. All modifier keys must be held down
5302 while a valid menu accelerator key is pressed in order for the top level
5303 menu to become active.
5305 See also menu-accelerator-enabled and menu-accelerator-prefix.
5307 Vmenu_accelerator_modifiers = list1 (Qmeta);
5309 DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /*
5310 Whether menu accelerator keys can cause the menubar to become active.
5311 If 'menu-force or 'menu-fallback, then menu accelerator keys can
5312 be used to activate the top level menu. Once the menubar becomes active, the
5313 accelerator keys can be used regardless of the value of this variable.
5315 menu-force is used to indicate that the menu accelerator key takes
5316 precedence over bindings in the current keymap(s). menu-fallback means
5317 that bindings in the current keymap take precedence over menu accelerator keys.
5318 Thus a top level menu with an accelerator of "T" would be activated on a
5319 keypress of Meta-t if menu-accelerator-enabled is menu-force.
5320 However, if menu-accelerator-enabled is menu-fallback, then
5321 Meta-t will not activate the menubar and will instead run the function
5322 transpose-words, to which it is normally bound.
5324 See also menu-accelerator-modifiers and menu-accelerator-prefix.
5326 Vmenu_accelerator_enabled = Qnil;
5330 complex_vars_of_event_stream (void)
5332 Vkeyboard_translate_table =
5333 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5335 DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
5336 Keymap for use when the menubar is active.
5337 The actions menu-quit, menu-up, menu-down, menu-left, menu-right,
5338 menu-select and menu-escape can be mapped to keys in this map.
5340 menu-quit Immediately deactivate the menubar and any open submenus without
5342 menu-up Move the menu cursor up one row in the current menu. If the
5343 move extends past the top of the menu, wrap around to the bottom.
5344 menu-down Move the menu cursor down one row in the current menu. If the
5345 move extends past the bottom of the menu, wrap around to the top.
5346 If executed while the cursor is in the top level menu, move down
5347 into the selected menu.
5348 menu-left Move the cursor from a submenu into the parent menu. If executed
5349 while the cursor is in the top level menu, move the cursor to the
5350 left. If the move extends past the left edge of the menu, wrap
5351 around to the right edge.
5352 menu-right Move the cursor into a submenu. If the cursor is located in the
5353 top level menu or is not currently on a submenu heading, then move
5354 the cursor to the next top level menu entry. If the move extends
5355 past the right edge of the menu, wrap around to the left edge.
5356 menu-select Activate the item under the cursor. If the cursor is located on
5357 a submenu heading, then move the cursor into the submenu.
5358 menu-escape Pop up to the next level of menus. Moves from a submenu into its
5359 parent menu. From the top level menu, this deactivates the
5362 This keymap can also contain normal key-command bindings, in which case the
5363 menubar is deactivated and the corresponding command is executed.
5365 The action bindings used by the menu accelerator code are designed to mimic
5366 the actions of menu traversal keys in a commonly used PC operating system.
5368 Vmenu_accelerator_map = Fmake_keymap(Qnil);
5372 init_event_stream (void)
5376 #ifdef HAVE_UNIXOID_EVENT_LOOP
5377 /* if (strcmp (display_use, "mswindows") != 0)*/
5378 init_event_unixoid ();
5380 #ifdef HAVE_X_WINDOWS
5381 if (!strcmp (display_use, "x"))
5382 init_event_Xt_late ();
5385 #ifdef HAVE_MS_WINDOWS
5386 if (!strcmp (display_use, "mswindows"))
5387 init_event_mswindows_late ();
5391 /* For TTY's, use the Xt event loop if we can; it allows
5392 us to later open an X connection. */
5393 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5394 init_event_Xt_late ();
5395 #elif defined (HAVE_TTY)
5396 init_event_tty_late ();
5397 #elif defined (HAVE_MS_WINDOWS)
5398 init_event_mswindows_late ();
5401 init_interrupts_late ();
5407 useful testcases for v18/v19 compatibility:
5411 (setq unread-command-event (character-to-event ?A (allocate-event)))
5412 (setq x (list (read-char)
5413 ; (read-key-sequence "") ; try it with and without this
5414 last-command-char last-input-char
5415 (recent-keys) (this-command-keys))))
5416 (global-set-key "\^Q" 'foo)
5418 without the read-key-sequence:
5419 ^Q ==> (65 17 65 [... ^Q] [^Q])
5420 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
5421 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
5423 with the read-key-sequence:
5424 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
5425 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
5426 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
5428 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5430 ;(setq x (list (read-char) quit-flag))^J^G
5431 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5432 ;for BOTH, x should get set to (7 t), but no result should be printed.
5434 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5435 ;in *scratch*, type (sit-for 20)^J
5436 ;wait a couple of seconds, move cursor to foo, type "a"
5437 ;a should be inserted in foo. Cursor highlighting should not change in
5440 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5442 ;repeat also with (accept-process-output nil 20)
5444 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5447 (list (condition-case c
5452 (tst)^Ja^G ==> ((quit) 97) with no signal
5453 (tst)^J^Ga ==> ((quit) 97) with no signal
5454 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
5456 ; with sit-for only do the 2nd test.
5457 ; Do all 3 tests with (accept-process-output nil 20)
5460 (setq enable-recursive-minibuffers t
5461 minibuffer-max-depth nil)
5462 ESC ESC ESC ESC - there are now two minibuffers active
5463 C-g C-g C-g - there should be active 0, not 1
5465 C-x C-f ~ / ? - wait for "Making completion list..." to display
5466 C-g - wait for "Quit" to display
5467 C-g - minibuffer should not be active
5468 however C-g before "Quit" is displayed should leave minibuffer active.
5470 ;do it all in both v18 and v19 and make sure all results are the same.
5471 ;all of these cases matter a lot, but some in quite subtle ways.
5475 Additional test cases for accept-process-output, sleep-for, sit-for.
5476 Be sure you do all of the above checking for C-g and focus, too!
5478 ; Make sure that timer handlers are run during, not after sit-for:
5479 (defun timer-check ()
5480 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5482 (message "after sit-for"))
5484 ; The first message should appear after 2 seconds, and the final message
5485 ; 3 seconds after that.
5486 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5490 ; Make sure that process filters are run during, not after sit-for.
5492 (message "sit-for = %s" (sit-for 30)))
5493 (add-hook 'post-command-hook 'fubar)
5495 ; Now type M-x shell RET
5496 ; wait for the shell prompt then send: ls RET
5497 ; the output of ls should fill immediately, and not wait 30 seconds.
5499 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5503 ; Make sure that recursive invocations return immediately:
5504 (defmacro test-diff-time (start end)
5505 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5506 (- (cadr ,end) (cadr ,start))
5507 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5509 (defun testee (ignore)
5513 (let ((start (current-time))
5515 (add-timeout 2 'testee nil)
5517 (add-timeout 2 'testee nil)
5519 (add-timeout 2 'testee nil)
5520 (accept-process-output nil 5)
5521 (setq end (current-time))
5522 (test-diff-time start end)))
5524 (test-them) should sit for 15 seconds.
5525 Repeat with testee set to sleep-for and accept-process-output.
5526 These should each delay 36 seconds.