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 */
87 #include "sysdep.h" /* init_poll_for_quit() */
88 #include "syssignal.h" /* SIGCHLD, etc. */
90 #include "systime.h" /* to set Vlast_input_time */
92 #include "events-mod.h"
94 #include "file-coding.h"
99 /* The number of keystrokes between auto-saves. */
100 static int auto_save_interval;
102 Lisp_Object Qundefined_keystroke_sequence;
104 Lisp_Object Qcommand_event_p;
106 /* Hooks to run before and after each command. */
107 Lisp_Object Vpre_command_hook, Vpost_command_hook;
108 Lisp_Object Qpre_command_hook, Qpost_command_hook;
110 /* Hook run when XEmacs is about to be idle. */
111 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
113 /* Control gratuitous keyboard focus throwing. */
114 int focus_follows_mouse;
116 #ifdef ILL_CONCEIVED_HOOK
117 /* Hook run after a command if there's no more input soon. */
118 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
120 /* Delay time in microseconds before running post-command-idle-hook. */
121 int post_command_idle_delay;
122 #endif /* ILL_CONCEIVED_HOOK */
124 #ifdef DEFERRED_ACTION_CRAP
125 /* List of deferred actions to be performed at a later time.
126 The precise format isn't relevant here; we just check whether it is nil. */
127 Lisp_Object Vdeferred_action_list;
129 /* Function to call to handle deferred actions, when there are any. */
130 Lisp_Object Vdeferred_action_function;
131 Lisp_Object Qdeferred_action_function;
132 #endif /* DEFERRED_ACTION_CRAP */
134 /* Non-nil disable property on a command means
135 do not execute it; call disabled-command-hook's value instead. */
136 Lisp_Object Qdisabled, Vdisabled_command_hook;
138 EXFUN (Fnext_command_event, 2);
140 static void pre_command_hook (void);
141 static void post_command_hook (void);
143 /* Last keyboard or mouse input event read as a command. */
144 Lisp_Object Vlast_command_event;
146 /* The nearest ASCII equivalent of the above. */
147 Lisp_Object Vlast_command_char;
149 /* Last keyboard or mouse event read for any purpose. */
150 Lisp_Object Vlast_input_event;
152 /* The nearest ASCII equivalent of the above. */
153 Lisp_Object Vlast_input_char;
155 Lisp_Object Vcurrent_mouse_event;
157 /* This is fbound in cmdloop.el, see the commentary there */
158 Lisp_Object Qcancel_mode_internal;
160 /* If not Qnil, event objects to be read as the next command input */
161 Lisp_Object Vunread_command_events;
162 Lisp_Object Vunread_command_event; /* obsoleteness support */
164 static Lisp_Object Qunread_command_events, Qunread_command_event;
166 /* Previous command, represented by a Lisp object.
167 Does not include prefix commands and arg setting commands */
168 Lisp_Object Vlast_command;
170 /* If a command sets this, the value goes into
171 previous-command for the next command. */
172 Lisp_Object Vthis_command;
174 /* The value of point when the last command was executed. */
175 Bufpos last_point_position;
177 /* The frame that was current when the last command was started. */
178 Lisp_Object Vlast_selected_frame;
180 /* The buffer that was current when the last command was started. */
181 Lisp_Object last_point_position_buffer;
183 /* A (16bit . 16bit) representation of the time of the last-command-event. */
184 Lisp_Object Vlast_input_time;
186 /* A (16bit 16bit usec) representation of the time
187 of the last-command-event. */
188 Lisp_Object Vlast_command_event_time;
190 /* Character to recognize as the help char. */
191 Lisp_Object Vhelp_char;
193 /* Form to execute when help char is typed. */
194 Lisp_Object Vhelp_form;
196 /* Command to run when the help character follows a prefix key. */
197 Lisp_Object Vprefix_help_command;
199 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
200 may have happened. */
201 volatile int something_happened;
203 /* Hash table to translate keysyms through */
204 Lisp_Object Vkeyboard_translate_table;
206 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
207 Lisp_Object Vretry_undefined_key_binding_unshifted;
208 Lisp_Object Qretry_undefined_key_binding_unshifted;
211 /* If composed input is undefined, use self-insert-char */
212 Lisp_Object Vcomposed_character_default_binding;
213 #endif /* HAVE_XIM */
215 /* Console that corresponds to our controlling terminal */
216 Lisp_Object Vcontrolling_terminal;
218 /* An event (actually an event chain linked through event_next) or Qnil.
220 Lisp_Object Vthis_command_keys;
221 Lisp_Object Vthis_command_keys_tail;
224 Lisp_Object Qauto_show_make_point_visible;
226 /* File in which we write all commands we read; an lstream */
227 static Lisp_Object Vdribble_file;
229 /* Recent keys ring location; a vector of events or nil-s */
230 Lisp_Object Vrecent_keys_ring;
231 int recent_keys_ring_size;
232 int recent_keys_ring_index;
234 /* Boolean specifying whether keystrokes should be added to
236 int inhibit_input_event_recording;
238 /* prefix key(s) that must match in order to activate menu.
239 This is ugly. fix me.
241 Lisp_Object Vmenu_accelerator_prefix;
243 /* list of modifier keys to match accelerator for top level menus */
244 Lisp_Object Vmenu_accelerator_modifiers;
246 /* whether menu accelerators are enabled */
247 Lisp_Object Vmenu_accelerator_enabled;
249 /* keymap for auxiliary menu accelerator functions */
250 Lisp_Object Vmenu_accelerator_map;
252 Lisp_Object Qmenu_force;
253 Lisp_Object Qmenu_fallback;
254 Lisp_Object Qmenu_quit;
255 Lisp_Object Qmenu_up;
256 Lisp_Object Qmenu_down;
257 Lisp_Object Qmenu_left;
258 Lisp_Object Qmenu_right;
259 Lisp_Object Qmenu_select;
260 Lisp_Object Qmenu_escape;
262 Lisp_Object Qself_insert_defer_undo;
264 /* this is in keymap.c */
265 extern Lisp_Object Fmake_keymap (Lisp_Object name);
268 int debug_emacs_events;
271 external_debugging_print_event (char *event_description, Lisp_Object event)
273 write_c_string ("(", Qexternal_debugging_output);
274 write_c_string (event_description, Qexternal_debugging_output);
275 write_c_string (") ", Qexternal_debugging_output);
276 print_internal (event, Qexternal_debugging_output, 1);
277 write_c_string ("\n", Qexternal_debugging_output);
279 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \
280 if (debug_emacs_events) \
281 external_debugging_print_event (event_description, event); \
284 #define DEBUG_PRINT_EMACS_EVENT(string, event)
288 /* The callback routines for the window system or terminal driver */
289 struct event_stream *event_stream;
291 /* This structure is what we use to encapsulate the state of a command sequence
292 being composed; key events are executed by adding themselves to the command
293 builder; if the command builder is then complete (does not still represent
294 a prefix key sequence) it executes the corresponding command.
296 struct command_builder
298 struct lcrecord_header header;
299 Lisp_Object console; /* back pointer to the console this command
301 /* Qnil, or a Lisp_Event representing the first event read
302 * after the last command completed. Threaded. */
304 Lisp_Object prefix_events;
305 /* Qnil, or a Lisp_Event representing event in the current
306 * keymap-lookup sequence. Subsequent events are threaded via
307 * the event's next slot */
308 Lisp_Object current_events;
309 /* Last elt of above */
310 Lisp_Object most_current_event;
311 /* Last elt before function map code took over. What this means is:
312 All prefixes up to (but not including) this event have non-nil
313 bindings, but the prefix including this event has a nil binding.
314 Any events in the chain after this one were read solely because
315 we're part of a possible function key. If we end up with
316 something that's not part of a possible function key, we have to
317 unread all of those events. */
318 Lisp_Object last_non_munged_event;
319 /* One set of values for function-key-map, one for key-translation-map */
320 struct munging_key_translation
322 /* First event that can begin a possible function key sequence
323 (to be translated according to function-key-map). Normally
324 this is the first event in the chain. However, once we've
325 translated a sequence through function-key-map, this will point
326 to the first event after the translated sequence: we don't ever
327 want to translate any events twice through function-key-map, or
328 things could get really screwed up (e.g. if the user created a
329 translation loop). If this is nil, then the next-read event is
330 the first that can begin a function key sequence. */
331 Lisp_Object first_mungeable_event;
335 Bytecount echo_buf_length; /* size of echo_buf */
336 Bytecount echo_buf_index; /* index into echo_buf
337 * -1 before doing echoing for new cmd */
338 /* Self-insert-command is magic in that it doesn't always push an undo-
339 boundary: up to 20 consecutive self-inserts can happen before an undo-
340 boundary is pushed. This variable is that counter.
342 int self_insert_countdown;
345 static void echo_key_event (struct command_builder *, Lisp_Object event);
346 static void maybe_kbd_translate (Lisp_Object event);
348 /* This structure is basically a typeahead queue: things like
349 wait-reading-process-output will delay the execution of
350 keyboard and mouse events by pushing them here.
352 Chained through event_next()
353 command_event_queue_tail is a pointer to the last-added element.
355 static Lisp_Object command_event_queue;
356 static Lisp_Object command_event_queue_tail;
358 /* Nonzero means echo unfinished commands after this many seconds of pause. */
359 static Lisp_Object Vecho_keystrokes;
361 /* The number of keystrokes since the last auto-save. */
362 static int keystrokes_since_auto_save;
364 /* Used by the C-g signal handler so that it will never "hard quit"
365 when waiting for an event. Otherwise holding down C-g could
366 cause a suspension back to the shell, which is generally
367 undesirable. (#### This doesn't fully work.) */
369 int emacs_is_blocking;
371 /* Handlers which run during sit-for, sleep-for and accept-process-output
372 are not allowed to recursively call these routines. We record here
373 if we are in that situation. */
375 static Lisp_Object recursive_sit_for;
379 /**********************************************************************/
380 /* Command-builder object */
381 /**********************************************************************/
383 #define XCOMMAND_BUILDER(x) \
384 XRECORD (x, command_builder, struct command_builder)
385 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
386 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
387 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
390 mark_command_builder (Lisp_Object obj)
392 struct command_builder *builder = XCOMMAND_BUILDER (obj);
393 mark_object (builder->prefix_events);
394 mark_object (builder->current_events);
395 mark_object (builder->most_current_event);
396 mark_object (builder->last_non_munged_event);
397 mark_object (builder->munge_me[0].first_mungeable_event);
398 mark_object (builder->munge_me[1].first_mungeable_event);
399 return builder->console;
403 finalize_command_builder (void *header, int for_disksave)
407 xfree (((struct command_builder *) header)->echo_buf);
408 ((struct command_builder *) header)->echo_buf = 0;
412 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
413 mark_command_builder, internal_object_printer,
414 finalize_command_builder, 0, 0, 0,
415 struct command_builder);
418 reset_command_builder_event_chain (struct command_builder *builder)
420 builder->prefix_events = Qnil;
421 builder->current_events = Qnil;
422 builder->most_current_event = Qnil;
423 builder->last_non_munged_event = Qnil;
424 builder->munge_me[0].first_mungeable_event = Qnil;
425 builder->munge_me[1].first_mungeable_event = Qnil;
429 allocate_command_builder (Lisp_Object console)
431 Lisp_Object builder_obj;
432 struct command_builder *builder =
433 alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
435 builder->console = console;
436 reset_command_builder_event_chain (builder);
437 builder->echo_buf_length = 300; /* #### Kludge */
438 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
439 builder->echo_buf[0] = 0;
440 builder->echo_buf_index = -1;
441 builder->echo_buf_index = -1;
442 builder->self_insert_countdown = 0;
444 XSETCOMMAND_BUILDER (builder_obj, builder);
449 command_builder_append_event (struct command_builder *builder,
452 assert (EVENTP (event));
454 if (EVENTP (builder->most_current_event))
455 XSET_EVENT_NEXT (builder->most_current_event, event);
457 builder->current_events = event;
459 builder->most_current_event = event;
460 if (NILP (builder->munge_me[0].first_mungeable_event))
461 builder->munge_me[0].first_mungeable_event = event;
462 if (NILP (builder->munge_me[1].first_mungeable_event))
463 builder->munge_me[1].first_mungeable_event = event;
467 /**********************************************************************/
468 /* Low-level interfaces onto event methods */
469 /**********************************************************************/
471 enum event_stream_operation
473 EVENT_STREAM_PROCESS,
474 EVENT_STREAM_TIMEOUT,
475 EVENT_STREAM_CONSOLE,
480 check_event_stream_ok (enum event_stream_operation op)
482 if (!event_stream && noninteractive)
486 case EVENT_STREAM_PROCESS:
487 error ("Can't start subprocesses in -batch mode");
488 case EVENT_STREAM_TIMEOUT:
489 error ("Can't add timeouts in -batch mode");
490 case EVENT_STREAM_CONSOLE:
491 error ("Can't add consoles in -batch mode");
492 case EVENT_STREAM_READ:
493 error ("Can't read events in -batch mode");
498 else if (!event_stream)
500 error ("event-stream callbacks not initialized (internal error?)");
505 event_stream_event_pending_p (int user)
507 return event_stream && event_stream->event_pending_p (user);
511 maybe_read_quit_event (struct Lisp_Event *event)
513 /* A C-g that came from `sigint_happened' will always come from the
514 controlling terminal. If that doesn't exist, however, then the
515 user manually sent us a SIGINT, and we pretend the C-g came from
516 the selected console. */
519 if (CONSOLEP (Vcontrolling_terminal) &&
520 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
521 con = XCONSOLE (Vcontrolling_terminal);
523 con = XCONSOLE (Fselected_console ());
527 int ch = CONSOLE_QUIT_CHAR (con);
530 character_to_event (ch, event, con, 1, 1);
531 event->channel = make_console (con);
538 event_stream_next_event (struct Lisp_Event *event)
540 Lisp_Object event_obj;
542 check_event_stream_ok (EVENT_STREAM_READ);
544 XSETEVENT (event_obj, event);
546 /* If C-g was pressed, treat it as a character to be read.
547 Note that if C-g was pressed while we were blocking,
548 the SIGINT signal handler will be called. It will
549 set Vquit_flag and write a byte on our "fake pipe",
550 which will unblock us. */
551 if (maybe_read_quit_event (event))
553 DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj);
557 /* If a longjmp() happens in the callback, we're screwed.
558 Let's hope it doesn't. I think the code here is fairly
559 clean and doesn't do this. */
560 emacs_is_blocking = 1;
562 /* Do this if the poll-for-quit timer seems to be taking too
563 much CPU time when idle ... */
564 reset_poll_for_quit ();
566 event_stream->next_event_cb (event);
568 init_poll_for_quit ();
570 emacs_is_blocking = 0;
573 /* timeout events have more info set later, so
574 print the event out in next_event_internal(). */
575 if (event->event_type != timeout_event)
576 DEBUG_PRINT_EMACS_EVENT ("real", event_obj);
578 maybe_kbd_translate (event_obj);
582 event_stream_handle_magic_event (struct Lisp_Event *event)
584 check_event_stream_ok (EVENT_STREAM_READ);
585 event_stream->handle_magic_event_cb (event);
589 event_stream_add_timeout (EMACS_TIME timeout)
591 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
592 return event_stream->add_timeout_cb (timeout);
596 event_stream_remove_timeout (int id)
598 check_event_stream_ok (EVENT_STREAM_TIMEOUT);
599 event_stream->remove_timeout_cb (id);
603 event_stream_select_console (struct console *con)
605 check_event_stream_ok (EVENT_STREAM_CONSOLE);
606 if (!con->input_enabled)
608 event_stream->select_console_cb (con);
609 con->input_enabled = 1;
614 event_stream_unselect_console (struct console *con)
616 check_event_stream_ok (EVENT_STREAM_CONSOLE);
617 if (con->input_enabled)
619 event_stream->unselect_console_cb (con);
620 con->input_enabled = 0;
625 event_stream_select_process (struct Lisp_Process *proc)
627 check_event_stream_ok (EVENT_STREAM_PROCESS);
628 if (!get_process_selected_p (proc))
630 event_stream->select_process_cb (proc);
631 set_process_selected_p (proc, 1);
636 event_stream_unselect_process (struct Lisp_Process *proc)
638 check_event_stream_ok (EVENT_STREAM_PROCESS);
639 if (get_process_selected_p (proc))
641 event_stream->unselect_process_cb (proc);
642 set_process_selected_p (proc, 0);
647 event_stream_create_stream_pair (void* inhandle, void* outhandle,
648 Lisp_Object* instream, Lisp_Object* outstream, int flags)
650 check_event_stream_ok (EVENT_STREAM_PROCESS);
651 return event_stream->create_stream_pair_cb
652 (inhandle, outhandle, instream, outstream, flags);
656 event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
658 check_event_stream_ok (EVENT_STREAM_PROCESS);
659 return event_stream->delete_stream_pair_cb (instream, outstream);
663 event_stream_quit_p (void)
666 event_stream->quit_p_cb ();
671 /**********************************************************************/
672 /* Character prompting */
673 /**********************************************************************/
676 echo_key_event (struct command_builder *command_builder,
679 /* This function can GC */
681 Bytecount buf_index = command_builder->echo_buf_index;
687 buf_index = 0; /* We're echoing now */
688 clear_echo_area (selected_frame (), Qnil, 0);
691 format_event_object (buf, XEVENT (event), 1);
694 if (len + buf_index + 4 > command_builder->echo_buf_length)
696 e = command_builder->echo_buf + buf_index;
697 memcpy (e, buf, len);
705 command_builder->echo_buf_index = buf_index + len + 1;
709 regenerate_echo_keys_from_this_command_keys (struct command_builder *
714 builder->echo_buf_index = 0;
716 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
717 echo_key_event (builder, event);
721 maybe_echo_keys (struct command_builder *command_builder, int no_snooze)
723 /* This function can GC */
724 double echo_keystrokes;
725 struct frame *f = selected_frame ();
726 /* Message turns off echoing unless more keystrokes turn it on again. */
727 if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f)))
730 if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes))
731 echo_keystrokes = extract_float (Vecho_keystrokes);
735 if (minibuf_level == 0
736 && echo_keystrokes > 0.0
741 /* #### C-g here will cause QUIT. Setting dont_check_for_quit
742 doesn't work. See check_quit. */
743 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
744 /* input came in, so don't echo. */
748 echo_area_message (f, command_builder->echo_buf, Qnil, 0,
749 /* not echo_buf_index. That doesn't include
750 the terminating " - ". */
751 strlen ((char *) command_builder->echo_buf),
757 reset_key_echo (struct command_builder *command_builder,
758 int remove_echo_area_echo)
760 /* This function can GC */
761 struct frame *f = selected_frame ();
763 command_builder->echo_buf_index = -1;
765 if (remove_echo_area_echo)
766 clear_echo_area (f, Qcommand, 0);
770 /**********************************************************************/
772 /**********************************************************************/
775 maybe_kbd_translate (Lisp_Object event)
778 int did_translate = 0;
780 if (XEVENT_TYPE (event) != key_press_event)
782 if (!HASH_TABLEP (Vkeyboard_translate_table))
784 if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
787 c = event_to_character (XEVENT (event), 0, 0, 0);
790 Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table,
792 if (!NILP (traduit) && SYMBOLP (traduit))
794 XEVENT (event)->event.key.keysym = traduit;
795 XEVENT (event)->event.key.modifiers = 0;
798 else if (CHARP (traduit))
800 struct Lisp_Event ev2;
802 /* This used to call Fcharacter_to_event() directly into EVENT,
803 but that can eradicate timestamps and other such stuff.
804 This way is safer. */
806 character_to_event (XCHAR (traduit), &ev2,
807 XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
808 XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
809 XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers;
816 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
817 Vkeyboard_translate_table, Qnil);
818 if (!NILP (traduit) && SYMBOLP (traduit))
820 XEVENT (event)->event.key.keysym = traduit;
827 DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event);
831 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
832 keystrokes_since_auto_save is equivalent to the difference between
833 num_nonmacro_input_chars and last_auto_save. */
835 /* When an auto-save happens, record the "time", and don't do again soon. */
838 record_auto_save (void)
840 keystrokes_since_auto_save = 0;
843 /* Make an auto save happen as soon as possible at command level. */
846 force_auto_save_soon (void)
848 keystrokes_since_auto_save = 1 + max (auto_save_interval, 20);
851 record_asynch_buffer_change ();
856 maybe_do_auto_save (void)
858 /* This function can call lisp */
859 keystrokes_since_auto_save++;
860 if (auto_save_interval > 0 &&
861 keystrokes_since_auto_save > max (auto_save_interval, 20) &&
862 !detect_input_pending ())
864 Fdo_auto_save (Qnil, Qnil);
870 print_help (Lisp_Object object)
872 Fprinc (object, Qnil);
877 execute_help_form (struct command_builder *command_builder,
880 /* This function can GC */
881 Lisp_Object help = Qnil;
882 int speccount = specpdl_depth ();
883 Bytecount buf_index = command_builder->echo_buf_index;
884 Lisp_Object echo = ((buf_index <= 0)
886 : make_string (command_builder->echo_buf,
888 struct gcpro gcpro1, gcpro2;
891 record_unwind_protect (save_window_excursion_unwind,
892 Fcurrent_window_configuration (Qnil));
893 reset_key_echo (command_builder, 1);
895 help = Feval (Vhelp_form);
897 internal_with_output_to_temp_buffer (build_string ("*Help*"),
898 print_help, help, Qnil);
899 Fnext_command_event (event, Qnil);
900 /* Remove the help from the frame */
901 unbind_to (speccount, Qnil);
902 /* Hmmmm. Tricky. The unbind restores an old window configuration,
903 apparently bypassing any setting of windows_structure_changed.
904 So we need to set it so that things get redrawn properly. */
905 /* #### This is massive overkill. Look at doing it better once the
906 new redisplay is fully in place. */
908 Lisp_Object frmcons, devcons, concons;
909 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
911 struct frame *f = XFRAME (XCAR (frmcons));
912 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
917 if (event_matches_key_specifier_p (XEVENT (event), make_char (' ')))
919 /* Discard next key if it is a space */
920 reset_key_echo (command_builder, 1);
921 Fnext_command_event (event, Qnil);
924 command_builder->echo_buf_index = buf_index;
926 memcpy (command_builder->echo_buf,
927 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
932 /**********************************************************************/
934 /**********************************************************************/
937 detect_input_pending (void)
939 /* Always call the event_pending_p hook even if there's an unread
940 character, because that might do some needed ^G detection (on
941 systems without SIGIO, for example).
943 if (event_stream_event_pending_p (1))
945 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
947 if (!NILP (command_event_queue))
951 EVENT_CHAIN_LOOP (event, command_event_queue)
953 if (XEVENT_TYPE (event) != eval_event
954 && XEVENT_TYPE (event) != magic_eval_event)
961 DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /*
962 Return t if command input is currently available with no waiting.
963 Actually, the value is nil only if we can be sure that no input is available.
967 return detect_input_pending () ? Qt : Qnil;
971 /**********************************************************************/
973 /**********************************************************************/
975 /**** Low-level timeout functions. ****
977 These functions maintain a sorted list of one-shot timeouts (where
978 the timeouts are in absolute time). They are intended for use by
979 functions that need to convert a list of absolute timeouts into a
980 series of intervals to wait for. */
982 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
983 used to indicate an absence of a timer. */
984 static int low_level_timeout_id_tick;
986 static struct low_level_timeout_blocktype
988 Blocktype_declare (struct low_level_timeout);
989 } *the_low_level_timeout_blocktype;
991 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return
992 a unique ID identifying the timeout. */
995 add_low_level_timeout (struct low_level_timeout **timeout_list,
998 struct low_level_timeout *tm;
999 struct low_level_timeout *t, **tt;
1001 /* Allocate a new time struct. */
1003 tm = Blocktype_alloc (the_low_level_timeout_blocktype);
1005 if (low_level_timeout_id_tick == 0)
1006 low_level_timeout_id_tick++;
1007 tm->id = low_level_timeout_id_tick++;
1010 /* Add it to the queue. */
1014 while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time))
1025 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
1026 If the timeout is not there, do nothing. */
1029 remove_low_level_timeout (struct low_level_timeout **timeout_list, int id)
1031 struct low_level_timeout *t, *prev;
1035 for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
1039 return; /* couldn't find it */
1042 *timeout_list = t->next;
1043 else prev->next = t->next;
1045 Blocktype_free (the_low_level_timeout_blocktype, t);
1048 /* If there are timeouts on TIMEOUT_LIST, store the relative time
1049 interval to the first timeout on the list into INTERVAL and
1050 return 1. Otherwise, return 0. */
1053 get_low_level_timeout_interval (struct low_level_timeout *timeout_list,
1054 EMACS_TIME *interval)
1056 if (!timeout_list) /* no timer events; block indefinitely */
1060 EMACS_TIME current_time;
1062 /* The time to block is the difference between the first
1063 (earliest) timer on the queue and the current time.
1064 If that is negative, then the timer will fire immediately
1065 but we still have to call select(), with a zero-valued
1066 timeout: user events must have precedence over timer events. */
1067 EMACS_GET_TIME (current_time);
1068 if (EMACS_TIME_GREATER (timeout_list->time, current_time))
1069 EMACS_SUB_TIME (*interval, timeout_list->time,
1072 EMACS_SET_SECS_USECS (*interval, 0, 0);
1077 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
1078 its ID. Also, if TIME_OUT is not 0, store the absolute time of the
1079 timeout into TIME_OUT. */
1082 pop_low_level_timeout (struct low_level_timeout **timeout_list,
1083 EMACS_TIME *time_out)
1085 struct low_level_timeout *tm = *timeout_list;
1091 *time_out = tm->time;
1092 *timeout_list = tm->next;
1093 Blocktype_free (the_low_level_timeout_blocktype, tm);
1098 /**** High-level timeout functions. ****/
1100 static int timeout_id_tick;
1102 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1104 static Lisp_Object Vtimeout_free_list;
1107 mark_timeout (Lisp_Object obj)
1109 struct Lisp_Timeout *tm = XTIMEOUT (obj);
1110 mark_object (tm->function);
1114 /* Should never, ever be called. (except by an external debugger) */
1116 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1118 CONST struct Lisp_Timeout *t = XTIMEOUT (obj);
1121 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
1123 write_c_string (buf, printcharfun);
1126 static const struct lrecord_description timeout_description[] = {
1127 { XD_LISP_OBJECT, offsetof(struct Lisp_Timeout, function), 2 },
1131 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
1132 mark_timeout, print_timeout,
1133 0, 0, 0, timeout_description, struct Lisp_Timeout);
1135 /* Generate a timeout and return its ID. */
1138 event_stream_generate_wakeup (unsigned int milliseconds,
1139 unsigned int vanilliseconds,
1140 Lisp_Object function, Lisp_Object object,
1143 Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
1144 struct Lisp_Timeout *timeout = XTIMEOUT (op);
1145 EMACS_TIME current_time;
1146 EMACS_TIME interval;
1148 timeout->id = timeout_id_tick++;
1149 timeout->resignal_msecs = vanilliseconds;
1150 timeout->function = function;
1151 timeout->object = object;
1153 EMACS_GET_TIME (current_time);
1154 EMACS_SET_SECS_USECS (interval, milliseconds / 1000,
1155 1000 * (milliseconds % 1000));
1156 EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval);
1160 timeout->interval_id =
1161 event_stream_add_async_timeout (timeout->next_signal_time);
1162 pending_async_timeout_list = noseeum_cons (op,
1163 pending_async_timeout_list);
1167 timeout->interval_id =
1168 event_stream_add_timeout (timeout->next_signal_time);
1169 pending_timeout_list = noseeum_cons (op, pending_timeout_list);
1174 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1175 as necessary and return the timeout's ID and function and object slots.
1177 This should be called as a result of receiving notice that a timeout
1178 has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that
1179 identifies this particular firing of the timeout. INTERVAL-ID's and
1180 timeout ID's are in separate number spaces and bear no relation to
1181 each other. The INTERVAL-ID is all that the event callback routines
1182 work with: they work only with one-shot intervals, not with timeouts
1183 that may fire repeatedly.
1185 NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1189 event_stream_resignal_wakeup (int interval_id, int async_p,
1190 Lisp_Object *function, Lisp_Object *object)
1192 Lisp_Object op = Qnil, rest;
1193 struct Lisp_Timeout *timeout;
1194 Lisp_Object *timeout_list;
1195 struct gcpro gcpro1;
1198 GCPRO1 (op); /* just in case ... because it's removed from the list
1201 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
1203 /* Find the timeout on the list of pending ones. */
1204 LIST_LOOP (rest, *timeout_list)
1206 timeout = XTIMEOUT (XCAR (rest));
1207 if (timeout->interval_id == interval_id)
1211 assert (!NILP (rest));
1213 timeout = XTIMEOUT (op);
1214 /* We make sure to snarf the data out of the timeout object before
1215 we free it with free_managed_lcrecord(). */
1217 *function = timeout->function;
1218 *object = timeout->object;
1220 /* Remove this one from the list of pending timeouts */
1221 *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list);
1223 /* If this timeout wants to be resignalled, do it now. */
1224 if (timeout->resignal_msecs)
1226 EMACS_TIME current_time;
1227 EMACS_TIME interval;
1229 /* Determine the time that the next resignalling should occur.
1230 We do that by adding the interval time to the last signalled
1231 time until we get a time that's current.
1233 (This way, it doesn't matter if the timeout was signalled
1234 exactly when we asked for it, or at some time later.)
1236 EMACS_GET_TIME (current_time);
1237 EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000,
1238 1000 * (timeout->resignal_msecs % 1000));
1241 EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time,
1243 } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time));
1246 timeout->interval_id =
1247 event_stream_add_async_timeout (timeout->next_signal_time);
1249 timeout->interval_id =
1250 event_stream_add_timeout (timeout->next_signal_time);
1251 /* Add back onto the list. Note that the effect of this
1252 is to move frequently-hit timeouts to the front of the
1253 list, which is a good thing. */
1254 *timeout_list = noseeum_cons (op, *timeout_list);
1257 free_managed_lcrecord (Vtimeout_free_list, op);
1264 event_stream_disable_wakeup (int id, int async_p)
1266 struct Lisp_Timeout *timeout = 0;
1268 Lisp_Object *timeout_list;
1271 timeout_list = &pending_async_timeout_list;
1273 timeout_list = &pending_timeout_list;
1275 /* Find the timeout on the list of pending ones, if it's still there. */
1276 LIST_LOOP (rest, *timeout_list)
1278 timeout = XTIMEOUT (XCAR (rest));
1279 if (timeout->id == id)
1283 /* If we found it, remove it from the list and disable the pending
1287 Lisp_Object op = XCAR (rest);
1289 delq_no_quit_and_free_cons (op, *timeout_list);
1291 event_stream_remove_async_timeout (timeout->interval_id);
1293 event_stream_remove_timeout (timeout->interval_id);
1294 free_managed_lcrecord (Vtimeout_free_list, op);
1299 event_stream_wakeup_pending_p (int id, int async_p)
1301 struct Lisp_Timeout *timeout;
1303 Lisp_Object timeout_list;
1308 timeout_list = pending_async_timeout_list;
1310 timeout_list = pending_timeout_list;
1312 /* Find the element on the list of pending ones, if it's still there. */
1313 LIST_LOOP (rest, timeout_list)
1315 timeout = XTIMEOUT (XCAR (rest));
1316 if (timeout->id == id)
1327 /**** Asynch. timeout functions (see also signal.c) ****/
1329 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1330 extern int poll_for_quit_id;
1333 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1334 extern int poll_for_sigchld_id;
1338 event_stream_deal_with_async_timeout (int interval_id)
1340 /* This function can GC */
1341 Lisp_Object humpty, dumpty;
1342 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1343 || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1346 event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty);
1348 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1349 if (id == poll_for_quit_id)
1351 quit_check_signal_happened = 1;
1352 quit_check_signal_tick_count++;
1357 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1358 if (id == poll_for_sigchld_id)
1360 kick_status_notify ();
1365 /* call1 GC-protects its arguments */
1366 call1_trapping_errors ("Error in asynchronous timeout callback",
1371 /**** Lisp-level timeout functions. ****/
1373 static unsigned long
1374 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
1376 #ifdef LISP_FLOAT_TYPE
1378 CHECK_INT_OR_FLOAT (secs);
1379 fsecs = XFLOATINT (secs);
1383 fsecs = XINT (secs);
1386 signal_simple_error ("timeout is negative", secs);
1387 if (!allow_0 && fsecs == 0)
1388 signal_simple_error ("timeout is non-positive", secs);
1389 if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
1391 ("timeout would exceed 32 bits when represented in milliseconds", secs);
1393 return (unsigned long) (1000 * fsecs);
1396 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
1397 Add a timeout, to be signaled after the timeout period has elapsed.
1398 SECS is a number of seconds, expressed as an integer or a float.
1399 FUNCTION will be called after that many seconds have elapsed, with one
1400 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1401 then after this timeout expires, `add-timeout' will automatically be called
1402 again with RESIGNAL as the first argument.
1404 This function returns an object which is the id number of this particular
1405 timeout. You can pass that object to `disable-timeout' to turn off the
1406 timeout before it has been signalled.
1408 NOTE: Id numbers as returned by this function are in a distinct namespace
1409 from those returned by `add-async-timeout'. This means that the same id
1410 number could refer to a pending synchronous timeout and a different pending
1411 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1412 to `disable-async-timeout', or vice-versa.
1414 The number of seconds may be expressed as a floating-point number, in which
1415 case some fractional part of a second will be used. Caveat: the usable
1416 timeout granularity will vary from system to system.
1418 Adding a timeout causes a timeout event to be returned by `next-event', and
1419 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1420 loop, the function will not be invoked until the next call to sit-for or
1421 until the return to top-level (the same is true of process filters).
1423 If you need to have a timeout executed even when XEmacs is in the midst of
1424 running Lisp code, use `add-async-timeout'.
1426 WARNING: if you are thinking of calling add-timeout from inside of a
1427 callback function as a way of resignalling a timeout, think again. There
1428 is a race condition. That's why the RESIGNAL argument exists.
1430 (secs, function, object, resignal))
1432 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1433 unsigned long msecs2 = (NILP (resignal) ? 0 :
1434 lisp_number_to_milliseconds (resignal, 0));
1437 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0);
1438 lid = make_int (id);
1439 if (id != XINT (lid)) abort ();
1443 DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /*
1444 Disable a timeout from signalling any more.
1445 ID should be a timeout id number as returned by `add-timeout'. If ID
1446 corresponds to a one-shot timeout that has already signalled, nothing
1449 It will not work to call this function on an id number returned by
1450 `add-async-timeout'. Use `disable-async-timeout' for that.
1455 event_stream_disable_wakeup (XINT (id), 0);
1459 DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1460 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1461 SECS is a number of seconds, expressed as an integer or a float.
1462 FUNCTION will be called after that many seconds have elapsed, with one
1463 argument, the given OBJECT. If the optional RESIGNAL argument is provided,
1464 then after this timeout expires, `add-async-timeout' will automatically be
1465 called again with RESIGNAL as the first argument.
1467 This function returns an object which is the id number of this particular
1468 timeout. You can pass that object to `disable-async-timeout' to turn off
1469 the timeout before it has been signalled.
1471 NOTE: Id numbers as returned by this function are in a distinct namespace
1472 from those returned by `add-timeout'. This means that the same id number
1473 could refer to a pending synchronous timeout and a different pending
1474 asynchronous timeout, and that you cannot pass an id from
1475 `add-async-timeout' to `disable-timeout', or vice-versa.
1477 The number of seconds may be expressed as a floating-point number, in which
1478 case some fractional part of a second will be used. Caveat: the usable
1479 timeout granularity will vary from system to system.
1481 Adding an asynchronous timeout causes the function to be invoked as soon
1482 as the timeout occurs, even if XEmacs is in the midst of executing some
1483 other code. (This is unlike the synchronous timeouts added with
1484 `add-timeout', where the timeout will only be signalled when XEmacs is
1485 waiting for events, i.e. the next return to top-level or invocation of
1486 `sit-for' or related functions.) This means that the function that is
1487 called *must* not signal an error or change any global state (e.g. switch
1488 buffers or windows) except when locking code is in place to make sure
1489 that race conditions don't occur in the interaction between the
1490 asynchronous timeout function and other code.
1492 Under most circumstances, you should use `add-timeout' instead, as it is
1493 much safer. Asynchronous timeouts should only be used when such behavior
1494 is really necessary.
1496 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1497 is non-nil. As soon as `inhibit-quit' becomes nil again, any pending
1498 asynchronous timeouts will get called immediately. (Multiple occurrences
1499 of the same asynchronous timeout are not queued, however.) While the
1500 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1501 is automatically bound to non-nil, and thus other asynchronous timeouts
1502 will be blocked unless the callback function explicitly sets `inhibit-quit'
1505 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1506 callback function as a way of resignalling a timeout, think again. There
1507 is a race condition. That's why the RESIGNAL argument exists.
1509 (secs, function, object, resignal))
1511 unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
1512 unsigned long msecs2 = (NILP (resignal) ? 0 :
1513 lisp_number_to_milliseconds (resignal, 0));
1516 id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1);
1517 lid = make_int (id);
1518 if (id != XINT (lid)) abort ();
1522 DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1523 Disable an asynchronous timeout from signalling any more.
1524 ID should be a timeout id number as returned by `add-async-timeout'. If ID
1525 corresponds to a one-shot timeout that has already signalled, nothing
1528 It will not work to call this function on an id number returned by
1529 `add-timeout'. Use `disable-timeout' for that.
1534 event_stream_disable_wakeup (XINT (id), 1);
1539 /**********************************************************************/
1540 /* enqueuing and dequeuing events */
1541 /**********************************************************************/
1543 /* Add an event to the back of the command-event queue: it will be the next
1544 event read after all pending events. This only works on keyboard,
1545 mouse-click, misc-user, and eval events.
1548 enqueue_command_event (Lisp_Object event)
1550 enqueue_event (event, &command_event_queue, &command_event_queue_tail);
1554 dequeue_command_event (void)
1556 return dequeue_event (&command_event_queue, &command_event_queue_tail);
1559 /* put the event on the typeahead queue, unless
1560 the event is the quit char, in which case the `QUIT'
1561 which will occur on the next trip through this loop is
1562 all the processing we should do - leaving it on the queue
1563 would cause the quit to be processed twice.
1566 enqueue_command_event_1 (Lisp_Object event_to_copy)
1568 /* do not call check_quit() here. Vquit_flag was set in
1569 next_event_internal. */
1570 if (NILP (Vquit_flag))
1571 enqueue_command_event (Fcopy_event (event_to_copy, Qnil));
1575 enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object)
1577 Lisp_Object event = Fmake_event (Qnil, Qnil);
1579 XEVENT (event)->event_type = magic_eval_event;
1580 /* channel for magic_eval events is nil */
1581 XEVENT (event)->event.magic_eval.internal_function = fun;
1582 XEVENT (event)->event.magic_eval.object = object;
1583 enqueue_command_event (event);
1586 DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /*
1587 Add an eval event to the back of the eval event queue.
1588 When this event is dispatched, FUNCTION (which should be a function
1589 of one argument) will be called with OBJECT as its argument.
1590 See `next-event' for a description of event types and how events
1595 Lisp_Object event = Fmake_event (Qnil, Qnil);
1597 XEVENT (event)->event_type = eval_event;
1598 /* channel for eval events is nil */
1599 XEVENT (event)->event.eval.function = function;
1600 XEVENT (event)->event.eval.object = object;
1601 enqueue_command_event (event);
1607 enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function,
1610 Lisp_Object event = Fmake_event (Qnil, Qnil);
1612 XEVENT (event)->event_type = misc_user_event;
1613 XEVENT (event)->channel = channel;
1614 XEVENT (event)->event.misc.function = function;
1615 XEVENT (event)->event.misc.object = object;
1616 XEVENT (event)->event.misc.button = 0;
1617 XEVENT (event)->event.misc.modifiers = 0;
1618 XEVENT (event)->event.misc.x = -1;
1619 XEVENT (event)->event.misc.y = -1;
1620 enqueue_command_event (event);
1626 enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function,
1628 int button, int modifiers, int x, int y)
1630 Lisp_Object event = Fmake_event (Qnil, Qnil);
1632 XEVENT (event)->event_type = misc_user_event;
1633 XEVENT (event)->channel = channel;
1634 XEVENT (event)->event.misc.function = function;
1635 XEVENT (event)->event.misc.object = object;
1636 XEVENT (event)->event.misc.button = button;
1637 XEVENT (event)->event.misc.modifiers = modifiers;
1638 XEVENT (event)->event.misc.x = x;
1639 XEVENT (event)->event.misc.y = y;
1640 enqueue_command_event (event);
1646 /**********************************************************************/
1647 /* focus-event handling */
1648 /**********************************************************************/
1652 Ben's capsule lecture on focus:
1654 In FSFmacs `select-frame' never changes the window-manager frame
1655 focus. All it does is change the "selected frame". This is similar
1656 to what happens when we call `select-device' or `select-console'.
1657 Whenever an event comes in (including a keyboard event), its frame is
1658 selected; therefore, evaluating `select-frame' in *scratch* won't
1659 cause any effects because the next received event (in the same frame)
1660 will cause a switch back to the frame displaying *scratch*.
1662 Whenever a focus-change event is received from the window manager, it
1663 generates a `switch-frame' event, which causes the Lisp function
1664 `handle-switch-frame' to get run. This basically just runs
1665 `select-frame' (see below, however).
1667 In FSFmacs, if you want to have an operation run when a frame is
1668 selected, you supply an event binding for `switch-frame' (and then
1669 maybe call `handle-switch-frame', or something ...).
1671 In XEmacs, we *do* change the window-manager frame focus as a result
1672 of `select-frame', but not until the next time an event is received,
1673 so that a function that momentarily changes the selected frame won't
1674 cause WM focus flashing. (#### There's something not quite right here;
1675 this is causing the wrong-cursor-focus problems that you occasionally
1676 see. But the general idea is correct.) This approach is winning for
1677 people who use the explicit-focus model, but is trickier to implement.
1679 We also don't make the `switch-frame' event visible but instead have
1680 `select-frame-hook', which is a better approach.
1682 There is the problem of surrogate minibuffers, where when we enter the
1683 minibuffer, you essentially want to temporarily switch the WM focus to
1684 the frame with the minibuffer, and switch it back when you exit the
1687 FSFmacs solves this with the crockish `redirect-frame-focus', which
1688 says "for keyboard events received from FRAME, act like they're
1689 coming from FOCUS-FRAME". I think what this means is that, when
1690 a keyboard event comes in and the event manager is about to select the
1691 event's frame, if that frame has its focus redirected, the redirected-to
1692 frame is selected instead. That way, if you're in a minibufferless
1693 frame and enter the minibuffer, then all Lisp functions that run see
1694 the selected frame as the minibuffer's frame rather than the minibufferless
1695 frame you came from, so that (e.g.) your typing actually appears in
1696 the minibuffer's frame and things behave sanely.
1698 There's also some weird logic that switches the redirected frame focus
1699 from one frame to another if Lisp code explicitly calls `select-frame'
1700 \(but not if `handle-switch-frame' is called), and saves and restores
1701 the frame focus in window configurations, etc. etc. All of this logic
1702 is heavily #if 0'd, with lots of comments saying "No, this approach
1703 doesn't seem to work, so I'm trying this ... is it reasonable?
1704 Well, I'm not sure ..." that are a red flag indicating crockishness.
1706 Because of our way of doing things, we can avoid all this crock.
1707 Keyboard events never cause a select-frame (who cares what frame
1708 they're associated with? They come from a console, only). We change
1709 the actual WM focus to a surrogate minibuffer frame, so we don't have
1710 to do any internal redirection. In order to get the focus back,
1711 I took the approach in minibuf.el of just checking to see if the
1712 frame we moved to is still the selected frame, and move back to the
1713 old one if so. Conceivably we might have to do the weird "tracking"
1714 that FSFmacs does when `select-frame' is called, but I don't think
1715 so. If the selected frame moved from the minibuffer frame, then
1716 we just leave it there, figuring that someone knows what they're
1717 doing. Because we don't have any redirection recorded anywhere,
1718 it's safe to do this, and we don't end up with unwanted redirection.
1723 run_select_frame_hook (void)
1725 run_hook (Qselect_frame_hook);
1729 run_deselect_frame_hook (void)
1731 #if 0 /* unclean! FSF calls this at all sorts of random places,
1732 including a bunch of places in their mouse.el. If this
1733 is implemented, it has to be done cleanly. */
1734 run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also
1735 called in `call-interactively'.
1736 Does this mean it will be
1737 called twice? Oh well, FSF
1738 bug -- FSF calls it in
1739 `handle-switch-frame',
1740 which is approximately the
1741 same as the caller of this
1744 run_hook (Qdeselect_frame_hook);
1747 /* When select-frame is called and focus_follows_mouse is false, we want
1748 to tell the window system that the focus should be changed to point to
1749 the new frame. However,
1750 sometimes Lisp functions will temporarily change the selected frame
1751 (e.g. to call a function that operates on the selected frame),
1752 and it's annoying if this focus-change happens exactly when
1753 select-frame is called, because then you get some flickering of the
1754 window-manager border and perhaps other undesirable results. We
1755 really only want to change the focus when we're about to retrieve
1756 an event from the user. To do this, we keep track of the frame
1757 where the window-manager focus lies on, and just before waiting
1758 for user events, check the currently selected frame and change
1759 the focus as necessary.
1761 On the other hand, if focus_follows_mouse is true, we need to switch the
1762 selected frame back to the frame with window manager focus just before we
1763 execute the next command in Fcommand_loop_1, just as the selected buffer is
1764 reverted after a set-buffer.
1766 Both cases are handled by this function. It must be called as appropriate
1767 from these two places, depending on the value of focus_follows_mouse. */
1770 investigate_frame_change (void)
1772 Lisp_Object devcons, concons;
1774 /* if the selected frame was changed, change the window-system
1775 focus to the new frame. We don't do it when select-frame was
1776 called, to avoid flickering and other unwanted side effects when
1777 the frame is just changed temporarily. */
1778 DEVICE_LOOP_NO_BREAK (devcons, concons)
1780 struct device *d = XDEVICE (XCAR (devcons));
1781 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d);
1783 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1784 but that can cause us to end up in an infinite loop focusing
1785 between two frames. It seems that since the call to `select-frame'
1786 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1787 value, we need to do so too. */
1788 if (!NILP (sel_frame) &&
1789 !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
1790 !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
1791 !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
1793 /* At this point, we know that the frame has been changed. Now, if
1794 * focus_follows_mouse is not set, we finish off the frame change,
1795 * so that user events will now come from the new frame. Otherwise,
1796 * if focus_follows_mouse is set, no gratuitous frame changing
1797 * should take place. Set the focus back to the frame which was
1798 * originally selected for user input.
1800 if (!focus_follows_mouse)
1802 /* prevent us from issuing the same request more than once */
1803 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
1804 MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
1808 Lisp_Object old_frame = Qnil;
1810 /* #### Do we really want to check OUGHT ??
1811 * It seems to make sense, though I have never seen us
1812 * get here and have it be non-nil.
1814 if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
1815 old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
1816 else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
1817 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1819 /* #### Can old_frame ever be NIL? play it safe.. */
1820 if (!NILP (old_frame))
1822 /* Fselect_frame is not really the right thing: it frobs the
1823 * buffer stack. But there's no easy way to do the right
1824 * thing, and this code already had this problem anyway.
1826 Fselect_frame (old_frame);
1834 cleanup_after_missed_defocusing (Lisp_Object frame)
1836 if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)))
1837 Fselect_frame (frame);
1842 emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev)
1844 Lisp_Object frame = Fcar (frame_inp_and_dev);
1845 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1846 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1849 if (!DEVICE_LIVE_P (XDEVICE (device)))
1852 d = XDEVICE (device);
1854 /* Any received focus-change notifications render invalid any
1855 pending focus-change requests. */
1856 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil;
1859 Lisp_Object focus_frame;
1861 if (!FRAME_LIVE_P (XFRAME (frame)))
1864 focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1866 /* Mark the minibuffer as changed to make sure it gets updated
1867 properly if the echo area is active. */
1869 struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame)));
1870 MARK_WINDOWS_CHANGED (w);
1873 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1875 /* Oops, we missed a focus-out event. */
1876 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1877 redisplay_redraw_cursor (XFRAME (focus_frame), 1);
1879 DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame;
1880 if (!EQ (frame, focus_frame))
1882 redisplay_redraw_cursor (XFRAME (frame), 1);
1887 /* We ignore the frame reported in the event. If it's different
1888 from where we think the focus was, oh well -- we messed up.
1889 Nonetheless, we pretend we were right, for sensible behavior. */
1890 frame = DEVICE_FRAME_WITH_FOCUS_REAL (d);
1893 DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil;
1895 if (FRAME_LIVE_P (XFRAME (frame)))
1896 redisplay_redraw_cursor (XFRAME (frame), 1);
1901 /* Called from the window-system-specific code when we receive a
1902 notification that the focus lies on a particular frame.
1903 Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1907 emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev)
1909 Lisp_Object frame = Fcar (frame_inp_and_dev);
1910 Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev));
1911 int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev)));
1915 if (!DEVICE_LIVE_P (XDEVICE (device)))
1918 d = XDEVICE (device);
1922 Lisp_Object focus_frame;
1924 if (!FRAME_LIVE_P (XFRAME (frame)))
1927 focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1929 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame;
1930 if (FRAMEP (focus_frame) && !EQ (frame, focus_frame))
1932 /* Oops, we missed a focus-out event. */
1933 Fselect_frame (focus_frame);
1934 /* Do an unwind-protect in case an error occurs in
1935 the deselect-frame-hook */
1936 count = specpdl_depth ();
1937 record_unwind_protect (cleanup_after_missed_defocusing, frame);
1938 run_deselect_frame_hook ();
1939 unbind_to (count, Qnil);
1940 /* the cleanup method changed the focus frame to nil, so
1941 we need to reflect this */
1945 Fselect_frame (frame);
1946 if (!EQ (frame, focus_frame))
1947 run_select_frame_hook ();
1951 /* We ignore the frame reported in the event. If it's different
1952 from where we think the focus was, oh well -- we messed up.
1953 Nonetheless, we pretend we were right, for sensible behavior. */
1954 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
1957 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil;
1958 run_deselect_frame_hook ();
1964 /**********************************************************************/
1965 /* retrieving the next event */
1966 /**********************************************************************/
1968 static int in_single_console;
1970 /* #### These functions don't currently do anything. */
1972 single_console_state (void)
1974 in_single_console = 1;
1978 any_console_state (void)
1980 in_single_console = 0;
1984 in_single_console_state (void)
1986 return in_single_console;
1989 /* the number of keyboard characters read. callint.c wants this. */
1990 Charcount num_input_chars;
1993 next_event_internal (Lisp_Object target_event, int allow_queued)
1995 struct gcpro gcpro1;
1996 /* QUIT; This is incorrect - the caller must do this because some
1997 callers (ie, Fnext_event()) do not want to QUIT. */
1999 assert (NILP (XEVENT_NEXT (target_event)));
2001 GCPRO1 (target_event);
2003 /* When focus_follows_mouse is nil, if a frame change took place, we need
2004 * to actually switch window manager focus to the selected window now.
2006 if (!focus_follows_mouse)
2007 investigate_frame_change ();
2009 if (allow_queued && !NILP (command_event_queue))
2011 Lisp_Object event = dequeue_command_event ();
2012 Fcopy_event (event, target_event);
2013 Fdeallocate_event (event);
2014 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
2018 struct Lisp_Event *e = XEVENT (target_event);
2020 /* The command_event_queue was empty. Wait for an event. */
2021 event_stream_next_event (e);
2022 /* If this was a timeout, then we need to extract some data
2023 out of the returned closure and might need to resignal
2025 if (e->event_type == timeout_event)
2027 Lisp_Object tristan, isolde;
2029 e->event.timeout.id_number =
2030 event_stream_resignal_wakeup (e->event.timeout.interval_id, 0,
2033 e->event.timeout.function = tristan;
2034 e->event.timeout.object = isolde;
2035 /* next_event_internal() doesn't print out timeout events
2036 because of the extra info we just set. */
2037 DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event);
2040 /* If we read a ^G, then set quit-flag but do not discard the ^G.
2041 The callers of next_event_internal() will do one of two things:
2043 -- set Vquit_flag to Qnil. (next-event does this.) This will
2044 cause the ^G to be treated as a normal keystroke.
2045 -- not change Vquit_flag but attempt to enqueue the ^G, at
2046 which point it will be discarded. The next time QUIT is
2047 called, it will notice that Vquit_flag was set.
2050 if (e->event_type == key_press_event &&
2051 event_matches_key_specifier_p
2052 (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e))))))
2062 run_pre_idle_hook (void)
2064 if (!NILP (Vpre_idle_hook)
2065 && !detect_input_pending ())
2066 safe_run_hook_trapping_errors
2067 ("Error in `pre-idle-hook' (setting hook to nil)",
2071 static void push_this_command_keys (Lisp_Object event);
2072 static void push_recent_keys (Lisp_Object event);
2073 static void dribble_out_event (Lisp_Object event);
2074 static void execute_internal_event (Lisp_Object event);
2076 DEFUN ("next-event", Fnext_event, 0, 2, 0, /*
2077 Return the next available event.
2078 Pass this object to `dispatch-event' to handle it.
2079 In most cases, you will want to use `next-command-event', which returns
2080 the next available "user" event (i.e. keypress, button-press,
2081 button-release, or menu selection) instead of this function.
2083 If EVENT is non-nil, it should be an event object and will be filled in
2084 and returned; otherwise a new event object will be created and returned.
2085 If PROMPT is non-nil, it should be a string and will be displayed in the
2086 echo area while this function is waiting for an event.
2088 The next available event will be
2090 -- any events in `unread-command-events' or `unread-command-event'; else
2091 -- the next event in the currently executing keyboard macro, if any; else
2092 -- an event queued by `enqueue-eval-event', if any; else
2093 -- the next available event from the window system or terminal driver.
2095 In the last case, this function will block until an event is available.
2097 The returned event will be one of the following types:
2099 -- a key-press event.
2100 -- a button-press or button-release event.
2101 -- a misc-user-event, meaning the user selected an item on a menu or used
2103 -- a process event, meaning that output from a subprocess is available.
2104 -- a timeout event, meaning that a timeout has elapsed.
2105 -- an eval event, which simply causes a function to be executed when the
2106 event is dispatched. Eval events are generated by `enqueue-eval-event'
2107 or by certain other conditions happening.
2108 -- a magic event, indicating that some window-system-specific event
2109 happened (such as a focus-change notification) that must be handled
2110 synchronously with other events. `dispatch-event' knows what to do with
2115 /* This function can call lisp */
2116 /* #### We start out using the selected console before an event
2117 is received, for echoing the partially completed command.
2118 This is most definitely wrong -- there needs to be a separate
2119 echo area for each console! */
2120 struct console *con = XCONSOLE (Vselected_console);
2121 struct command_builder *command_builder =
2122 XCOMMAND_BUILDER (con->command_builder);
2123 int store_this_key = 0;
2124 struct gcpro gcpro1;
2125 #ifdef LWLIB_MENUBARS_LUCID
2126 extern int in_menu_callback; /* defined in menubar-x.c */
2127 #endif /* LWLIB_MENUBARS_LUCID */
2130 /* DO NOT do QUIT anywhere within this function or the functions it calls.
2131 We want to read the ^G as an event. */
2133 #ifdef LWLIB_MENUBARS_LUCID
2135 * #### Fix the menu code so this isn't necessary.
2137 * We cannot allow the lwmenu code to be reentered, because the
2138 * code is not written to be reentrant and will crash. Therefore
2139 * paths from the menu callbacks back into the menu code have to
2140 * be blocked. Fnext_event is the normal path into the menu code,
2141 * so we signal an error here.
2143 if (in_menu_callback)
2144 error ("Attempt to call next-event inside menu callback");
2145 #endif /* LWLIB_MENUBARS_LUCID */
2148 event = Fmake_event (Qnil, Qnil);
2150 CHECK_LIVE_EVENT (event);
2155 CHECK_STRING (prompt);
2157 len = XSTRING_LENGTH (prompt);
2158 if (command_builder->echo_buf_length < len)
2159 len = command_builder->echo_buf_length - 1;
2160 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len);
2161 command_builder->echo_buf[len] = 0;
2162 command_builder->echo_buf_index = len;
2163 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)),
2164 command_builder->echo_buf,
2166 command_builder->echo_buf_index,
2170 start_over_and_avoid_hosage:
2172 /* If there is something in unread-command-events, simply return it.
2173 But do some error checking to make sure the user hasn't put something
2174 in the unread-command-events that they shouldn't have.
2175 This does not update this-command-keys and recent-keys.
2177 if (!NILP (Vunread_command_events))
2179 if (!CONSP (Vunread_command_events))
2181 Vunread_command_events = Qnil;
2182 signal_error (Qwrong_type_argument,
2183 list3 (Qconsp, Vunread_command_events,
2184 Qunread_command_events));
2188 Lisp_Object e = XCAR (Vunread_command_events);
2189 Vunread_command_events = XCDR (Vunread_command_events);
2190 if (!EVENTP (e) || !command_event_p (e))
2191 signal_error (Qwrong_type_argument,
2192 list3 (Qcommand_event_p, e, Qunread_command_events));
2195 Fcopy_event (e, event);
2196 DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event);
2200 /* Do similar for unread-command-event (obsoleteness support). */
2201 else if (!NILP (Vunread_command_event))
2203 Lisp_Object e = Vunread_command_event;
2204 Vunread_command_event = Qnil;
2206 if (!EVENTP (e) || !command_event_p (e))
2208 signal_error (Qwrong_type_argument,
2209 list3 (Qeventp, e, Qunread_command_event));
2212 Fcopy_event (e, event);
2214 DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event);
2217 /* If we're executing a keyboard macro, take the next event from that,
2218 and update this-command-keys and recent-keys.
2219 Note that the unread-command-events take precedence over kbd macros.
2223 if (!NILP (Vexecuting_macro))
2226 pop_kbd_macro_event (event); /* This throws past us at
2229 DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event);
2231 /* Otherwise, read a real event, possibly from the
2232 command_event_queue, and update this-command-keys and
2236 run_pre_idle_hook ();
2238 next_event_internal (event, 1);
2239 Vquit_flag = Qnil; /* Read C-g as an event. */
2244 status_notify (); /* Notice process change */
2247 alloca (0); /* Cause a garbage collection now */
2248 /* Since we can free the most stuff here
2249 * (since this is typically called from
2250 * the command-loop top-level). */
2251 #endif /* C_ALLOCA */
2253 if (object_dead_p (XEVENT (event)->channel))
2254 /* event_console_or_selected may crash if the channel is dead.
2255 Best just to eat it and get the next event. */
2256 goto start_over_and_avoid_hosage;
2258 /* OK, now we can stop the selected-console kludge and use the
2259 actual console from the event. */
2260 con = event_console_or_selected (event);
2261 command_builder = XCOMMAND_BUILDER (con->command_builder);
2263 switch (XEVENT_TYPE (event))
2267 case button_release_event:
2268 case misc_user_event:
2269 /* don't echo menu accelerator keys */
2270 reset_key_echo (command_builder, 1);
2272 case button_press_event: /* key or mouse input can trigger prompting */
2273 goto STORE_AND_EXECUTE_KEY;
2274 case key_press_event: /* any key input can trigger autosave */
2278 maybe_do_auto_save ();
2280 STORE_AND_EXECUTE_KEY:
2283 echo_key_event (command_builder, event);
2287 /* Store the last-input-event. The semantics of this is that it is
2288 the thing most recently returned by next-command-event. It need
2289 not have come from the keyboard or a keyboard macro, it may have
2290 come from unread-command-events. It's always a command-event (a
2291 key, click, or menu selection), never a motion or process event.
2293 if (!EVENTP (Vlast_input_event))
2294 Vlast_input_event = Fmake_event (Qnil, Qnil);
2295 if (XEVENT_TYPE (Vlast_input_event) == dead_event)
2297 Vlast_input_event = Fmake_event (Qnil, Qnil);
2298 error ("Someone deallocated last-input-event!");
2300 if (! EQ (event, Vlast_input_event))
2301 Fcopy_event (event, Vlast_input_event);
2303 /* last-input-char and last-input-time are derived from
2305 Note that last-input-char will never have its high-bit set, in an
2306 effort to sidestep the ambiguity between M-x and oslash.
2308 Vlast_input_char = Fevent_to_character (Vlast_input_event,
2313 if (!CONSP (Vlast_input_time))
2314 Vlast_input_time = Fcons (Qnil, Qnil);
2315 XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2316 XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2317 if (!CONSP (Vlast_command_event_time))
2318 Vlast_command_event_time = list3 (Qnil, Qnil, Qnil);
2319 XCAR (Vlast_command_event_time) =
2320 make_int ((EMACS_SECS (t) >> 16) & 0xffff);
2321 XCAR (XCDR (Vlast_command_event_time)) =
2322 make_int ((EMACS_SECS (t) >> 0) & 0xffff);
2323 XCAR (XCDR (XCDR (Vlast_command_event_time)))
2324 = make_int (EMACS_USECS (t));
2326 /* If this key came from the keyboard or from a keyboard macro, then
2327 it goes into the recent-keys and this-command-keys vectors.
2328 If this key came from the keyboard, and we're defining a keyboard
2329 macro, then it goes into the macro.
2333 push_this_command_keys (event);
2334 if (!inhibit_input_event_recording)
2335 push_recent_keys (event);
2336 dribble_out_event (event);
2337 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
2339 if (!EVENTP (command_builder->current_events))
2340 finalize_kbd_macro_chars (con);
2341 store_kbd_macro_event (event);
2344 /* If this is the help char and there is a help form, then execute the
2345 help form and swallow this character. This is the only place where
2346 calling Fnext_event() can cause arbitrary lisp code to run. Note
2347 that execute_help_form() calls Fnext_command_event(), which calls
2348 this function, as well as Fdispatch_event.
2350 if (!NILP (Vhelp_form) &&
2351 event_matches_key_specifier_p (XEVENT (event), Vhelp_char))
2352 execute_help_form (command_builder, event);
2359 DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /*
2360 Return the next available "user" event.
2361 Pass this object to `dispatch-event' to handle it.
2363 If EVENT is non-nil, it should be an event object and will be filled in
2364 and returned; otherwise a new event object will be created and returned.
2365 If PROMPT is non-nil, it should be a string and will be displayed in the
2366 echo area while this function is waiting for an event.
2368 The event returned will be a keyboard, mouse press, or mouse release event.
2369 If there are non-command events available (mouse motion, sub-process output,
2370 etc) then these will be executed (with `dispatch-event') and discarded. This
2371 function is provided as a convenience; it is roughly equivalent to the lisp code
2374 (next-event event prompt)
2375 (not (or (key-press-event-p event)
2376 (button-press-event-p event)
2377 (button-release-event-p event)
2378 (misc-user-event-p event))))
2379 (dispatch-event event))
2381 but it also makes a provision for displaying keystrokes in the echo area.
2385 /* This function can GC */
2386 struct gcpro gcpro1;
2388 maybe_echo_keys (XCOMMAND_BUILDER
2389 (XCONSOLE (Vselected_console)->
2390 command_builder), 0); /* #### This sucks bigtime */
2393 event = Fnext_event (event, prompt);
2394 if (command_event_p (event))
2397 execute_internal_event (event);
2404 reset_current_events (struct command_builder *command_builder)
2406 Lisp_Object event = command_builder->current_events;
2407 reset_command_builder_event_chain (command_builder);
2409 deallocate_event_chain (event);
2412 DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /*
2413 Discard any pending "user" events.
2414 Also cancel any kbd macro being defined.
2415 A user event is a key press, button press, button release, or
2416 "misc-user" event (menu selection or scrollbar action).
2420 /* This throws away user-input on the queue, but doesn't process any
2421 events. Calling dispatch_event() here leads to a race condition.
2423 Lisp_Object event = Fmake_event (Qnil, Qnil);
2424 Lisp_Object head = Qnil, tail = Qnil;
2425 Lisp_Object oiq = Vinhibit_quit;
2426 struct gcpro gcpro1, gcpro2;
2427 /* #### not correct here with Vselected_console? Should
2428 discard-input take a console argument, or maybe map over
2430 struct console *con = XCONSOLE (Vselected_console);
2432 /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2433 GCPRO2 (event, oiq);
2435 /* If a macro was being defined then we have to mark the modeline
2436 has changed to ensure that it gets updated correctly. */
2437 if (!NILP (con->defining_kbd_macro))
2438 MARK_MODELINE_CHANGED;
2439 con->defining_kbd_macro = Qnil;
2440 reset_current_events (XCOMMAND_BUILDER (con->command_builder));
2442 while (!NILP (command_event_queue)
2443 || event_stream_event_pending_p (1))
2445 /* This will take stuff off the command_event_queue, or read it
2446 from the event_stream, but it will not block.
2448 next_event_internal (event, 1);
2449 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
2450 It is vitally important that we reset
2451 Vquit_flag here. Otherwise, if we're
2452 reading from a TTY console,
2453 maybe_read_quit_event() will notice
2454 that C-g has been set and send us
2455 another C-g. That will cause us
2456 to get right back here, and read
2457 another C-g, ad infinitum ... */
2459 /* If the event is a user event, ignore it. */
2460 if (!command_event_p (event))
2462 /* Otherwise, chain the event onto our list of events not to ignore,
2463 and keep reading until the queue is empty. This does not mean
2464 that if a subprocess is generating an infinite amount of output,
2465 we will never terminate (*provided* that the behavior of
2466 next_event_cb() is correct -- see the comment in events.h),
2467 because this loop ends as soon as there are no more user events
2468 on the command_event_queue or event_stream.
2470 enqueue_event (Fcopy_event (event, Qnil), &head, &tail);
2474 if (!NILP (command_event_queue) || !NILP (command_event_queue_tail))
2477 /* Now tack our chain of events back on to the front of the queue.
2478 Actually, since the queue is now drained, we can just replace it.
2479 The effect of this will be that we have deleted all user events
2480 from the input stream without changing the relative ordering of
2481 any other events. (Some events may have been taken from the
2482 event_stream and added to the command_event_queue, however.)
2484 At this time, the command_event_queue will contain only eval_events.
2487 command_event_queue = head;
2488 command_event_queue_tail = tail;
2490 Fdeallocate_event (event);
2493 Vinhibit_quit = oiq;
2498 /**********************************************************************/
2499 /* pausing until an action occurs */
2500 /**********************************************************************/
2502 /* This is used in accept-process-output, sleep-for and sit-for.
2503 Before running any process_events in these routines, we set
2504 recursive_sit_for to Qt, and use this unwind protect to reset it to
2505 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will
2506 cause it to return immediately.
2508 All of these routines install timeouts, so we clear the installed
2511 Note: It's very easy to break the desired behaviors of these
2512 3 routines. If you make any changes to anything in this area, run
2513 the regression tests at the bottom of the file. -- dmoore */
2517 sit_for_unwind (Lisp_Object timeout_id)
2519 if (!NILP(timeout_id))
2520 Fdisable_timeout (timeout_id);
2522 recursive_sit_for = Qnil;
2526 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2529 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2530 Allow any pending output from subprocesses to be read by Emacs.
2531 It is read into the process' buffers or given to their filter functions.
2532 Non-nil arg PROCESS means do not return until some output has been received
2533 from PROCESS. Nil arg PROCESS means do not return until some output has
2534 been received from any process.
2535 If the second arg is non-nil, it is the maximum number of seconds to wait:
2536 this function will return after that much time even if no input has arrived
2537 from PROCESS. This argument may be a float, meaning wait some fractional
2539 If the third arg is non-nil, it is a number of milliseconds that is added
2540 to the second arg. (This exists only for compatibility.)
2541 Return non-nil iff we received any output before the timeout expired.
2543 (process, timeout_secs, timeout_msecs))
2545 /* This function can GC */
2546 struct gcpro gcpro1, gcpro2;
2547 Lisp_Object event = Qnil;
2548 Lisp_Object result = Qnil;
2549 int timeout_id = -1;
2550 int timeout_enabled = 0;
2552 struct buffer *old_buffer = current_buffer;
2555 /* We preserve the current buffer but nothing else. If a focus
2556 change alters the selected window then the top level event loop
2557 will eventually alter current_buffer to match. In the mean time
2558 we don't want to mess up whatever called this function. */
2560 if (!NILP (process))
2561 CHECK_PROCESS (process);
2563 GCPRO2 (event, process);
2565 if (!NILP (timeout_secs) || !NILP (timeout_msecs))
2567 unsigned long msecs = 0;
2568 if (!NILP (timeout_secs))
2569 msecs = lisp_number_to_milliseconds (timeout_secs, 1);
2570 if (!NILP (timeout_msecs))
2572 CHECK_NATNUM (timeout_msecs);
2573 msecs += XINT (timeout_msecs);
2577 timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2578 timeout_enabled = 1;
2582 event = Fmake_event (Qnil, Qnil);
2584 count = specpdl_depth ();
2585 record_unwind_protect (sit_for_unwind,
2586 timeout_enabled ? make_int (timeout_id) : Qnil);
2587 recursive_sit_for = Qt;
2590 ((NILP (process) && timeout_enabled) ||
2591 (NILP (process) && event_stream_event_pending_p (0)) ||
2593 /* Calling detect_input_pending() is the wrong thing here, because
2594 that considers the Vunread_command_events and command_event_queue.
2595 We don't need to look at the command_event_queue because we are
2596 only interested in process events, which don't go on that. In
2597 fact, we can't read from it anyway, because we put stuff on it.
2599 Note that event_stream->event_pending_p must be called in such
2600 a way that it says whether any events *of any kind* are ready,
2601 not just user events, or (accept-process-output nil) will fail
2602 to dispatch any process events that may be on the queue. It is
2603 not clear to me that this is important, because the top-level
2604 loop will process it, and I don't think that there is ever a
2605 time when one calls accept-process-output with a nil argument
2606 and really need the processes to be handled. */
2608 /* If our timeout has arrived, we move along. */
2609 if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
2611 timeout_enabled = 0;
2612 done = 1; /* We're done. */
2613 continue; /* Don't call next_event_internal */
2616 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2617 before reading output from the process - this makes it
2618 less likely that the filter will actually be aborted.
2621 next_event_internal (event, 0);
2622 /* If C-g was pressed while we were waiting, Vquit_flag got
2623 set and next_event_internal() also returns C-g. When
2624 we enqueue the C-g below, it will get discarded. The
2625 next time through, QUIT will be called and will signal a quit. */
2626 switch (XEVENT_TYPE (event))
2630 if (NILP (process) ||
2631 EQ (XEVENT (event)->event.process.process, process))
2634 /* RMS's version always returns nil when proc is nil,
2635 and only returns t if input ever arrived on proc. */
2639 execute_internal_event (event);
2643 /* We execute the event even if it's ours, and notice that it's
2645 case pointer_motion_event:
2648 execute_internal_event (event);
2653 enqueue_command_event_1 (event);
2659 unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
2661 Fdeallocate_event (event);
2663 current_buffer = old_buffer;
2667 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
2668 Pause, without updating display, for ARG seconds.
2669 ARG may be a float, meaning pause for some fractional part of a second.
2671 It is recommended that you never call sleep-for from inside of a process
2672 filter function or timer event (either synchronous or asynchronous).
2676 /* This function can GC */
2677 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2679 Lisp_Object event = Qnil;
2681 struct gcpro gcpro1;
2685 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2686 event = Fmake_event (Qnil, Qnil);
2688 count = specpdl_depth ();
2689 record_unwind_protect (sit_for_unwind, make_int (id));
2690 recursive_sit_for = Qt;
2694 /* If our timeout has arrived, we move along. */
2695 if (!event_stream_wakeup_pending_p (id, 0))
2698 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2699 before reading output from the process - this makes it
2700 less likely that the filter will actually be aborted.
2702 /* We're a generator of the command_event_queue, so we can't be a
2703 consumer as well. We don't care about command and eval-events
2706 next_event_internal (event, 0); /* blocks */
2707 /* See the comment in accept-process-output about Vquit_flag */
2708 switch (XEVENT_TYPE (event))
2711 /* We execute the event even if it's ours, and notice that it's
2714 case pointer_motion_event:
2717 execute_internal_event (event);
2722 enqueue_command_event_1 (event);
2728 unbind_to (count, make_int (id));
2729 Fdeallocate_event (event);
2734 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
2735 Perform redisplay, then wait ARG seconds or until user input is available.
2736 ARG may be a float, meaning a fractional part of a second.
2737 Optional second arg non-nil means don't redisplay, just wait for input.
2738 Redisplay is preempted as always if user input arrives, and does not
2739 happen if input is available before it starts.
2740 Value is t if waited the full time with no input arriving.
2742 If sit-for is called from within a process filter function or timer
2743 event (either synchronous or asynchronous) it will return immediately.
2745 (seconds, nodisplay))
2747 /* This function can GC */
2748 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
2749 Lisp_Object event, result;
2750 struct gcpro gcpro1;
2754 /* The unread-command-events count as pending input */
2755 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
2758 /* If the command-builder already has user-input on it (not eval events)
2759 then that means we're done too.
2761 if (!NILP (command_event_queue))
2763 EVENT_CHAIN_LOOP (event, command_event_queue)
2765 if (command_event_p (event))
2770 /* If we're in a macro, or noninteractive, or early in temacs, then
2772 if (noninteractive || !NILP (Vexecuting_macro))
2775 /* Recursive call from a filter function or timeout handler. */
2776 if (!NILP(recursive_sit_for))
2778 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2780 run_pre_idle_hook ();
2787 /* Otherwise, start reading events from the event_stream.
2788 Do this loop at least once even if (sit-for 0) so that we
2789 redisplay when no input pending.
2792 event = Fmake_event (Qnil, Qnil);
2794 /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2795 events get processed. The old (pre-19.12) code special-cased this
2796 and didn't generate a wakeup, but the resulting behavior was less than
2797 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2798 the E-Lisp universe. */
2800 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
2802 count = specpdl_depth ();
2803 record_unwind_protect (sit_for_unwind, make_int (id));
2804 recursive_sit_for = Qt;
2808 /* If there is no user input pending, then redisplay.
2810 if (!event_stream_event_pending_p (1) && NILP (nodisplay))
2812 run_pre_idle_hook ();
2816 /* If our timeout has arrived, we move along. */
2817 if (!event_stream_wakeup_pending_p (id, 0))
2823 QUIT; /* next_event_internal() does not QUIT, so check for ^G
2824 before reading output from the process - this makes it
2825 less likely that the filter will actually be aborted.
2827 /* We're a generator of the command_event_queue, so we can't be a
2828 consumer as well. In fact, we know there's nothing on the
2829 command_event_queue that we didn't just put there.
2831 next_event_internal (event, 0); /* blocks */
2832 /* See the comment in accept-process-output about Vquit_flag */
2834 if (command_event_p (event))
2836 QUIT; /* If the command was C-g check it here
2837 so that we abort out of the sit-for,
2838 not the next command. sleep-for and
2839 accept-process-output continue looping
2840 so they check QUIT again implicitly.*/
2844 switch (XEVENT_TYPE (event))
2848 /* eval-events get delayed until later. */
2849 enqueue_command_event (Fcopy_event (event, Qnil));
2854 /* We execute the event even if it's ours, and notice that it's
2858 execute_internal_event (event);
2865 unbind_to (count, make_int (id));
2867 /* Put back the event (if any) that made Fsit_for() exit before the
2868 timeout. Note that it is being added to the back of the queue, which
2869 would be inappropriate if there were any user events on the queue
2870 already: we would be misordering them. But we know that there are
2871 no user-events on the queue, or else we would not have reached this
2875 enqueue_command_event (event);
2877 Fdeallocate_event (event);
2883 /* This handy little function is used by xselect.c and energize.c to
2884 wait for replies from processes that aren't really processes (that is,
2885 the X server and the Energize server).
2888 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
2890 /* This function can GC */
2891 Lisp_Object event = Fmake_event (Qnil, Qnil);
2892 struct gcpro gcpro1;
2895 while (!(*predicate) (predicate_arg))
2897 QUIT; /* next_event_internal() does not QUIT. */
2899 /* We're a generator of the command_event_queue, so we can't be a
2900 consumer as well. Also, we have no reason to consult the
2901 command_event_queue; there are only user and eval-events there,
2902 and we'd just have to put them back anyway.
2904 next_event_internal (event, 0);
2905 /* See the comment in accept-process-output about Vquit_flag */
2906 if (command_event_p (event)
2907 || (XEVENT_TYPE (event) == eval_event)
2908 || (XEVENT_TYPE (event) == magic_eval_event))
2909 enqueue_command_event_1 (event);
2911 execute_internal_event (event);
2917 /**********************************************************************/
2918 /* dispatching events; command builder */
2919 /**********************************************************************/
2922 execute_internal_event (Lisp_Object event)
2924 /* events on dead channels get silently eaten */
2925 if (object_dead_p (XEVENT (event)->channel))
2928 /* This function can GC */
2929 switch (XEVENT_TYPE (event))
2936 call1 (XEVENT (event)->event.eval.function,
2937 XEVENT (event)->event.eval.object);
2941 case magic_eval_event:
2943 (XEVENT (event)->event.magic_eval.internal_function)
2944 (XEVENT (event)->event.magic_eval.object);
2948 case pointer_motion_event:
2950 if (!NILP (Vmouse_motion_handler))
2951 call1 (Vmouse_motion_handler, event);
2957 Lisp_Object p = XEVENT (event)->event.process.process;
2958 Charcount readstatus;
2960 assert (PROCESSP (p));
2961 while ((readstatus = read_process_output (p)) > 0)
2964 ; /* this clauses never gets executed but allows the #ifdefs
2967 else if (readstatus == -1 && errno == EWOULDBLOCK)
2969 #endif /* EWOULDBLOCK */
2971 else if (readstatus == -1 && errno == EAGAIN)
2974 else if ((readstatus == 0 &&
2975 /* Note that we cannot distinguish between no input
2976 available now and a closed pipe.
2977 With luck, a closed pipe will be accompanied by
2978 subprocess termination and SIGCHLD. */
2979 (!network_connection_p (p) ||
2981 When connected to ToolTalk (i.e.
2982 connected_via_filedesc_p()), it's not possible to
2983 reliably determine whether there is a message
2984 waiting for ToolTalk to receive. ToolTalk expects
2985 to have tt_message_receive() called exactly once
2986 every time the file descriptor becomes active, so
2987 the filter function forces this by returning 0.
2988 Emacs must not interpret this as a closed pipe. */
2989 connected_via_filedesc_p (XPROCESS (p))))
2991 /* On some OSs with ptys, when the process on one end of
2992 a pty exits, the other end gets an error reading with
2993 errno = EIO instead of getting an EOF (0 bytes read).
2994 Therefore, if we get an error reading and errno =
2995 EIO, just continue, because the child process has
2996 exited and should clean itself up soon (e.g. when we
2998 || (readstatus == -1 && errno == EIO)
3002 /* Currently, we rely on SIGCHLD to indicate that the
3003 process has terminated. Unfortunately, on some systems
3004 the SIGCHLD gets missed some of the time. So we put an
3005 additional check in status_notify() to see whether a
3006 process has terminated. We must tell status_notify()
3007 to enable that check, and we do so now. */
3008 kick_status_notify ();
3012 /* Deactivate network connection */
3013 Lisp_Object status = Fprocess_status (p);
3014 if (EQ (status, Qopen)
3015 /* In case somebody changes the theory of whether to
3016 return open as opposed to run for network connection
3018 || EQ (status, Qrun))
3019 update_process_status (p, Qexit, 256, 0);
3020 deactivate_process (p);
3023 /* We must call status_notify here to allow the
3024 event_stream->unselect_process_cb to be run if appropriate.
3025 Otherwise, dead fds may be selected for, and we will get a
3026 continuous stream of process events for them. Since we don't
3027 return until all process events have been flushed, we would
3028 get stuck here, processing events on a process whose status
3029 was 'exit. Call this after dispatch-event, or the fds will
3030 have been closed before we read the last data from them.
3031 It's safe for the filter to signal an error because
3032 status_notify() will be called on return to top-level.
3040 struct Lisp_Event *e = XEVENT (event);
3041 if (!NILP (e->event.timeout.function))
3042 call1 (e->event.timeout.function,
3043 e->event.timeout.object);
3048 event_stream_handle_magic_event (XEVENT (event));
3059 this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain)
3061 Lisp_Object first_before_suffix =
3062 event_chain_find_previous (Vthis_command_keys, suffix);
3064 if (NILP (first_before_suffix))
3065 Vthis_command_keys = chain;
3067 XSET_EVENT_NEXT (first_before_suffix, chain);
3068 deallocate_event_chain (suffix);
3069 Vthis_command_keys_tail = event_chain_tail (chain);
3073 command_builder_replace_suffix (struct command_builder *builder,
3074 Lisp_Object suffix, Lisp_Object chain)
3076 Lisp_Object first_before_suffix =
3077 event_chain_find_previous (builder->current_events, suffix);
3079 if (NILP (first_before_suffix))
3080 builder->current_events = chain;
3082 XSET_EVENT_NEXT (first_before_suffix, chain);
3083 deallocate_event_chain (suffix);
3084 builder->most_current_event = event_chain_tail (chain);
3088 command_builder_find_leaf_1 (struct command_builder *builder)
3090 Lisp_Object event0 = builder->current_events;
3095 return event_binding (event0, 1);
3098 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3102 widget_value *current = lw_get_entries (False);
3103 widget_value *entries = lw_get_entries (True);
3104 widget_value *prev = NULL;
3106 while (entries != current)
3108 if (entries->name /*&& entries->enabled*/) prev = entries;
3109 entries = entries->next;
3114 /* move to last item */
3116 while (entries->next)
3118 if (entries->name /*&& entries->enabled*/) prev = entries;
3119 entries = entries->next;
3123 if (entries->name /*&& entries->enabled*/)
3128 /* no selectable items in this menu, pop up to previous level */
3137 menu_move_down (void)
3139 widget_value *current = lw_get_entries (False);
3140 widget_value *new = current;
3145 if (new->name /*&& new->enabled*/) break;
3148 if (new==current||!(new->name/*||new->enabled*/))
3150 new = lw_get_entries (True);
3151 while (new!=current)
3153 if (new->name /*&& new->enabled*/) break;
3156 if (new==current&&!(new->name /*|| new->enabled*/))
3167 menu_move_left (void)
3169 int level = lw_menu_level ();
3171 widget_value *current;
3173 while (level-- >= 3)
3177 current = lw_get_entries (False);
3178 if (l > 2 && current->contents)
3179 lw_push_menu (current->contents);
3183 menu_move_right (void)
3185 int level = lw_menu_level ();
3187 widget_value *current;
3189 while (level-- >= 3)
3193 current = lw_get_entries (False);
3194 if (l > 2 && current->contents)
3195 lw_push_menu (current->contents);
3199 menu_select_item (widget_value *val)
3202 val = lw_get_entries (False);
3204 /* is match a submenu? */
3208 /* enter the submenu */
3211 lw_push_menu (val->contents);
3215 /* Execute the menu entry by calling the menu's `select'
3218 lw_kill_menus (val);
3223 command_builder_operate_menu_accelerator (struct command_builder *builder)
3225 /* this function can GC */
3227 struct console *con = XCONSOLE (Vselected_console);
3228 Lisp_Object evee = builder->most_current_event;
3229 Lisp_Object binding;
3230 widget_value *entries;
3232 extern int lw_menu_accelerate; /* lwlib.c */
3240 t = builder->current_events;
3245 sprintf (buf,"OPERATE (%d): ",i);
3246 write_c_string (buf, Qexternal_debugging_output);
3247 print_internal (t, Qexternal_debugging_output, 1);
3248 write_c_string ("\n", Qexternal_debugging_output);
3249 t = XEVENT_NEXT (t);
3254 /* menu accelerator keys don't go into keyboard macros */
3255 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3256 con->kbd_macro_ptr = con->kbd_macro_end;
3258 /* don't echo menu accelerator keys */
3259 /*reset_key_echo (builder, 1);*/
3261 if (!lw_menu_accelerate)
3263 /* `convert' mouse display to keyboard display
3264 by entering the open submenu
3266 entries = lw_get_entries (False);
3267 if (entries->contents)
3269 lw_push_menu (entries->contents);
3270 lw_display_menu (CurrentTime);
3274 /* compare event to the current menu accelerators */
3276 entries=lw_get_entries (True);
3281 VOID_TO_LISP (accel, entries->accel);
3282 if (entries->name && !NILP (accel))
3284 if (event_matches_key_specifier_p (XEVENT (evee), accel))
3288 menu_select_item (entries);
3290 if (lw_menu_active) lw_display_menu (CurrentTime);
3292 reset_this_command_keys (Vselected_console, 1);
3293 /*reset_command_builder_event_chain (builder);*/
3294 return Vmenu_accelerator_map;
3297 entries = entries->next;
3300 /* try to look up event in menu-accelerator-map */
3302 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
3306 /* beep at user for undefined key */
3311 if (EQ (binding, Qmenu_quit))
3313 /* turn off menus and set quit flag */
3314 lw_kill_menus (NULL);
3317 else if (EQ (binding, Qmenu_up))
3319 int level = lw_menu_level ();
3323 else if (EQ (binding, Qmenu_down))
3325 int level = lw_menu_level ();
3329 menu_select_item (NULL);
3331 else if (EQ (binding, Qmenu_left))
3333 int level = lw_menu_level ();
3337 lw_display_menu (CurrentTime);
3342 else if (EQ (binding, Qmenu_right))
3344 int level = lw_menu_level ();
3346 lw_get_entries (False)->contents)
3348 widget_value *current = lw_get_entries (False);
3349 if (current->contents)
3350 menu_select_item (NULL);
3355 else if (EQ (binding, Qmenu_select))
3356 menu_select_item (NULL);
3357 else if (EQ (binding, Qmenu_escape))
3359 int level = lw_menu_level ();
3364 lw_display_menu (CurrentTime);
3368 /* turn off menus quietly */
3369 lw_kill_menus (NULL);
3372 else if (KEYMAPP (binding))
3375 reset_this_command_keys (Vselected_console, 1);
3376 /*reset_command_builder_event_chain (builder);*/
3381 /* turn off menus and execute binding */
3382 lw_kill_menus (NULL);
3383 reset_this_command_keys (Vselected_console, 1);
3384 /*reset_command_builder_event_chain (builder);*/
3389 if (lw_menu_active) lw_display_menu (CurrentTime);
3391 reset_this_command_keys (Vselected_console, 1);
3392 /*reset_command_builder_event_chain (builder);*/
3394 return Vmenu_accelerator_map;
3398 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
3400 Vmenu_accelerator_prefix = Qnil;
3401 Vmenu_accelerator_modifiers = Qnil;
3402 Vmenu_accelerator_enabled = Qnil;
3403 if (!NILP (errordata))
3405 Lisp_Object args[2];
3407 args[0] = build_string ("Error in menu accelerators (setting to nil)");
3408 /* #### This should call
3409 (with-output-to-string (display-error errordata))
3410 but that stuff is all in Lisp currently. */
3411 args[1] = errordata;
3412 warn_when_safe_lispobj
3414 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
3415 Qnil, -1, 2, args));
3422 menu_accelerator_safe_compare (Lisp_Object event0)
3424 if (CONSP (Vmenu_accelerator_prefix))
3427 t=Vmenu_accelerator_prefix;
3430 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
3433 event0 = XEVENT_NEXT (event0);
3438 else if (NILP (event0))
3440 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
3441 event0 = XEVENT_NEXT (event0);
3448 menu_accelerator_safe_mod_compare (Lisp_Object cons)
3450 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
3456 command_builder_find_menu_accelerator (struct command_builder *builder)
3458 /* this function can GC */
3459 Lisp_Object event0 = builder->current_events;
3460 struct console *con = XCONSOLE (Vselected_console);
3461 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3462 Widget menubar_widget;
3464 /* compare entries in event0 against the menu prefix */
3466 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
3467 XEVENT (event0)->event_type != key_press_event)
3470 if (!NILP (Vmenu_accelerator_prefix))
3472 event0 = condition_case_1 (Qerror,
3473 menu_accelerator_safe_compare,
3475 menu_accelerator_junk_on_error,
3482 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3484 && CONSP (Vmenu_accelerator_modifiers))
3487 Lisp_Object last = Qnil;
3488 struct gcpro gcpro1;
3492 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
3494 val = lw_get_all_values (id);
3497 val = val->contents;
3499 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
3502 while (!NILP (Fcdr (last)))
3505 Fsetcdr (last, Fcons (Qnil, Qnil));
3509 fake = Fcons (Qnil, fake);
3516 VOID_TO_LISP (accel, val->accel);
3517 if (val->name && !NILP (accel))
3519 Fsetcar (last, accel);
3520 Fsetcar (fake, event0);
3521 matchp = condition_case_1 (Qerror,
3522 menu_accelerator_safe_mod_compare,
3524 menu_accelerator_junk_on_error,
3530 lw_set_menu (menubar_widget, val);
3531 /* yah - yet another hack.
3532 pretend emacs timestamp is the same as an X timestamp,
3533 which for the moment it is. (read events.h)
3535 lw_map_menu (XEVENT (event0)->timestamp);
3538 lw_push_menu (val->contents);
3540 lw_display_menu (CurrentTime);
3542 /* menu accelerator keys don't go into keyboard macros */
3543 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3544 con->kbd_macro_ptr = con->kbd_macro_end;
3546 /* don't echo menu accelerator keys */
3547 /*reset_key_echo (builder, 1);*/
3548 reset_this_command_keys (Vselected_console, 1);
3551 return Vmenu_accelerator_map;
3564 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
3565 Make the menubar active. Menu items can be selected using menu accelerators
3566 or by actions defined in menu-accelerator-map.
3570 struct console *con = XCONSOLE (Vselected_console);
3571 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
3575 if (NILP (f->menubar_data))
3576 error ("Frame has no menubar.");
3578 id = XPOPUP_DATA (f->menubar_data)->id;
3579 val = lw_get_all_values (id);
3580 val = val->contents;
3581 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
3582 lw_map_menu (CurrentTime);
3584 lw_display_menu (CurrentTime);
3586 /* menu accelerator keys don't go into keyboard macros */
3587 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
3588 con->kbd_macro_ptr = con->kbd_macro_end;
3592 #endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */
3594 /* See if we can do function-key-map or key-translation-map translation
3595 on the current events in the command builder. If so, do this, and
3596 return the resulting binding, if any. */
3599 munge_keymap_translate (struct command_builder *builder,
3600 enum munge_me_out_the_door munge,
3601 int has_normal_binding_p)
3605 EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event)
3607 Lisp_Object result = munging_key_map_event_binding (suffix, munge);
3612 if (KEYMAPP (result))
3614 if (NILP (builder->last_non_munged_event)
3615 && !has_normal_binding_p)
3616 builder->last_non_munged_event = builder->most_current_event;
3619 builder->last_non_munged_event = Qnil;
3621 if (!KEYMAPP (result) &&
3622 !VECTORP (result) &&
3625 struct gcpro gcpro1;
3627 result = call1 (result, Qnil);
3633 if (KEYMAPP (result))
3636 if (VECTORP (result) || STRINGP (result))
3638 Lisp_Object new_chain = key_sequence_to_event_chain (result);
3642 /* If the first_mungeable_event of the other munger is
3643 within the events we're munging, then it will point to
3644 deallocated events afterwards, which is bad -- so make it
3645 point at the beginning of the munged events. */
3646 EVENT_CHAIN_LOOP (tempev, suffix)
3648 Lisp_Object *mungeable_event =
3649 &builder->munge_me[1 - munge].first_mungeable_event;
3650 if (EQ (tempev, *mungeable_event))
3652 *mungeable_event = new_chain;
3657 n = event_chain_count (suffix);
3658 command_builder_replace_suffix (builder, suffix, new_chain);
3659 builder->munge_me[munge].first_mungeable_event = Qnil;
3660 /* Now hork this-command-keys as well. */
3662 /* We just assume that the events we just replaced are
3663 sitting in copied form at the end of this-command-keys.
3664 If the user did weird things with `dispatch-event' this
3665 may not be the case, but at least we make sure we won't
3667 new_chain = copy_event_chain (new_chain);
3668 tckn = event_chain_count (Vthis_command_keys);
3671 this_command_keys_replace_suffix
3672 (event_chain_nth (Vthis_command_keys, tckn - n),
3676 result = command_builder_find_leaf_1 (builder);
3680 signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ?
3681 "Invalid binding in function-key-map" :
3682 "Invalid binding in key-translation-map"),
3689 /* Compare the current state of the command builder against the local and
3690 global keymaps, and return the binding. If there is no match, try again,
3691 case-insensitively. The return value will be one of:
3692 -- nil (there is no binding)
3693 -- a keymap (part of a command has been specified)
3694 -- a command (anything that satisfies `commandp'; this includes
3695 some symbols, lists, subrs, strings, vectors, and
3696 compiled-function objects)
3699 command_builder_find_leaf (struct command_builder *builder,
3700 int allow_misc_user_events_p)
3702 /* This function can GC */
3704 Lisp_Object evee = builder->current_events;
3706 if (XEVENT_TYPE (evee) == misc_user_event)
3708 if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee))))
3709 return list2 (XEVENT (evee)->event.eval.function,
3710 XEVENT (evee)->event.eval.object);
3715 /* if we're currently in a menu accelerator, check there for further events */
3716 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3719 return command_builder_operate_menu_accelerator (builder);
3724 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
3725 result = command_builder_find_menu_accelerator (builder);
3728 result = command_builder_find_leaf_1 (builder);
3729 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3731 && EQ (Vmenu_accelerator_enabled, Qmenu_fallback))
3732 result = command_builder_find_menu_accelerator (builder);
3736 /* Check to see if we have a potential function-key-map match. */
3739 result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0);
3740 regenerate_echo_keys_from_this_command_keys (builder);
3742 /* Check to see if we have a potential key-translation-map match. */
3744 Lisp_Object key_translate_result =
3745 munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION,
3747 if (!NILP (key_translate_result))
3749 result = key_translate_result;
3750 regenerate_echo_keys_from_this_command_keys (builder);
3757 /* If key-sequence wasn't bound, we'll try some fallbacks. */
3759 /* If we didn't find a binding, and the last event in the sequence is
3760 a shifted character, then try again with the lowercase version. */
3762 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3763 && !NILP (Vretry_undefined_key_binding_unshifted))
3765 Lisp_Object terminal = builder->most_current_event;
3766 struct key_data* key = & XEVENT (terminal)->event.key;
3768 if ((key->modifiers & MOD_SHIFT)
3769 || (CHAR_OR_CHAR_INTP (key->keysym)
3770 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
3772 struct Lisp_Event terminal_copy = *XEVENT (terminal);
3774 if (key->modifiers & MOD_SHIFT)
3775 key->modifiers &= (~ MOD_SHIFT);
3777 key->keysym = make_char (c + 'a' - 'A');
3779 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
3782 /* If there was no match with the lower-case version either,
3783 then put back the upper-case event for the error
3784 message. But make sure that function-key-map didn't
3785 change things out from under us. */
3786 if (EQ (terminal, builder->most_current_event))
3787 *XEVENT (terminal) = terminal_copy;
3791 /* help-char is `auto-bound' in every keymap */
3792 if (!NILP (Vprefix_help_command) &&
3793 event_matches_key_specifier_p (XEVENT (builder->most_current_event),
3795 return Vprefix_help_command;
3798 /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3799 if (XEVENT_TYPE (builder->most_current_event) == key_press_event
3800 && !NILP (Vcomposed_character_default_binding))
3802 Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
3803 if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
3804 return Vcomposed_character_default_binding;
3806 #endif /* HAVE_XIM */
3808 /* If we read extra events attempting to match a function key but end
3809 up failing, then we release those events back to the command loop
3810 and fail on the original lookup. The released events will then be
3811 reprocessed in the context of the first part having failed. */
3812 if (!NILP (builder->last_non_munged_event))
3814 Lisp_Object event0 = builder->last_non_munged_event;
3816 /* Put the commands back on the event queue. */
3817 enqueue_event_chain (XEVENT_NEXT (event0),
3818 &command_event_queue,
3819 &command_event_queue_tail);
3821 /* Then remove them from the command builder. */
3822 XSET_EVENT_NEXT (event0, Qnil);
3823 builder->most_current_event = event0;
3824 builder->last_non_munged_event = Qnil;
3831 /* Every time a command-event (a key, button, or menu selection) is read by
3832 Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3833 and in Vthis_command_keys. (Eval-events are not stored there.)
3835 Every time a command is invoked, Vlast_command_event is set to the last
3836 event in the sequence.
3838 This means that Vthis_command_keys is really about "input read since the
3839 last command was executed" rather than about "what keys invoked this
3840 command." This is a little counterintuitive, but that's the way it
3843 As an extra kink, the function read-key-sequence resets/updates the
3844 last-command-event and this-command-keys. It doesn't append to the
3845 command-keys as read-char does. Such are the pitfalls of having to
3846 maintain compatibility with a program for which the only specification
3849 (We could implement recent_keys_ring and Vthis_command_keys as the same
3853 DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /*
3854 Return a vector of recent keyboard or mouse button events read.
3855 If NUMBER is non-nil, not more than NUMBER events will be returned.
3856 Change number of events stored using `set-recent-keys-ring-size'.
3858 This copies the event objects into a new vector; it is safe to keep and
3863 struct gcpro gcpro1;
3864 Lisp_Object val = Qnil;
3866 int start, nkeys, i, j;
3870 nwanted = recent_keys_ring_size;
3873 CHECK_NATNUM (number);
3874 nwanted = XINT (number);
3877 /* Create the keys ring vector, if none present. */
3878 if (NILP (Vrecent_keys_ring))
3880 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
3881 /* And return nothing in particular. */
3882 return make_vector (0, Qnil);
3885 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3886 /* This means the vector has not yet wrapped */
3888 nkeys = recent_keys_ring_index;
3893 nkeys = recent_keys_ring_size;
3894 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3897 if (nwanted < nkeys)
3899 start += nkeys - nwanted;
3900 if (start >= recent_keys_ring_size)
3901 start -= recent_keys_ring_size;
3907 val = make_vector (nwanted, Qnil);
3909 for (i = 0, j = start; i < nkeys; i++)
3911 Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j];
3915 XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil);
3916 if (++j >= recent_keys_ring_size)
3924 DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3925 The maximum number of events `recent-keys' can return.
3929 return make_int (recent_keys_ring_size);
3932 DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3933 Set the maximum number of events to be stored internally.
3937 Lisp_Object new_vector = Qnil;
3938 int i, j, nkeys, start, min;
3939 struct gcpro gcpro1;
3940 GCPRO1 (new_vector);
3943 if (XINT (size) <= 0)
3944 error ("Recent keys ring size must be positive");
3945 if (XINT (size) == recent_keys_ring_size)
3948 new_vector = make_vector (XINT (size), Qnil);
3950 if (NILP (Vrecent_keys_ring))
3952 Vrecent_keys_ring = new_vector;
3956 if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index]))
3957 /* This means the vector has not yet wrapped */
3959 nkeys = recent_keys_ring_index;
3964 nkeys = recent_keys_ring_size;
3965 start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index);
3968 if (XINT (size) > nkeys)
3973 for (i = 0, j = start; i < min; i++)
3975 XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j];
3976 if (++j >= recent_keys_ring_size)
3979 recent_keys_ring_size = XINT (size);
3980 recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3982 Vrecent_keys_ring = new_vector;
3988 /* Vthis_command_keys having value Qnil means that the next time
3989 push_this_command_keys is called, it should start over.
3990 The times at which the command-keys are reset
3991 (instead of merely being augmented) are pretty counterintuitive.
3994 -- We do not reset this-command-keys when we finish reading a
3995 command. This is because some commands (e.g. C-u) act
3996 like command prefixes; they signal this by setting prefix-arg
3998 -- Therefore, we reset this-command-keys when we finish
3999 executing a command, unless prefix-arg is set.
4000 -- However, if we ever do a non-local exit out of a command
4001 loop (e.g. an error in a command), we need to reset
4002 this-command-keys. We do this by calling reset_this_command_keys()
4003 from cmdloop.c, whenever an error causes an invocation of the
4004 default error handler, and whenever there's a throw to top-level.)
4008 reset_this_command_keys (Lisp_Object console, int clear_echo_area_p)
4010 struct command_builder *command_builder =
4011 XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4013 reset_key_echo (command_builder, clear_echo_area_p);
4015 deallocate_event_chain (Vthis_command_keys);
4016 Vthis_command_keys = Qnil;
4017 Vthis_command_keys_tail = Qnil;
4019 reset_current_events (command_builder);
4023 push_this_command_keys (Lisp_Object event)
4025 Lisp_Object new = Fmake_event (Qnil, Qnil);
4027 Fcopy_event (event, new);
4028 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail);
4031 /* The following two functions are used in call-interactively,
4032 for the @ and e specifications. We used to just use
4033 `current-mouse-event' (i.e. the last mouse event in this-command-keys),
4034 but FSF does it more generally so we follow their lead. */
4037 extract_this_command_keys_nth_mouse_event (int n)
4041 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4044 && (XEVENT_TYPE (event) == button_press_event
4045 || XEVENT_TYPE (event) == button_release_event
4046 || XEVENT_TYPE (event) == misc_user_event))
4050 /* must copy to avoid an abort() in next_event_internal() */
4051 if (!NILP (XEVENT_NEXT (event)))
4052 return Fcopy_event (event, Qnil);
4064 extract_vector_nth_mouse_event (Lisp_Object vector, int n)
4067 int len = XVECTOR_LENGTH (vector);
4069 for (i = 0; i < len; i++)
4071 Lisp_Object event = XVECTOR_DATA (vector)[i];
4073 switch (XEVENT_TYPE (event))
4075 case button_press_event :
4076 case button_release_event :
4077 case misc_user_event :
4091 push_recent_keys (Lisp_Object event)
4095 if (NILP (Vrecent_keys_ring))
4096 Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil);
4098 e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index];
4102 e = Fmake_event (Qnil, Qnil);
4103 XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e;
4105 Fcopy_event (event, e);
4106 if (++recent_keys_ring_index == recent_keys_ring_size)
4107 recent_keys_ring_index = 0;
4112 current_events_into_vector (struct command_builder *command_builder)
4116 int n = event_chain_count (command_builder->current_events);
4118 /* Copy the vector and the events in it. */
4119 /* No need to copy the events, since they're already copies, and
4120 nobody other than the command-builder has pointers to them */
4121 vector = make_vector (n, Qnil);
4123 EVENT_CHAIN_LOOP (event, command_builder->current_events)
4124 XVECTOR_DATA (vector)[n++] = event;
4125 reset_command_builder_event_chain (command_builder);
4131 Given the current state of the command builder and a new command event
4132 that has just been dispatched:
4134 -- add the event to the event chain forming the current command
4135 (doing meta-translation as necessary)
4136 -- return the binding of this event chain; this will be one of:
4137 -- nil (there is no binding)
4138 -- a keymap (part of a command has been specified)
4139 -- a command (anything that satisfies `commandp'; this includes
4140 some symbols, lists, subrs, strings, vectors, and
4141 compiled-function objects)
4144 lookup_command_event (struct command_builder *command_builder,
4145 Lisp_Object event, int allow_misc_user_events_p)
4147 /* This function can GC */
4148 struct frame *f = selected_frame ();
4149 /* Clear output from previous command execution */
4150 if (!EQ (Qcommand, echo_area_status (f))
4151 /* but don't let mouse-up clear what mouse-down just printed */
4152 && (XEVENT (event)->event_type != button_release_event))
4153 clear_echo_area (f, Qnil, 0);
4155 /* Add the given event to the command builder.
4156 Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
4157 vectors to translate "ESC x" to "M-x" (for any "x" of course).
4160 Lisp_Object recent = command_builder->most_current_event;
4163 && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
4165 struct Lisp_Event *e;
4166 /* When we see a sequence like "ESC x", pretend we really saw "M-x".
4167 DoubleThink the recent-keys and this-command-keys as well. */
4169 /* Modify the previous most-recently-pushed event on the command
4170 builder to be a copy of this one with the meta-bit set instead of
4171 pushing a new event.
4173 Fcopy_event (event, recent);
4174 e = XEVENT (recent);
4175 if (e->event_type == key_press_event)
4176 e->event.key.modifiers |= MOD_META;
4177 else if (e->event_type == button_press_event
4178 || e->event_type == button_release_event)
4179 e->event.button.modifiers |= MOD_META;
4184 int tckn = event_chain_count (Vthis_command_keys);
4186 /* ??? very strange if it's < 2. */
4187 this_command_keys_replace_suffix
4188 (event_chain_nth (Vthis_command_keys, tckn - 2),
4189 Fcopy_event (recent, Qnil));
4192 regenerate_echo_keys_from_this_command_keys (command_builder);
4196 event = Fcopy_event (event, Fmake_event (Qnil, Qnil));
4198 command_builder_append_event (command_builder, event);
4203 Lisp_Object leaf = command_builder_find_leaf (command_builder,
4204 allow_misc_user_events_p);
4205 struct gcpro gcpro1;
4210 if (!lw_menu_active)
4212 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
4213 if (STRINGP (prompt))
4215 /* Append keymap prompt to key echo buffer */
4216 int buf_index = command_builder->echo_buf_index;
4217 Bytecount len = XSTRING_LENGTH (prompt);
4219 if (len + buf_index + 1 <= command_builder->echo_buf_length)
4221 Bufbyte *echo = command_builder->echo_buf + buf_index;
4222 memcpy (echo, XSTRING_DATA (prompt), len);
4225 maybe_echo_keys (command_builder, 1);
4228 maybe_echo_keys (command_builder, 0);
4230 else if (!NILP (Vquit_flag)) {
4231 Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
4232 struct Lisp_Event *e = XEVENT (quit_event);
4233 /* if quit happened during menu acceleration, pretend we read it */
4234 struct console *con = XCONSOLE (Fselected_console ());
4235 int ch = CONSOLE_QUIT_CHAR (con);
4237 character_to_event (ch, e, con, 1, 1);
4238 e->channel = make_console (con);
4240 enqueue_command_event (quit_event);
4244 else if (!NILP (leaf))
4246 if (EQ (Qcommand, echo_area_status (f))
4247 && command_builder->echo_buf_index > 0)
4249 /* If we had been echoing keys, echo the last one (without
4250 the trailing dash) and redisplay before executing the
4252 command_builder->echo_buf[command_builder->echo_buf_index] = 0;
4253 maybe_echo_keys (command_builder, 1);
4254 Fsit_for (Qzero, Qt);
4257 RETURN_UNGCPRO (leaf);
4262 execute_command_event (struct command_builder *command_builder,
4265 /* This function can GC */
4266 struct console *con = XCONSOLE (command_builder->console);
4267 struct gcpro gcpro1;
4269 GCPRO1 (event); /* event may be freshly created */
4270 reset_current_events (command_builder);
4272 switch (XEVENT (event)->event_type)
4274 case key_press_event:
4275 Vcurrent_mouse_event = Qnil;
4277 case button_press_event:
4278 case button_release_event:
4279 case misc_user_event:
4280 Vcurrent_mouse_event = Fcopy_event (event, Qnil);
4285 /* Store the last-command-event. The semantics of this is that it
4286 is the last event most recently involved in command-lookup. */
4287 if (!EVENTP (Vlast_command_event))
4288 Vlast_command_event = Fmake_event (Qnil, Qnil);
4289 if (XEVENT (Vlast_command_event)->event_type == dead_event)
4291 Vlast_command_event = Fmake_event (Qnil, Qnil);
4292 error ("Someone deallocated the last-command-event!");
4295 if (! EQ (event, Vlast_command_event))
4296 Fcopy_event (event, Vlast_command_event);
4298 /* Note that last-command-char will never have its high-bit set, in
4299 an effort to sidestep the ambiguity between M-x and oslash. */
4300 Vlast_command_char = Fevent_to_character (Vlast_command_event,
4303 /* Actually call the command, with all sorts of hair to preserve or clear
4304 the echo-area and region as appropriate and call the pre- and post-
4307 int old_kbd_macro = con->kbd_macro_end;
4308 struct window *w = XWINDOW (Fselected_window (Qnil));
4310 /* We're executing a new command, so the old value is irrelevant. */
4311 zmacs_region_stays = 0;
4313 /* If the previous command tried to force a specific window-start,
4314 reset the flag in case this command moves point far away from
4315 that position. Also, reset the window's buffer's change
4316 information so that we don't trigger an incremental update. */
4320 buffer_reset_changes (XBUFFER (w->buffer));
4323 pre_command_hook ();
4325 if (XEVENT (event)->event_type == misc_user_event)
4327 call1 (XEVENT (event)->event.eval.function,
4328 XEVENT (event)->event.eval.object);
4332 Fcommand_execute (Vthis_command, Qnil, Qnil);
4335 post_command_hook ();
4337 #if 0 /* #### here was an attempted fix that didn't work */
4338 if (XEVENT (event)->event_type == misc_user_event)
4342 if (!NILP (con->prefix_arg))
4344 /* Commands that set the prefix arg don't update last-command, don't
4345 reset the echoing state, and don't go into keyboard macros unless
4346 followed by another command. */
4347 maybe_echo_keys (command_builder, 0);
4349 /* If we're recording a keyboard macro, and the last command
4350 executed set a prefix argument, then decrement the pointer to
4351 the "last character really in the macro" to be just before this
4352 command. This is so that the ^U in "^U ^X )" doesn't go onto
4353 the end of macro. */
4354 if (!NILP (con->defining_kbd_macro))
4355 con->kbd_macro_end = old_kbd_macro;
4359 /* Start a new command next time */
4360 Vlast_command = Vthis_command;
4361 /* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
4362 so we don't either */
4363 reset_this_command_keys (make_console (con), 0);
4370 /* Run the pre command hook. */
4373 pre_command_hook (void)
4375 last_point_position = BUF_PT (current_buffer);
4376 XSETBUFFER (last_point_position_buffer, current_buffer);
4377 /* This function can GC */
4378 safe_run_hook_trapping_errors
4379 ("Error in `pre-command-hook' (setting hook to nil)",
4380 Qpre_command_hook, 1);
4383 /* Run the post command hook. */
4386 post_command_hook (void)
4388 /* This function can GC */
4389 /* Turn off region highlighting unless this command requested that
4390 it be left on, or we're in the minibuffer. We don't turn it off
4391 when we're in the minibuffer so that things like M-x write-region
4394 This could be done via a function on the post-command-hook, but
4395 we don't want the user to accidentally remove it.
4398 Lisp_Object win = Fselected_window (Qnil);
4401 /* If the last command deleted the frame, `win' might be nil.
4402 It seems safest to do nothing in this case. */
4403 /* ### This doesn't really fix the problem,
4404 if delete-frame is called by some hook */
4409 if (! zmacs_region_stays
4410 && (!MINI_WINDOW_P (XWINDOW (win))
4411 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
4412 zmacs_deactivate_region ();
4414 zmacs_update_region ();
4416 safe_run_hook_trapping_errors
4417 ("Error in `post-command-hook' (setting hook to nil)",
4418 Qpost_command_hook, 1);
4420 #ifdef DEFERRED_ACTION_CRAP
4421 if (!NILP (Vdeferred_action_list))
4422 call0 (Vdeferred_action_function);
4425 #ifdef ILL_CONCEIVED_HOOK
4426 if (NILP (Vunread_command_events)
4427 && NILP (Vexecuting_macro)
4428 && !NILP (Vpost_command_idle_hook)
4429 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
4431 safe_run_hook_trapping_errors
4432 ("Error in `post-command-idle-hook' (setting hook to nil)",
4433 Qpost_command_idle_hook, 1);
4437 if (!NILP (current_buffer->mark_active))
4439 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
4441 current_buffer->mark_active = Qnil;
4442 run_hook (intern ("deactivate-mark-hook"));
4444 else if (current_buffer != prev_buffer ||
4445 BUF_MODIFF (current_buffer) != prev_modiff)
4446 run_hook (intern ("activate-mark-hook"));
4448 #endif /* FSFmacs */
4450 /* #### Kludge!!! This is necessary to make sure that things
4451 are properly positioned even if post-command-hook moves point.
4452 #### There should be a cleaner way of handling this. */
4453 call0 (Qauto_show_make_point_visible);
4457 DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /*
4458 Given an event object as returned by `next-event', execute it.
4460 Key-press, button-press, and button-release events get accumulated
4461 until a complete key sequence (see `read-key-sequence') is reached,
4462 at which point the sequence is looked up in the current keymaps and
4465 Mouse motion events cause the low-level handling function stored in
4466 `mouse-motion-handler' to be called. (There are very few circumstances
4467 under which you should change this handler. Use `mode-motion-hook'
4470 Menu, timeout, and eval events cause the associated function or handler
4473 Process events cause the subprocess's output to be read and acted upon
4474 appropriately (see `start-process').
4476 Magic events are handled as necessary.
4480 /* This function can GC */
4481 struct command_builder *command_builder;
4482 struct Lisp_Event *ev;
4483 Lisp_Object console;
4484 Lisp_Object channel;
4486 CHECK_LIVE_EVENT (event);
4487 ev = XEVENT (event);
4489 /* events on dead channels get silently eaten */
4490 channel = EVENT_CHANNEL (ev);
4491 if (object_dead_p (channel))
4494 /* Some events don't have channels (e.g. eval events). */
4495 console = CDFW_CONSOLE (channel);
4497 console = Vselected_console;
4498 else if (!EQ (console, Vselected_console))
4499 Fselect_console (console);
4501 command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder);
4502 switch (XEVENT (event)->event_type)
4504 case button_press_event:
4505 case button_release_event:
4506 case key_press_event:
4508 Lisp_Object leaf = lookup_command_event (command_builder, event, 1);
4511 /* Incomplete key sequence */
4515 /* At this point, we know that the sequence is not bound to a
4516 command. Normally, we beep and print a message informing the
4517 user of this. But we do not beep or print a message when:
4519 o the last event in this sequence is a mouse-up event; or
4520 o the last event in this sequence is a mouse-down event and
4521 there is a binding for the mouse-up version.
4523 That is, if the sequence ``C-x button1'' is typed, and is not
4524 bound to a command, but the sequence ``C-x button1up'' is bound
4525 to a command, we do not complain about the ``C-x button1''
4526 sequence. If neither ``C-x button1'' nor ``C-x button1up'' is
4527 bound to a command, then we complain about the ``C-x button1''
4528 sequence, but later will *not* complain about the
4529 ``C-x button1up'' sequence, which would be redundant.
4531 This is pretty hairy, but I think it's the most intuitive
4534 Lisp_Object terminal = command_builder->most_current_event;
4536 if (XEVENT_TYPE (terminal) == button_press_event)
4539 /* Temporarily pretend the last event was an "up" instead of a
4540 "down", and look up its binding. */
4541 XEVENT_TYPE (terminal) = button_release_event;
4542 /* If the "up" version is bound, don't complain. */
4544 = !NILP (command_builder_find_leaf (command_builder, 0));
4545 /* Undo the temporary changes we just made. */
4546 XEVENT_TYPE (terminal) = button_press_event;
4549 /* Pretend this press was not seen (treat as a prefix) */
4550 if (EQ (command_builder->current_events, terminal))
4552 reset_current_events (command_builder);
4558 EVENT_CHAIN_LOOP (eve, command_builder->current_events)
4559 if (EQ (XEVENT_NEXT (eve), terminal))
4562 Fdeallocate_event (command_builder->
4563 most_current_event);
4564 XSET_EVENT_NEXT (eve, Qnil);
4565 command_builder->most_current_event = eve;
4567 maybe_echo_keys (command_builder, 1);
4572 /* Complain that the typed sequence is not defined, if this is the
4573 kind of sequence that warrants a complaint. */
4574 XCONSOLE (console)->defining_kbd_macro = Qnil;
4575 XCONSOLE (console)->prefix_arg = Qnil;
4576 /* Don't complain about undefined button-release events */
4577 if (XEVENT_TYPE (terminal) != button_release_event)
4579 Lisp_Object keys = current_events_into_vector (command_builder);
4580 struct gcpro gcpro1;
4582 /* Run the pre-command-hook before barfing about an undefined
4584 Vthis_command = Qnil;
4586 pre_command_hook ();
4588 /* The post-command-hook doesn't run. */
4589 Fsignal (Qundefined_keystroke_sequence, list1 (keys));
4591 /* Reset the command builder for reading the next sequence. */
4592 reset_this_command_keys (console, 1);
4594 else /* key sequence is bound to a command */
4597 int magic_undo_count = 20;
4599 Vthis_command = leaf;
4601 /* Don't push an undo boundary if the command set the prefix arg,
4602 or if we are executing a keyboard macro, or if in the
4603 minibuffer. If the command we are about to execute is
4604 self-insert, it's tricky: up to 20 consecutive self-inserts may
4605 be done without an undo boundary. This counter is reset as
4606 soon as a command other than self-insert-command is executed.
4608 Programmers can also use the `self-insert-undo-magic'
4609 property to install that behaviour on functions other
4610 than `self-insert-command', or to change the magic
4611 number 20 to something else. */
4615 Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
4617 magic_undo = 1, magic_undo_count = XINT (prop);
4618 else if (!NILP (prop))
4620 else if (EQ (leaf, Qself_insert_command))
4625 command_builder->self_insert_countdown = 0;
4626 if (NILP (XCONSOLE (console)->prefix_arg)
4627 && NILP (Vexecuting_macro)
4629 /* This was done in the days when there was no undo
4630 in the minibuffer. If we don't disable this code,
4631 then each instance of "undo" undoes everything in
4633 && !EQ (minibuf_window, Fselected_window (Qnil))
4635 && command_builder->self_insert_countdown == 0)
4640 if (--command_builder->self_insert_countdown < 0)
4641 command_builder->self_insert_countdown = magic_undo_count;
4643 execute_command_event
4645 internal_equal (event, command_builder-> most_current_event, 0)
4647 /* Use the translated event that was most recently seen.
4648 This way, last-command-event becomes f1 instead of
4649 the P from ESC O P. But we must copy it, else we'll
4650 lose when the command-builder events are deallocated. */
4651 : Fcopy_event (command_builder-> most_current_event, Qnil));
4655 case misc_user_event:
4659 We could just always use the menu item entry, whatever it is, but
4660 this might break some Lisp code that expects `this-command' to
4661 always contain a symbol. So only store it if this is a simple
4662 `call-interactively' sort of menu item.
4664 But this is bogus. `this-command' could be a string or vector
4665 anyway (for keyboard macros). There's even one instance
4666 (in pending-del.el) of `this-command' getting set to a cons
4667 (a lambda expression). So in the `eval' case I'll just
4668 convert it into a lambda expression.
4670 if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively)
4671 && SYMBOLP (XEVENT (event)->event.eval.object))
4672 Vthis_command = XEVENT (event)->event.eval.object;
4673 else if (EQ (XEVENT (event)->event.eval.function, Qeval))
4675 Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object));
4676 else if (SYMBOLP (XEVENT (event)->event.eval.function))
4677 /* A scrollbar command or the like. */
4678 Vthis_command = XEVENT (event)->event.eval.function;
4681 Vthis_command = Qnil;
4683 /* clear the echo area */
4684 reset_key_echo (command_builder, 1);
4686 command_builder->self_insert_countdown = 0;
4687 if (NILP (XCONSOLE (console)->prefix_arg)
4688 && NILP (Vexecuting_macro)
4689 && !EQ (minibuf_window, Fselected_window (Qnil)))
4691 execute_command_event (command_builder, event);
4696 execute_internal_event (event);
4703 DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4704 Read a sequence of keystrokes or mouse clicks.
4705 Returns a vector of the event objects read. The vector and the event
4706 objects it contains are freshly created (and will not be side-effected
4707 by subsequent calls to this function).
4709 The sequence read is sufficient to specify a non-prefix command starting
4710 from the current local and global keymaps. A C-g typed while in this
4711 function is treated like any other character, and `quit-flag' is not set.
4713 First arg PROMPT is a prompt string. If nil, do not prompt specially.
4714 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes
4715 as a continuation of the previous key.
4717 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
4718 convert the last event to lower case. (Normally any upper case event
4719 is converted to lower case if the original event is undefined and the lower
4720 case equivalent is defined.) This argument is provided mostly for
4721 FSF compatibility; the equivalent effect can be achieved more generally
4722 by binding `retry-undefined-key-binding-unshifted' to nil around the
4723 call to `read-key-sequence'.
4725 A C-g typed while in this function is treated like any other character,
4726 and `quit-flag' is not set.
4728 If the user selects a menu item while we are prompting for a key-sequence,
4729 the returned value will be a vector of a single menu-selection event.
4730 An error will be signalled if you pass this value to `lookup-key' or a
4733 `read-key-sequence' checks `function-key-map' for function key
4734 sequences, where they wouldn't conflict with ordinary bindings. See
4735 `function-key-map' for more details.
4737 (prompt, continue_echo, dont_downcase_last))
4739 /* This function can GC */
4740 struct console *con = XCONSOLE (Vselected_console); /* #### correct?
4744 struct command_builder *command_builder =
4745 XCOMMAND_BUILDER (con->command_builder);
4747 Lisp_Object event = Fmake_event (Qnil, Qnil);
4748 int speccount = specpdl_depth ();
4749 struct gcpro gcpro1;
4753 CHECK_STRING (prompt);
4754 /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4757 if (NILP (continue_echo))
4758 reset_this_command_keys (make_console (con), 1);
4760 specbind (Qinhibit_quit, Qt);
4762 if (!NILP (dont_downcase_last))
4763 specbind (Qretry_undefined_key_binding_unshifted, Qnil);
4767 Fnext_event (event, prompt);
4768 /* restore the selected-console damage */
4769 con = event_console_or_selected (event);
4770 command_builder = XCOMMAND_BUILDER (con->command_builder);
4771 if (! command_event_p (event))
4772 execute_internal_event (event);
4775 if (XEVENT (event)->event_type == misc_user_event)
4776 reset_current_events (command_builder);
4777 result = lookup_command_event (command_builder, event, 1);
4778 if (!KEYMAPP (result))
4780 result = current_events_into_vector (command_builder);
4781 reset_key_echo (command_builder, 0);
4788 Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */
4789 Fdeallocate_event (event);
4790 RETURN_UNGCPRO (unbind_to (speccount, result));
4793 DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4794 Return a vector of the keyboard or mouse button events that were used
4795 to invoke this command. This copies the vector and the events; it is safe
4796 to keep and modify them.
4804 if (NILP (Vthis_command_keys))
4805 return make_vector (0, Qnil);
4807 len = event_chain_count (Vthis_command_keys);
4809 result = make_vector (len, Qnil);
4811 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
4812 XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil);
4816 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /*
4817 Used for complicated reasons in `universal-argument-other-key'.
4819 `universal-argument-other-key' rereads the event just typed.
4820 It then gets translated through `function-key-map'.
4821 The translated event gets included in the echo area and in
4822 the value of `this-command-keys' in addition to the raw original event.
4825 Calling this function directs the translated event to replace
4826 the original event, so that only one version of the event actually
4827 appears in the echo area and in the value of `this-command-keys'.
4831 /* #### I don't understand this at all, so currently it does nothing.
4832 If there is ever a problem, maybe someone should investigate. */
4838 dribble_out_event (Lisp_Object event)
4840 if (NILP (Vdribble_file))
4843 if (XEVENT (event)->event_type == key_press_event &&
4844 !XEVENT (event)->event.key.modifiers)
4846 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
4847 if (CHARP (XEVENT (event)->event.key.keysym))
4849 Emchar ch = XCHAR (keysym);
4850 Bufbyte str[MAX_EMCHAR_LEN];
4851 Bytecount len = set_charptr_emchar (str, ch);
4852 Lstream_write (XLSTREAM (Vdribble_file), str, len);
4854 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
4855 /* one-char key events are printed with just the key name */
4856 Fprinc (keysym, Vdribble_file);
4857 else if (EQ (keysym, Qreturn))
4858 Lstream_putc (XLSTREAM (Vdribble_file), '\n');
4859 else if (EQ (keysym, Qspace))
4860 Lstream_putc (XLSTREAM (Vdribble_file), ' ');
4862 Fprinc (event, Vdribble_file);
4865 Fprinc (event, Vdribble_file);
4866 Lstream_flush (XLSTREAM (Vdribble_file));
4869 DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1,
4870 "FOpen dribble file: ", /*
4871 Start writing all keyboard characters to a dribble file called FILE.
4872 If FILE is nil, close any open dribble file.
4876 /* This function can GC */
4877 /* XEmacs change: always close existing dribble file. */
4878 /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */
4879 if (!NILP (Vdribble_file))
4881 Lstream_close (XLSTREAM (Vdribble_file));
4882 Vdribble_file = Qnil;
4888 file = Fexpand_file_name (file, Qnil);
4889 fd = open ((char*) XSTRING_DATA (file),
4890 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4893 error ("Unable to create dribble file");
4894 Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
4897 make_encoding_output_stream (XLSTREAM (Vdribble_file),
4898 Fget_coding_system (Qescape_quoted));
4905 /************************************************************************/
4906 /* initialization */
4907 /************************************************************************/
4910 syms_of_event_stream (void)
4912 defsymbol (&Qdisabled, "disabled");
4913 defsymbol (&Qcommand_event_p, "command-event-p");
4915 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
4916 "Undefined keystroke sequence", Qerror);
4918 DEFSUBR (Frecent_keys);
4919 DEFSUBR (Frecent_keys_ring_size);
4920 DEFSUBR (Fset_recent_keys_ring_size);
4921 DEFSUBR (Finput_pending_p);
4922 DEFSUBR (Fenqueue_eval_event);
4923 DEFSUBR (Fnext_event);
4924 DEFSUBR (Fnext_command_event);
4925 DEFSUBR (Fdiscard_input);
4927 DEFSUBR (Fsleep_for);
4928 DEFSUBR (Faccept_process_output);
4929 DEFSUBR (Fadd_timeout);
4930 DEFSUBR (Fdisable_timeout);
4931 DEFSUBR (Fadd_async_timeout);
4932 DEFSUBR (Fdisable_async_timeout);
4933 DEFSUBR (Fdispatch_event);
4934 DEFSUBR (Fread_key_sequence);
4935 DEFSUBR (Fthis_command_keys);
4936 DEFSUBR (Freset_this_command_lengths);
4937 DEFSUBR (Fopen_dribble_file);
4938 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
4939 DEFSUBR (Faccelerate_menu);
4942 defsymbol (&Qpre_command_hook, "pre-command-hook");
4943 defsymbol (&Qpost_command_hook, "post-command-hook");
4944 defsymbol (&Qunread_command_events, "unread-command-events");
4945 defsymbol (&Qunread_command_event, "unread-command-event");
4946 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
4947 #ifdef ILL_CONCEIVED_HOOK
4948 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
4950 #ifdef DEFERRED_ACTION_CRAP
4951 defsymbol (&Qdeferred_action_function, "deferred-action-function");
4953 defsymbol (&Qretry_undefined_key_binding_unshifted,
4954 "retry-undefined-key-binding-unshifted");
4955 defsymbol (&Qauto_show_make_point_visible,
4956 "auto-show-make-point-visible");
4958 defsymbol (&Qmenu_force, "menu-force");
4959 defsymbol (&Qmenu_fallback, "menu-fallback");
4961 defsymbol (&Qmenu_quit, "menu-quit");
4962 defsymbol (&Qmenu_up, "menu-up");
4963 defsymbol (&Qmenu_down, "menu-down");
4964 defsymbol (&Qmenu_left, "menu-left");
4965 defsymbol (&Qmenu_right, "menu-right");
4966 defsymbol (&Qmenu_select, "menu-select");
4967 defsymbol (&Qmenu_escape, "menu-escape");
4969 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
4970 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
4974 reinit_vars_of_event_stream (void)
4976 recent_keys_ring_index = 0;
4977 recent_keys_ring_size = 100;
4978 num_input_chars = 0;
4979 Vtimeout_free_list = make_lcrecord_list (sizeof (struct Lisp_Timeout),
4981 staticpro_nodump (&Vtimeout_free_list);
4982 the_low_level_timeout_blocktype =
4983 Blocktype_new (struct low_level_timeout_blocktype);
4984 something_happened = 0;
4985 recursive_sit_for = Qnil;
4989 vars_of_event_stream (void)
4991 reinit_vars_of_event_stream ();
4992 Vrecent_keys_ring = Qnil;
4993 staticpro (&Vrecent_keys_ring);
4995 Vthis_command_keys = Qnil;
4996 staticpro (&Vthis_command_keys);
4997 Vthis_command_keys_tail = Qnil;
4998 pdump_wire (&Vthis_command_keys_tail);
5000 command_event_queue = Qnil;
5001 staticpro (&command_event_queue);
5002 command_event_queue_tail = Qnil;
5003 pdump_wire (&command_event_queue_tail);
5005 Vlast_selected_frame = Qnil;
5006 staticpro (&Vlast_selected_frame);
5008 pending_timeout_list = Qnil;
5009 staticpro (&pending_timeout_list);
5011 pending_async_timeout_list = Qnil;
5012 staticpro (&pending_async_timeout_list);
5014 last_point_position_buffer = Qnil;
5015 staticpro (&last_point_position_buffer);
5017 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
5018 *Nonzero means echo unfinished commands after this many seconds of pause.
5020 Vecho_keystrokes = make_int (1);
5022 DEFVAR_INT ("auto-save-interval", &auto_save_interval /*
5023 *Number of keyboard input characters between auto-saves.
5024 Zero means disable autosaving due to number of characters typed.
5025 See also the variable `auto-save-timeout'.
5027 auto_save_interval = 300;
5029 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /*
5030 Function or functions to run before every command.
5031 This may examine the `this-command' variable to find out what command
5032 is about to be run, or may change it to cause a different command to run.
5033 Function on this hook must be careful to avoid signalling errors!
5035 Vpre_command_hook = Qnil;
5037 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /*
5038 Function or functions to run after every command.
5039 This may examine the `this-command' variable to find out what command
5042 Vpost_command_hook = Qnil;
5044 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
5045 Normal hook run when XEmacs it about to be idle.
5046 This occurs whenever it is going to block, waiting for an event.
5047 This generally happens as a result of a call to `next-event',
5048 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
5049 `x-get-selection', or various Energize-specific commands.
5050 Errors running the hook are caught and ignored.
5052 Vpre_idle_hook = Qnil;
5054 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
5055 *Variable to control XEmacs behavior with respect to focus changing.
5056 If this variable is set to t, then XEmacs will not gratuitously change
5057 the keyboard focus. XEmacs cannot in general detect when this mode is
5058 used by the window manager, so it is up to the user to set it.
5060 focus_follows_mouse = 0;
5062 #ifdef ILL_CONCEIVED_HOOK
5063 /* Ill-conceived because it's not run in all sorts of cases
5064 where XEmacs is blocking. That's what `pre-idle-hook'
5065 is designed to solve. */
5066 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
5067 Normal hook run after each command is executed, if idle.
5068 `post-command-idle-delay' specifies a time in microseconds that XEmacs
5069 must be idle for in order for the functions on this hook to be called.
5070 Errors running the hook are caught and ignored.
5072 Vpost_command_idle_hook = Qnil;
5074 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
5075 Delay time before running `post-command-idle-hook'.
5076 This is measured in microseconds.
5078 post_command_idle_delay = 5000;
5079 #endif /* ILL_CONCEIVED_HOOK */
5081 #ifdef DEFERRED_ACTION_CRAP
5082 /* Random FSFmacs crap. There is absolutely nothing to gain,
5083 and a great deal to lose, in using this in place of just
5084 setting `post-command-hook'. */
5085 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
5086 List of deferred actions to be performed at a later time.
5087 The precise format isn't relevant here; we just check whether it is nil.
5089 Vdeferred_action_list = Qnil;
5091 xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /*
5092 Function to call to handle deferred actions, after each command.
5093 This function is called with no arguments after each command
5094 whenever `deferred-action-list' is non-nil.
5096 Vdeferred_action_function = Qnil;
5097 #endif /* DEFERRED_ACTION_CRAP */
5099 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
5100 Last keyboard or mouse button event that was part of a command. This
5101 variable is off limits: you may not set its value or modify the event that
5102 is its value, as it is destructively modified by `read-key-sequence'. If
5103 you want to keep a pointer to this value, you must use `copy-event'.
5105 Vlast_command_event = Qnil;
5107 DEFVAR_LISP ("last-command-char", &Vlast_command_char /*
5108 If the value of `last-command-event' is a keyboard event, then
5109 this is the nearest ASCII equivalent to it. This is the value that
5110 `self-insert-command' will put in the buffer. Remember that there is
5111 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5112 of keyboard events is much larger, so writing code that examines this
5113 variable to determine what key has been typed is bad practice, unless
5114 you are certain that it will be one of a small set of characters.
5116 Vlast_command_char = Qnil;
5118 DEFVAR_LISP ("last-input-event", &Vlast_input_event /*
5119 Last keyboard or mouse button event received. This variable is off
5120 limits: you may not set its value or modify the event that is its value, as
5121 it is destructively modified by `next-event'. If you want to keep a pointer
5122 to this value, you must use `copy-event'.
5124 Vlast_input_event = Qnil;
5126 DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /*
5127 The mouse-button event which invoked this command, or nil.
5128 This is usually what `(interactive "e")' returns.
5130 Vcurrent_mouse_event = Qnil;
5132 DEFVAR_LISP ("last-input-char", &Vlast_input_char /*
5133 If the value of `last-input-event' is a keyboard event, then
5134 this is the nearest ASCII equivalent to it. Remember that there is
5135 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
5136 of keyboard events is much larger, so writing code that examines this
5137 variable to determine what key has been typed is bad practice, unless
5138 you are certain that it will be one of a small set of characters.
5140 Vlast_input_char = Qnil;
5142 DEFVAR_LISP ("last-input-time", &Vlast_input_time /*
5143 The time (in seconds since Jan 1, 1970) of the last-command-event,
5144 represented as a cons of two 16-bit integers. This is destructively
5145 modified, so copy it if you want to keep it.
5147 Vlast_input_time = Qnil;
5149 DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /*
5150 The time (in seconds since Jan 1, 1970) of the last-command-event,
5151 represented as a list of three integers. The first integer contains
5152 the most significant 16 bits of the number of seconds, and the second
5153 integer contains the least significant 16 bits. The third integer
5154 contains the remainder number of microseconds, if the current system
5155 supports microsecond clock resolution. This list is destructively
5156 modified, so copy it if you want to keep it.
5158 Vlast_command_event_time = Qnil;
5160 DEFVAR_LISP ("unread-command-events", &Vunread_command_events /*
5161 List of event objects to be read as next command input events.
5162 This can be used to simulate the receipt of events from the user.
5163 Normally this is nil.
5164 Events are removed from the front of this list.
5166 Vunread_command_events = Qnil;
5168 DEFVAR_LISP ("unread-command-event", &Vunread_command_event /*
5169 Obsolete. Use `unread-command-events' instead.
5171 Vunread_command_event = Qnil;
5173 DEFVAR_LISP ("last-command", &Vlast_command /*
5174 The last command executed. Normally a symbol with a function definition,
5175 but can be whatever was found in the keymap, or whatever the variable
5176 `this-command' was set to by that command.
5178 Vlast_command = Qnil;
5180 DEFVAR_LISP ("this-command", &Vthis_command /*
5181 The command now being executed.
5182 The command can set this variable; whatever is put here
5183 will be in `last-command' during the following command.
5185 Vthis_command = Qnil;
5187 DEFVAR_LISP ("help-char", &Vhelp_char /*
5188 Character to recognize as meaning Help.
5189 When it is read, do `(eval help-form)', and display result if it's a string.
5190 If the value of `help-form' is nil, this char can be read normally.
5191 This can be any form recognized as a single key specifier.
5192 The help-char cannot be a negative number in XEmacs.
5194 Vhelp_char = make_char (8); /* C-h */
5196 DEFVAR_LISP ("help-form", &Vhelp_form /*
5197 Form to execute when character help-char is read.
5198 If the form returns a string, that string is displayed.
5199 If `help-form' is nil, the help char is not recognized.
5203 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /*
5204 Command to run when `help-char' character follows a prefix key.
5205 This command is used only when there is no actual binding
5206 for that character after that prefix key.
5208 Vprefix_help_command = Qnil;
5210 DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /*
5211 Hash table used as translate table for keyboard input.
5212 Use `keyboard-translate' to portably add entries to this table.
5213 Each key-press event is looked up in this table as follows:
5215 -- If an entry maps a symbol to a symbol, then a key-press event whose
5216 keysym is the former symbol (with any modifiers at all) gets its
5217 keysym changed and its modifiers left alone. This is useful for
5218 dealing with non-standard X keyboards, such as the grievous damage
5219 that Sun has inflicted upon the world.
5220 -- If an entry maps a character to a character, then a key-press event
5221 matching the former character gets converted to a key-press event
5222 matching the latter character. This is useful on ASCII terminals
5223 for (e.g.) making C-\\ look like C-s, to get around flow-control
5225 -- If an entry maps a character to a symbol, then a key-press event
5226 matching the character gets converted to a key-press event whose
5227 keysym is the given symbol and which has no modifiers.
5230 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
5231 &Vretry_undefined_key_binding_unshifted /*
5232 If a key-sequence which ends with a shifted keystroke is undefined
5233 and this variable is non-nil then the command lookup is retried again
5234 with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.)
5235 If lookup still fails, a normal error is signalled. In general,
5236 you should *bind* this, not set it.
5238 Vretry_undefined_key_binding_unshifted = Qt;
5241 DEFVAR_LISP ("composed-character-default-binding",
5242 &Vcomposed_character_default_binding /*
5243 The default keybinding to use for key events from composed input.
5244 Window systems frequently have ways to allow the user to compose
5245 single characters in a language using multiple keystrokes.
5246 XEmacs sees these as single character keypress events.
5248 Vcomposed_character_default_binding = Qself_insert_command;
5249 #endif /* HAVE_XIM */
5251 Vcontrolling_terminal = Qnil;
5252 staticpro (&Vcontrolling_terminal);
5254 Vdribble_file = Qnil;
5255 staticpro (&Vdribble_file);
5258 DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /*
5259 If non-zero, display debug information about Emacs events that XEmacs sees.
5260 Information is displayed on stderr.
5262 Before the event, the source of the event is displayed in parentheses,
5263 and is one of the following:
5265 \(real) A real event from the window system or
5266 terminal driver, as far as XEmacs can tell.
5268 \(keyboard macro) An event generated from a keyboard macro.
5270 \(unread-command-events) An event taken from `unread-command-events'.
5272 \(unread-command-event) An event taken from `unread-command-event'.
5274 \(command event queue) An event taken from an internal queue.
5275 Events end up on this queue when
5276 `enqueue-eval-event' is called or when
5277 user or eval events are received while
5278 XEmacs is blocking (e.g. in `sit-for',
5279 `sleep-for', or `accept-process-output',
5280 or while waiting for the reply to an
5283 \(->keyboard-translate-table) The result of an event translated through
5284 keyboard-translate-table. Note that in
5285 this case, two events are printed even
5286 though only one is really generated.
5288 \(SIGINT) A faked C-g resulting when XEmacs receives
5289 a SIGINT (e.g. C-c was pressed in XEmacs'
5290 controlling terminal or the signal was
5291 explicitly sent to the XEmacs process).
5293 debug_emacs_events = 0;
5296 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
5297 Non-nil inhibits recording of input-events to recent-keys ring.
5299 inhibit_input_event_recording = 0;
5301 DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /*
5302 Prefix key(s) that must be typed before menu accelerators will be activated.
5303 Set this to a value acceptable by define-key.
5305 Vmenu_accelerator_prefix = Qnil;
5307 DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /*
5308 Modifier keys which must be pressed to get to the top level menu accelerators.
5309 This is a list of modifier key symbols. All modifier keys must be held down
5310 while a valid menu accelerator key is pressed in order for the top level
5311 menu to become active.
5313 See also menu-accelerator-enabled and menu-accelerator-prefix.
5315 Vmenu_accelerator_modifiers = list1 (Qmeta);
5317 DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /*
5318 Whether menu accelerator keys can cause the menubar to become active.
5319 If 'menu-force or 'menu-fallback, then menu accelerator keys can
5320 be used to activate the top level menu. Once the menubar becomes active, the
5321 accelerator keys can be used regardless of the value of this variable.
5323 menu-force is used to indicate that the menu accelerator key takes
5324 precedence over bindings in the current keymap(s). menu-fallback means
5325 that bindings in the current keymap take precedence over menu accelerator keys.
5326 Thus a top level menu with an accelerator of "T" would be activated on a
5327 keypress of Meta-t if menu-accelerator-enabled is menu-force.
5328 However, if menu-accelerator-enabled is menu-fallback, then
5329 Meta-t will not activate the menubar and will instead run the function
5330 transpose-words, to which it is normally bound.
5332 See also menu-accelerator-modifiers and menu-accelerator-prefix.
5334 Vmenu_accelerator_enabled = Qnil;
5338 complex_vars_of_event_stream (void)
5340 Vkeyboard_translate_table =
5341 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5343 DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
5344 Keymap for use when the menubar is active.
5345 The actions menu-quit, menu-up, menu-down, menu-left, menu-right,
5346 menu-select and menu-escape can be mapped to keys in this map.
5348 menu-quit Immediately deactivate the menubar and any open submenus without
5350 menu-up Move the menu cursor up one row in the current menu. If the
5351 move extends past the top of the menu, wrap around to the bottom.
5352 menu-down Move the menu cursor down one row in the current menu. If the
5353 move extends past the bottom of the menu, wrap around to the top.
5354 If executed while the cursor is in the top level menu, move down
5355 into the selected menu.
5356 menu-left Move the cursor from a submenu into the parent menu. If executed
5357 while the cursor is in the top level menu, move the cursor to the
5358 left. If the move extends past the left edge of the menu, wrap
5359 around to the right edge.
5360 menu-right Move the cursor into a submenu. If the cursor is located in the
5361 top level menu or is not currently on a submenu heading, then move
5362 the cursor to the next top level menu entry. If the move extends
5363 past the right edge of the menu, wrap around to the left edge.
5364 menu-select Activate the item under the cursor. If the cursor is located on
5365 a submenu heading, then move the cursor into the submenu.
5366 menu-escape Pop up to the next level of menus. Moves from a submenu into its
5367 parent menu. From the top level menu, this deactivates the
5370 This keymap can also contain normal key-command bindings, in which case the
5371 menubar is deactivated and the corresponding command is executed.
5373 The action bindings used by the menu accelerator code are designed to mimic
5374 the actions of menu traversal keys in a commonly used PC operating system.
5376 Vmenu_accelerator_map = Fmake_keymap(Qnil);
5380 init_event_stream (void)
5384 #ifdef HAVE_UNIXOID_EVENT_LOOP
5385 init_event_unixoid ();
5387 #ifdef HAVE_X_WINDOWS
5388 if (!strcmp (display_use, "x"))
5389 init_event_Xt_late ();
5392 #ifdef HAVE_MS_WINDOWS
5393 if (!strcmp (display_use, "mswindows"))
5394 init_event_mswindows_late ();
5398 /* For TTY's, use the Xt event loop if we can; it allows
5399 us to later open an X connection. */
5400 #if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
5401 || (defined (HAVE_MSG_SELECT) \
5402 && !defined (DEBUG_TTY_EVENT_STREAM)))
5403 init_event_mswindows_late ();
5404 #elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5405 init_event_Xt_late ();
5406 #elif defined (HAVE_TTY)
5407 init_event_tty_late ();
5410 init_interrupts_late ();
5416 useful testcases for v18/v19 compatibility:
5420 (setq unread-command-event (character-to-event ?A (allocate-event)))
5421 (setq x (list (read-char)
5422 ; (read-key-sequence "") ; try it with and without this
5423 last-command-char last-input-char
5424 (recent-keys) (this-command-keys))))
5425 (global-set-key "\^Q" 'foo)
5427 without the read-key-sequence:
5428 ^Q ==> (65 17 65 [... ^Q] [^Q])
5429 ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q])
5430 ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q])
5432 with the read-key-sequence:
5433 ^Qb ==> (65 [b] 17 98 [... ^Q b] [b])
5434 ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b])
5435 ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b])
5437 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5439 ;(setq x (list (read-char) quit-flag))^J^G
5440 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5441 ;for BOTH, x should get set to (7 t), but no result should be printed.
5443 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5444 ;in *scratch*, type (sit-for 20)^J
5445 ;wait a couple of seconds, move cursor to foo, type "a"
5446 ;a should be inserted in foo. Cursor highlighting should not change in
5449 ;do it with sleep-for. move cursor into foo, then back into *scratch*
5451 ;repeat also with (accept-process-output nil 20)
5453 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5456 (list (condition-case c
5461 (tst)^Ja^G ==> ((quit) 97) with no signal
5462 (tst)^J^Ga ==> ((quit) 97) with no signal
5463 (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
5465 ; with sit-for only do the 2nd test.
5466 ; Do all 3 tests with (accept-process-output nil 20)
5469 (setq enable-recursive-minibuffers t
5470 minibuffer-max-depth nil)
5471 ESC ESC ESC ESC - there are now two minibuffers active
5472 C-g C-g C-g - there should be active 0, not 1
5474 C-x C-f ~ / ? - wait for "Making completion list..." to display
5475 C-g - wait for "Quit" to display
5476 C-g - minibuffer should not be active
5477 however C-g before "Quit" is displayed should leave minibuffer active.
5479 ;do it all in both v18 and v19 and make sure all results are the same.
5480 ;all of these cases matter a lot, but some in quite subtle ways.
5484 Additional test cases for accept-process-output, sleep-for, sit-for.
5485 Be sure you do all of the above checking for C-g and focus, too!
5487 ; Make sure that timer handlers are run during, not after sit-for:
5488 (defun timer-check ()
5489 (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5491 (message "after sit-for"))
5493 ; The first message should appear after 2 seconds, and the final message
5494 ; 3 seconds after that.
5495 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5499 ; Make sure that process filters are run during, not after sit-for.
5501 (message "sit-for = %s" (sit-for 30)))
5502 (add-hook 'post-command-hook 'fubar)
5504 ; Now type M-x shell RET
5505 ; wait for the shell prompt then send: ls RET
5506 ; the output of ls should fill immediately, and not wait 30 seconds.
5508 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5512 ; Make sure that recursive invocations return immediately:
5513 (defmacro test-diff-time (start end)
5514 `(+ (* (- (car ,end) (car ,start)) 65536.0)
5515 (- (cadr ,end) (cadr ,start))
5516 (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5518 (defun testee (ignore)
5522 (let ((start (current-time))
5524 (add-timeout 2 'testee nil)
5526 (add-timeout 2 'testee nil)
5528 (add-timeout 2 'testee nil)
5529 (accept-process-output nil 5)
5530 (setq end (current-time))
5531 (test-diff-time start end)))
5533 (test-them) should sit for 15 seconds.
5534 Repeat with testee set to sleep-for and accept-process-output.
5535 These should each delay 36 seconds.