Wand updates from Evgeny
[sxemacs] / src / events / event-stream.c
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.
6
7 This file is part of SXEmacs
8
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
13
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
21
22
23 /* Synched up with: Not in FSF. */
24
25 /* Authorship:
26
27    Created 1991 by Jamie Zawinski.
28    A great deal of work over the ages by Ben Wing (Mule-ization for 19.12,
29      device abstraction for 19.12/19.13, async timers for 19.14,
30      rewriting of focus code for 19.12, pre-idle hook for 19.12,
31      redoing of signal and quit handling for 19.9 and 19.12,
32      misc-user events to clean up menu/scrollbar handling for 19.11,
33      function-key-map/key-translation-map/keyboard-translate-table for
34      19.13/19.14, open-dribble-file for 19.13, much other cleanup).
35    focus-follows-mouse from Chuck Thompson, 1995.
36    XIM stuff by Martin Buchholz, c. 1996?.
37 */
38
39 /* This file has been Mule-ized. */
40
41 /*
42  *      DANGER!!
43  *
44  *      If you ever change ANYTHING in this file, you MUST run the
45  *      testcases at the end to make sure that you haven't changed
46  *      the semantics of recent-keys, last-input-char, or keyboard
47  *      macros.  You'd be surprised how easy it is to break this.
48  *
49  */
50
51 /* TODO:
52    This stuff is way too hard to maintain - needs rework.
53
54    The command builder should deal only with key and button events.
55    Other command events should be able to come in the MIDDLE of a key
56    sequence, without disturbing the key sequence composition, or the
57    command builder structure representing it.
58
59    Someone should rethink universal-argument and figure out how an
60    arbitrary command can influence the next command (universal-argument
61    or universal-coding-system-argument) or the next key (hyperify).
62
63    Both C-h and Help in the middle of a key sequence should trigger
64    prefix-help-command.  help-char is stupid.  Maybe we need
65    keymap-of-last-resort?
66
67    After prefix-help is run, one should be able to CONTINUE TYPING,
68    instead of RETYPING, the key sequence.
69  */
70
71 #include <config.h>
72 #include "lisp.h"
73
74 #include "mem/blocktype.h"
75 #include "buffer.h"
76 #include "commands.h"
77 #include "ui/device.h"
78 #include "elhash.h"
79 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
80 #include "events.h"
81 #include "ui/frame.h"
82 #include "ui/insdel.h"          /* for buffer_reset_changes */
83 #include "ui/keymap.h"
84 #include "lstream.h"
85 #include "macros.h"             /* for defining_keyboard_macro */
86 #include "ui/menubar.h"         /* #### for evil kludges. */
87 #include "process.h"
88 #include "ui/window.h"
89
90 #include "sysdep.h"             /* init_poll_for_quit() */
91 #include "syssignal.h"          /* SIGCHLD, etc. */
92 #include "sysfile.h"
93 #include "systime.h"            /* to set Vlast_input_time */
94
95 #include "events-mod.h"
96 #ifdef EF_USE_ASYNEQ
97 #include "event-queue.h"
98 #include "workers.h"
99 #include "worker-asyneq.h"
100 #endif
101 #ifdef FILE_CODING
102 #include "mule/file-coding.h"
103 #endif
104
105 #include <errno.h>
106
107 /* The number of keystrokes between auto-saves. */
108 static Fixnum auto_save_interval;
109
110 Lisp_Object Qundefined_keystroke_sequence;
111
112 Lisp_Object Qcommand_event_p;
113
114 /* Hooks to run before and after each command.  */
115 Lisp_Object Vpre_command_hook, Vpost_command_hook;
116 Lisp_Object Qpre_command_hook, Qpost_command_hook;
117
118 /* See simple.el */
119 Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
120
121 /* Hook run when SXEmacs is about to be idle. */
122 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
123
124 /* Control gratuitous keyboard focus throwing. */
125 int focus_follows_mouse;
126
127 /* When true, modifier keys are sticky. */
128 int modifier_keys_are_sticky;
129 /* Modifier keys are sticky for this many milliseconds. */
130 Lisp_Object Vmodifier_keys_sticky_time;
131
132 /* Here FSF Emacs 20.7 defines Vpost_command_idle_hook,
133    post_command_idle_delay, Vdeferred_action_list, and
134    Vdeferred_action_function, but we don't because that stuff is crap,
135    and we're smarter than them, and their momas are fat. */
136
137 /* FSF Emacs 20.7 also defines Vinput_method_function,
138    Qinput_method_exit_on_first_char and Qinput_method_use_echo_area.
139    I don't know this should be imported or not. */
140
141 /* Non-nil disable property on a command means
142    do not execute it; call disabled-command-hook's value instead. */
143 Lisp_Object Qdisabled, Vdisabled_command_hook;
144
145 EXFUN(Fnext_command_event, 2);
146
147 static void pre_command_hook(void);
148 static void post_command_hook(void);
149
150 /* Last keyboard or mouse input event read as a command. */
151 Lisp_Object Vlast_command_event;
152
153 /* The nearest ASCII equivalent of the above. */
154 Lisp_Object Vlast_command_char;
155
156 /* Last keyboard or mouse event read for any purpose. */
157 Lisp_Object Vlast_input_event;
158
159 /* The nearest ASCII equivalent of the above. */
160 Lisp_Object Vlast_input_char;
161
162 Lisp_Object Vcurrent_mouse_event;
163
164 /* This is fbound in cmdloop.el, see the commentary there */
165 Lisp_Object Qcancel_mode_internal;
166
167 /* If not Qnil, event objects to be read as the next command input */
168 Lisp_Object Vunread_command_events;
169 Lisp_Object Vunread_command_event;      /* obsoleteness support */
170
171 static Lisp_Object Qunread_command_events, Qunread_command_event;
172
173 /* Previous command, represented by a Lisp object.
174    Does not include prefix commands and arg setting commands. */
175 Lisp_Object Vlast_command;
176
177 /* Contents of this-command-properties for the last command. */
178 Lisp_Object Vlast_command_properties;
179
180 /* If a command sets this, the value goes into
181    last-command for the next command. */
182 Lisp_Object Vthis_command;
183
184 /* If a command sets this, the value goes into
185    last-command-properties for the next command. */
186 Lisp_Object Vthis_command_properties;
187
188 /* The value of point when the last command was executed.  */
189 Bufpos last_point_position;
190
191 /* The frame that was current when the last command was started. */
192 Lisp_Object Vlast_selected_frame;
193
194 /* The buffer that was current when the last command was started.  */
195 Lisp_Object last_point_position_buffer;
196
197 /* A (16bit . 16bit) representation of the time of the last-command-event. */
198 Lisp_Object Vlast_input_time;
199
200 /* A (16bit 16bit usec) representation of the time
201    of the last-command-event. */
202 Lisp_Object Vlast_command_event_time;
203
204 /* Character to recognize as the help char.  */
205 Lisp_Object Vhelp_char;
206
207 /* Form to execute when help char is typed.  */
208 Lisp_Object Vhelp_form;
209
210 /* Command to run when the help character follows a prefix key.  */
211 Lisp_Object Vprefix_help_command;
212
213 /* Flag to tell QUIT that some interesting occurrence (e.g. a keypress)
214    may have happened. */
215 volatile int something_happened;
216
217 /* Hash table to translate keysyms through */
218 Lisp_Object Vkeyboard_translate_table;
219
220 /* If control-meta-super-shift-X is undefined, try control-meta-super-x */
221 Lisp_Object Vretry_undefined_key_binding_unshifted;
222 Lisp_Object Qretry_undefined_key_binding_unshifted;
223
224 #ifdef HAVE_XIM
225 /* If composed input is undefined, use self-insert-char */
226 Lisp_Object Vcomposed_character_default_binding;
227 #endif                          /* HAVE_XIM */
228
229 /* Console that corresponds to our controlling terminal */
230 Lisp_Object Vcontrolling_terminal;
231
232 /* An event (actually an event chain linked through event_next) or Qnil.
233  */
234 Lisp_Object Vthis_command_keys;
235 Lisp_Object Vthis_command_keys_tail;
236
237 /* #### kludge! */
238 Lisp_Object Qauto_show_make_point_visible;
239
240 /* File in which we write all commands we read; an lstream */
241 static Lisp_Object Vdribble_file;
242
243 /* Recent keys ring location; a vector of events or nil-s */
244 Lisp_Object Vrecent_keys_ring;
245 int recent_keys_ring_size;
246 int recent_keys_ring_index;
247
248 /* Boolean specifying whether keystrokes should be added to
249    recent-keys. */
250 int inhibit_input_event_recording;
251
252 Lisp_Object Qself_insert_defer_undo;
253
254 /* this is in keymap.c */
255 extern Lisp_Object Fmake_keymap(Lisp_Object name);
256
257 #ifdef DEBUG_SXEMACS
258 Fixnum debug_emacs_events;
259
260 static void
261 external_debugging_print_event(char *event_description, Lisp_Object event)
262 {
263         write_c_string("(", Qexternal_debugging_output);
264         write_c_string(event_description, Qexternal_debugging_output);
265         write_c_string(") ", Qexternal_debugging_output);
266         print_internal(event, Qexternal_debugging_output, 1);
267         write_c_string("\n", Qexternal_debugging_output);
268 }
269
270 #define DEBUG_PRINT_EMACS_EVENT(event_description, event) do {  \
271   if (debug_emacs_events)                                       \
272     external_debugging_print_event (event_description, event);  \
273 } while (0)
274 #else
275 #define DEBUG_PRINT_EMACS_EVENT(string, event)
276 #endif
277 \f
278 /* The callback routines for the window system or terminal driver */
279 struct event_stream *event_stream;
280
281 static void echo_key_event(struct command_builder *, Lisp_Object event);
282 static void maybe_kbd_translate(Lisp_Object event);
283
284 #if defined(EF_USE_ASYNEQ)
285 /* everybody may use me */
286 event_queue_t asyneq = Qnull_pointer;
287 static Lisp_Object Vasyneq;
288 #define EQ_EMPTY_P()    eq_queue_empty_p(asyneq)
289 #define EQ_LARGE_P()    (eq_queue_size(asyneq) > 1)
290 #else
291 /* This structure is basically a typeahead queue: things like
292    wait-reading-process-output will delay the execution of
293    keyboard and mouse events by pushing them here.
294
295    Chained through event_next()
296    command_event_queue_tail is a pointer to the last-added element.
297  */
298 static Lisp_Object command_event_queue;
299 static Lisp_Object command_event_queue_tail;
300 #define EQ_EMPTY_P()    NILP(command_event_queue)
301 #define EQ_LARGE_P()    !NILP(command_event_queue_tail)
302 #endif
303
304 /* Nonzero means echo unfinished commands after this many seconds of pause. */
305 static Lisp_Object Vecho_keystrokes;
306
307 /* The number of keystrokes since the last auto-save. */
308 static int keystrokes_since_auto_save;
309
310 /* Used by the C-g signal handler so that it will never "hard quit"
311    when waiting for an event.  Otherwise holding down C-g could
312    cause a suspension back to the shell, which is generally
313    undesirable. (#### This doesn't fully work.) */
314
315 int emacs_is_blocking;
316
317 /* Handlers which run during sit-for, sleep-for and accept-process-output
318    are not allowed to recursively call these routines.  We record here
319    if we are in that situation. */
320
321 static Lisp_Object recursive_sit_for;
322 \f
323 /**********************************************************************/
324 /*                       Command-builder object                       */
325 /**********************************************************************/
326
327 #define XCOMMAND_BUILDER(x) \
328   XRECORD (x, command_builder, struct command_builder)
329 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
330 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
331 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
332
333 static Lisp_Object mark_command_builder(Lisp_Object obj)
334 {
335         struct command_builder *builder = XCOMMAND_BUILDER(obj);
336         mark_object(builder->prefix_events);
337         mark_object(builder->current_events);
338         mark_object(builder->most_current_event);
339         mark_object(builder->last_non_munged_event);
340         mark_object(builder->munge_me[0].first_mungeable_event);
341         mark_object(builder->munge_me[1].first_mungeable_event);
342         return builder->console;
343 }
344
345 static void finalize_command_builder(void *header, int for_disksave)
346 {
347         if (!for_disksave) {
348                 xfree(((struct command_builder *)header)->echo_buf);
349                 ((struct command_builder *)header)->echo_buf = 0;
350         }
351 }
352
353 DEFINE_LRECORD_IMPLEMENTATION("command-builder", command_builder,
354                               mark_command_builder, internal_object_printer,
355                               finalize_command_builder, 0, 0, 0,
356                               struct command_builder);
357 \f
358 static void reset_command_builder_event_chain(struct command_builder *builder)
359 {
360         builder->prefix_events = Qnil;
361         builder->current_events = Qnil;
362         builder->most_current_event = Qnil;
363         builder->last_non_munged_event = Qnil;
364         builder->munge_me[0].first_mungeable_event = Qnil;
365         builder->munge_me[1].first_mungeable_event = Qnil;
366 }
367
368 Lisp_Object allocate_command_builder(Lisp_Object console)
369 {
370         Lisp_Object builder_obj;
371         struct command_builder *builder =
372             alloc_lcrecord_type(struct command_builder,
373                                 &lrecord_command_builder);
374
375         builder->console = console;
376         reset_command_builder_event_chain(builder);
377         builder->echo_buf_length = 300; /* #### Kludge */
378         builder->echo_buf =
379                 xnew_atomic_array(Bufbyte, builder->echo_buf_length);
380         builder->echo_buf[0] = 0;
381         builder->echo_buf_index = -1;
382         builder->echo_buf_index = -1;
383         builder->self_insert_countdown = 0;
384
385         XSETCOMMAND_BUILDER(builder_obj, builder);
386         return builder_obj;
387 }
388
389 static void
390 command_builder_append_event(struct command_builder *builder, Lisp_Object event)
391 {
392         assert(EVENTP(event));
393
394         if (EVENTP(builder->most_current_event))
395                 XSET_EVENT_NEXT(builder->most_current_event, event);
396         else
397                 builder->current_events = event;
398
399         builder->most_current_event = event;
400         if (NILP(builder->munge_me[0].first_mungeable_event))
401                 builder->munge_me[0].first_mungeable_event = event;
402         if (NILP(builder->munge_me[1].first_mungeable_event))
403                 builder->munge_me[1].first_mungeable_event = event;
404 }
405 \f
406 /**********************************************************************/
407 /*             Low-level interfaces onto event methods                */
408 /**********************************************************************/
409
410 enum event_stream_operation {
411         EVENT_STREAM_PROCESS,
412         EVENT_STREAM_TIMEOUT,
413         EVENT_STREAM_CONSOLE,
414         EVENT_STREAM_READ
415 };
416
417 static void check_event_stream_ok(enum event_stream_operation op)
418 {
419         if (!event_stream && noninteractive) {
420                 switch (op) {
421                 case EVENT_STREAM_PROCESS:
422                         error("Can't start subprocesses in -batch mode");
423                 case EVENT_STREAM_TIMEOUT:
424                         error("Can't add timeouts in -batch mode");
425                 case EVENT_STREAM_CONSOLE:
426                         error("Can't add consoles in -batch mode");
427                 case EVENT_STREAM_READ:
428                         error("Can't read events in -batch mode");
429                 default:
430                         abort();
431                 }
432         } else if (!event_stream) {
433                 error
434                     ("event-stream callbacks not initialized (internal error?)");
435         }
436 }
437
438 static int event_stream_event_pending_p(int user)
439 {
440         return event_stream && event_stream->event_pending_p(user);
441 }
442
443 static void event_stream_force_event_pending(struct frame *f)
444 {
445         if (event_stream->force_event_pending)
446                 event_stream->force_event_pending(f);
447 }
448
449 static int maybe_read_quit_event(Lisp_Event * event)
450 {
451         /* A C-g that came from `sigint_happened' will always come from the
452            controlling terminal.  If that doesn't exist, however, then the
453            user manually sent us a SIGINT, and we pretend the C-g came from
454            the selected console. */
455         struct console *con;
456
457         if (CONSOLEP(Vcontrolling_terminal) &&
458             CONSOLE_LIVE_P(XCONSOLE(Vcontrolling_terminal))) {
459                 con = XCONSOLE(Vcontrolling_terminal);
460         } else {
461                 Lisp_Object tmp = Fselected_console();
462                 con = XCONSOLE(tmp);
463         }
464
465         if (sigint_happened) {
466                 int ch = CONSOLE_QUIT_CHAR(con);
467                 sigint_happened = 0;
468                 Vquit_flag = Qnil;
469                 character_to_event(ch, event, con, 1, 1);
470                 event->channel = make_console(con);
471                 return 1;
472         }
473         return 0;
474 }
475
476 void event_stream_next_event(Lisp_Event * event)
477 {
478         Lisp_Object event_obj;
479
480         check_event_stream_ok(EVENT_STREAM_READ);
481
482         XSETEVENT(event_obj, event);
483         zero_event(event);
484         /* If C-g was pressed, treat it as a character to be read.
485            Note that if C-g was pressed while we were blocking,
486            the SIGINT signal handler will be called.  It will
487            set Vquit_flag and write a byte on our "fake pipe",
488            which will unblock us. */
489         if (maybe_read_quit_event(event)) {
490                 DEBUG_PRINT_EMACS_EVENT("SIGINT", event_obj);
491                 return;
492         }
493
494         /* If a longjmp() happens in the callback, we're screwed.
495            Let's hope it doesn't.  I think the code here is fairly
496            clean and doesn't do this. */
497         emacs_is_blocking = 1;
498         event_stream->next_event_cb(event);
499         emacs_is_blocking = 0;
500
501 #ifdef DEBUG_SXEMACS
502         /* timeout events have more info set later, so
503            print the event out in next_event_internal(). */
504         if (event->event_type != timeout_event)
505                 DEBUG_PRINT_EMACS_EVENT("real", event_obj);
506 #endif
507         maybe_kbd_translate(event_obj);
508 }
509
510 void event_stream_handle_magic_event(Lisp_Event * event)
511 {
512         check_event_stream_ok(EVENT_STREAM_READ);
513         event_stream->handle_magic_event_cb(event);
514 }
515
516 static int event_stream_add_timeout(EMACS_TIME timeout)
517 {
518         check_event_stream_ok(EVENT_STREAM_TIMEOUT);
519         return event_stream->add_timeout_cb(timeout);
520 }
521
522 static void event_stream_remove_timeout(int id)
523 {
524         check_event_stream_ok(EVENT_STREAM_TIMEOUT);
525         event_stream->remove_timeout_cb(id);
526 }
527
528 void event_stream_select_console(struct console *con)
529 {
530         check_event_stream_ok(EVENT_STREAM_CONSOLE);
531         if (!con->input_enabled) {
532                 event_stream->select_console_cb(con);
533                 con->input_enabled = 1;
534         }
535 }
536
537 void event_stream_unselect_console(struct console *con)
538 {
539         check_event_stream_ok(EVENT_STREAM_CONSOLE);
540         if (con->input_enabled) {
541                 event_stream->unselect_console_cb(con);
542                 con->input_enabled = 0;
543         }
544 }
545
546 void event_stream_select_process(Lisp_Process * proc)
547 {
548         check_event_stream_ok(EVENT_STREAM_PROCESS);
549         if (!get_process_selected_p(proc)) {
550                 event_stream->select_process_cb(proc);
551                 set_process_selected_p(proc, 1);
552         }
553 }
554
555 void event_stream_unselect_process(Lisp_Process * proc)
556 {
557         check_event_stream_ok(EVENT_STREAM_PROCESS);
558         if (get_process_selected_p(proc)) {
559                 event_stream->unselect_process_cb(proc);
560                 set_process_selected_p(proc, 0);
561         }
562 }
563
564 USID
565 event_stream_create_stream_pair(void *inhandle, void *outhandle,
566                                 Lisp_Object * instream, Lisp_Object * outstream,
567                                 int flags)
568 {
569         check_event_stream_ok(EVENT_STREAM_PROCESS);
570         return event_stream->create_stream_pair_cb
571             (inhandle, outhandle, instream, outstream, flags);
572 }
573
574 USID
575 event_stream_delete_stream_pair(Lisp_Object instream, Lisp_Object outstream)
576 {
577         check_event_stream_ok(EVENT_STREAM_PROCESS);
578         return event_stream->delete_stream_pair_cb(instream, outstream);
579 }
580
581 void event_stream_quit_p(void)
582 {
583         if (event_stream)
584                 event_stream->quit_p_cb();
585 }
586
587 static int event_stream_current_event_timestamp(struct console *c)
588 {
589         if (event_stream && event_stream->current_event_timestamp_cb)
590                 return event_stream->current_event_timestamp_cb(c);
591         else
592                 return 0;
593 }
594 \f
595 /**********************************************************************/
596 /*                      Character prompting                           */
597 /**********************************************************************/
598
599 static void
600 echo_key_event(struct command_builder *command_builder, Lisp_Object event)
601 {
602         /* This function can GC */
603         char buf[255];
604         Bytecount buf_index = command_builder->echo_buf_index;
605         Bufbyte *e;
606         Bytecount len;
607
608         if (buf_index < 0) {
609                 buf_index = 0;  /* We're echoing now */
610                 clear_echo_area(selected_frame(), Qnil, 0);
611         }
612
613         format_event_object(buf, XEVENT(event), 1);
614         len = strlen(buf);
615
616         if (len + buf_index + 4 > command_builder->echo_buf_length)
617                 return;
618         e = command_builder->echo_buf + buf_index;
619         memcpy(e, buf, len);
620         e += len;
621
622         e[0] = ' ';
623         e[1] = '-';
624         e[2] = ' ';
625         e[3] = 0;
626
627         command_builder->echo_buf_index = buf_index + len + 1;
628 }
629
630 static void
631 regenerate_echo_keys_from_this_command_keys(struct command_builder *builder)
632 {
633         Lisp_Object event;
634
635         builder->echo_buf_index = 0;
636
637         EVENT_CHAIN_LOOP(event, Vthis_command_keys)
638             echo_key_event(builder, event);
639 }
640
641 static void
642 maybe_echo_keys(struct command_builder *command_builder, int no_snooze)
643 {
644         /* This function can GC */
645         double echo_keystrokes;
646         struct frame *f = selected_frame();
647         /* Message turns off echoing unless more keystrokes turn it on again. */
648         if (echo_area_active(f) && !EQ(Qcommand, echo_area_status(f)))
649                 return;
650
651         if (INTP(Vecho_keystrokes) || FLOATP(Vecho_keystrokes))
652                 echo_keystrokes = extract_float(Vecho_keystrokes);
653         else
654                 echo_keystrokes = 0;
655
656         if (minibuf_level == 0 && echo_keystrokes > 0.0
657 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
658             && !x_kludge_lw_menu_active()
659 #endif
660             ) {
661                 if (!no_snooze) {
662                         /* #### C-g here will cause QUIT.  Setting dont_check_for_quit
663                            doesn't work.  See check_quit. */
664                         if (NILP(Fsit_for(Vecho_keystrokes, Qnil)))
665                                 /* input came in, so don't echo. */
666                                 return;
667                 }
668
669                 echo_area_message(f, command_builder->echo_buf, Qnil, 0,
670                                   /* not echo_buf_index.  That doesn't include
671                                      the terminating " - ". */
672                                   strlen((char *)command_builder->echo_buf),
673                                   Qcommand);
674         }
675 }
676
677 static void
678 reset_key_echo(struct command_builder *command_builder,
679                int remove_echo_area_echo)
680 {
681         /* This function can GC */
682         struct frame *f = selected_frame();
683
684         if (command_builder)
685                 command_builder->echo_buf_index = -1;
686
687         if (remove_echo_area_echo)
688                 clear_echo_area(f, Qcommand, 0);
689 }
690 \f
691 /**********************************************************************/
692 /*                          random junk                               */
693 /**********************************************************************/
694
695 static void maybe_kbd_translate(Lisp_Object event)
696 {
697         Emchar c;
698         int did_translate = 0;
699
700         if (XEVENT_TYPE(event) != key_press_event)
701                 return;
702         if (!HASH_TABLEP(Vkeyboard_translate_table))
703                 return;
704         if (EQ(Fhash_table_count(Vkeyboard_translate_table), Qzero))
705                 return;
706
707         c = event_to_character(XEVENT(event), 0, 0, 0);
708         if (c != -1) {
709                 Lisp_Object traduit =
710                     Fgethash(make_char(c), Vkeyboard_translate_table,
711                              Qnil);
712                 if (!NILP(traduit) && SYMBOLP(traduit)) {
713                         XEVENT(event)->event.key.keysym = traduit;
714                         XEVENT(event)->event.key.modifiers = 0;
715                         did_translate = 1;
716                 } else if (CHARP(traduit)) {
717                         Lisp_Event ev2;
718
719                         /* This used to call Fcharacter_to_event() directly into EVENT,
720                            but that can eradicate timestamps and other such stuff.
721                            This way is safer. */
722                         zero_event(&ev2);
723                         character_to_event(XCHAR(traduit), &ev2,
724                                            XCONSOLE(EVENT_CHANNEL
725                                                     (XEVENT(event))), 0, 1);
726                         XEVENT(event)->event.key.keysym = ev2.event.key.keysym;
727                         XEVENT(event)->event.key.modifiers =
728                             ev2.event.key.modifiers;
729                         did_translate = 1;
730                 }
731         }
732
733         if (!did_translate) {
734                 Lisp_Object traduit = Fgethash(XEVENT(event)->event.key.keysym,
735                                                Vkeyboard_translate_table, Qnil);
736                 if (!NILP(traduit) && SYMBOLP(traduit)) {
737                         XEVENT(event)->event.key.keysym = traduit;
738                         did_translate = 1;
739                 } else if (CHARP(traduit)) {
740                         Lisp_Event ev2;
741
742                         zero_event(&ev2);
743                         character_to_event(XCHAR(traduit), &ev2,
744                                            XCONSOLE(EVENT_CHANNEL
745                                                     (XEVENT(event))), 0, 1);
746                         XEVENT(event)->event.key.keysym = ev2.event.key.keysym;
747                         XEVENT(event)->event.key.modifiers |=
748                             ev2.event.key.modifiers;
749                         did_translate = 1;
750                 }
751         }
752 #ifdef DEBUG_SXEMACS
753         if (did_translate)
754                 DEBUG_PRINT_EMACS_EVENT("->keyboard-translate-table", event);
755 #endif
756 }
757
758 /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and
759    keystrokes_since_auto_save is equivalent to the difference between
760    num_nonmacro_input_chars and last_auto_save. */
761
762 /* When an auto-save happens, record the number of keystrokes, and
763    don't do again soon.  */
764
765 void record_auto_save(void)
766 {
767         keystrokes_since_auto_save = 0;
768 }
769
770 /* Make an auto save happen as soon as possible at command level.  */
771
772 void force_auto_save_soon(void)
773 {
774         keystrokes_since_auto_save = 1 + max(auto_save_interval, 20);
775 }
776
777 static void maybe_do_auto_save(void)
778 {
779         /* This function can call lisp */
780         keystrokes_since_auto_save++;
781         if (auto_save_interval > 0 &&
782             keystrokes_since_auto_save > max(auto_save_interval, 20) &&
783             !detect_input_pending()) {
784                 Fdo_auto_save(Qnil, Qnil);
785                 record_auto_save();
786         }
787 }
788
789 static Lisp_Object print_help(Lisp_Object object)
790 {
791         Fprinc(object, Qnil);
792         return Qnil;
793 }
794
795 static void
796 execute_help_form(struct command_builder *command_builder, Lisp_Object event)
797 {
798         /* This function can GC */
799         Lisp_Object help = Qnil;
800         int speccount = specpdl_depth();
801         Bytecount buf_index = command_builder->echo_buf_index;
802         Lisp_Object echo = ((buf_index <= 0)
803                             ? Qnil : make_string(command_builder->echo_buf,
804                                                  buf_index));
805         struct gcpro gcpro1, gcpro2;
806         GCPRO2(echo, help);
807
808         record_unwind_protect(save_window_excursion_unwind,
809                               Fcurrent_window_configuration(Qnil));
810         reset_key_echo(command_builder, 1);
811
812         help = Feval(Vhelp_form);
813         if (STRINGP(help))
814                 internal_with_output_to_temp_buffer(build_string("*Help*"),
815                                                     print_help, help, Qnil);
816         Fnext_command_event(event, Qnil);
817         /* Remove the help from the frame */
818         unbind_to(speccount, Qnil);
819         /* Hmmmm.  Tricky.  The unbind restores an old window configuration,
820            apparently bypassing any setting of windows_structure_changed.
821            So we need to set it so that things get redrawn properly. */
822         /* #### This is massive overkill.  Look at doing it better once the
823            new redisplay is fully in place. */
824         {
825                 Lisp_Object frmcons, devcons, concons;
826                 FRAME_LOOP_NO_BREAK(frmcons, devcons, concons) {
827                         struct frame *f = XFRAME(XCAR(frmcons));
828                         MARK_FRAME_WINDOWS_STRUCTURE_CHANGED(f);
829                 }
830         }
831
832         redisplay();
833         if (event_matches_key_specifier_p(XEVENT(event), make_char(' '))) {
834                 /* Discard next key if it is a space */
835                 reset_key_echo(command_builder, 1);
836                 Fnext_command_event(event, Qnil);
837         }
838
839         command_builder->echo_buf_index = buf_index;
840         if (buf_index > 0)
841                 memcpy(command_builder->echo_buf, XSTRING_DATA(echo), buf_index + 1);   /* terminating 0 */
842         UNGCPRO;
843 }
844 \f
845 /**********************************************************************/
846 /*                          input pending                             */
847 /**********************************************************************/
848
849 int detect_input_pending(void)
850 {
851         /* Always call the event_pending_p hook even if there's an unread
852            character, because that might do some needed ^G detection (on
853            systems without SIGIO, for example).
854          */
855         if (event_stream_event_pending_p(1))
856                 return 1;
857         if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event))
858                 return 1;
859         if (!EQ_EMPTY_P()) {
860                 Lisp_Object event;
861
862 #if defined(EF_USE_ASYNEQ)
863                 EQ_TRAVERSE(
864                         asyneq, event,
865                         if (XEVENT_TYPE(event) != eval_event &&
866                             XEVENT_TYPE(event) != magic_eval_event) {
867                                 RETURN_FROM_EQ_TRAVERSE(asyneq, 1);
868                         });
869 #else
870                 EVENT_CHAIN_LOOP(event, command_event_queue) {
871                         if (XEVENT_TYPE(event) != eval_event
872                             && XEVENT_TYPE(event) != magic_eval_event)
873                                 return 1;
874                 }
875 #endif
876         }
877         return 0;
878 }
879
880 DEFUN("input-pending-p", Finput_pending_p, 0, 0, 0,     /*
881 Return t if command input is currently available with no waiting.
882 Actually, the value is nil only if we can be sure that no input is available.
883 */
884       ())
885 {
886         return detect_input_pending()? Qt : Qnil;
887 }
888 \f
889 /**********************************************************************/
890 /*                            timeouts                                */
891 /**********************************************************************/
892
893 /**** Low-level timeout functions. ****
894
895    These functions maintain a sorted list of one-shot timeouts (where
896    the timeouts are in absolute time).  They are intended for use by
897    functions that need to convert a list of absolute timeouts into a
898    series of intervals to wait for. */
899
900 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
901    used to indicate an absence of a timer. */
902 static int low_level_timeout_id_tick;
903
904 static struct low_level_timeout_blocktype {
905         Blocktype_declare(struct low_level_timeout);
906 } *the_low_level_timeout_blocktype;
907
908 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST.  Return
909    a unique ID identifying the timeout. */
910
911 int
912 add_low_level_timeout(struct low_level_timeout **timeout_list, EMACS_TIME thyme)
913 {
914         struct low_level_timeout *tm;
915         struct low_level_timeout *t, **tt;
916
917         /* Allocate a new time struct. */
918
919         tm = Blocktype_alloc(the_low_level_timeout_blocktype);
920         tm->next = NULL;
921         if (low_level_timeout_id_tick == 0)
922                 low_level_timeout_id_tick++;
923         tm->id = low_level_timeout_id_tick++;
924         tm->time = thyme;
925
926         /* Add it to the queue. */
927
928         tt = timeout_list;
929         t = *tt;
930         while (t && EMACS_TIME_EQUAL_OR_GREATER(tm->time, t->time)) {
931                 tt = &t->next;
932                 t = *tt;
933         }
934         tm->next = t;
935         *tt = tm;
936
937         return tm->id;
938 }
939
940 /* Remove the low-level timeout identified by ID from TIMEOUT_LIST.
941    If the timeout is not there, do nothing. */
942
943 void remove_low_level_timeout(struct low_level_timeout **timeout_list, int id)
944 {
945         struct low_level_timeout *t, *prev;
946
947         /* find it */
948
949         for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next)
950                 prev = t;
951
952         if (!t)
953                 return;         /* couldn't find it */
954
955         if (!prev)
956                 *timeout_list = t->next;
957         else
958                 prev->next = t->next;
959
960         Blocktype_free(the_low_level_timeout_blocktype, t);
961 }
962
963 /* If there are timeouts on TIMEOUT_LIST, store the relative time
964    interval to the first timeout on the list into INTERVAL and
965    return 1.  Otherwise, return 0. */
966
967 int
968 get_low_level_timeout_interval(struct low_level_timeout *timeout_list,
969                                EMACS_TIME * interval)
970 {
971         if (!timeout_list)      /* no timer events; block indefinitely */
972                 return 0;
973         else {
974                 EMACS_TIME current_time;
975
976                 /* The time to block is the difference between the first
977                    (earliest) timer on the queue and the current time.
978                    If that is negative, then the timer will fire immediately
979                    but we still have to call select(), with a zero-valued
980                    timeout: user events must have precedence over timer events. */
981                 EMACS_GET_TIME(current_time);
982                 if (EMACS_TIME_GREATER(timeout_list->time, current_time))
983                         EMACS_SUB_TIME(*interval, timeout_list->time,
984                                        current_time);
985                 else
986                         EMACS_SET_SECS_USECS(*interval, 0, 0);
987                 return 1;
988         }
989 }
990
991 /* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return
992    its ID.  Also, if TIME_OUT is not 0, store the absolute time of the
993    timeout into TIME_OUT. */
994
995 int
996 pop_low_level_timeout(struct low_level_timeout **timeout_list,
997                       EMACS_TIME * time_out)
998 {
999         struct low_level_timeout *tm = *timeout_list;
1000         int id;
1001
1002         assert(tm);
1003         id = tm->id;
1004         if (time_out)
1005                 *time_out = tm->time;
1006         *timeout_list = tm->next;
1007         Blocktype_free(the_low_level_timeout_blocktype, tm);
1008         return id;
1009 }
1010 \f
1011 /**** High-level timeout functions. ****/
1012
1013 static int timeout_id_tick;
1014
1015 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1016
1017 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1018 static Lisp_Object Vtimeout_free_list;
1019 #endif  /* !BDWGC */
1020
1021 static Lisp_Object mark_timeout(Lisp_Object obj)
1022 {
1023         Lisp_Timeout *tm = XTIMEOUT(obj);
1024         mark_object(tm->function);
1025         return tm->object;
1026 }
1027
1028 /* Should never, ever be called. (except by an external debugger) */
1029 static void
1030 print_timeout(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1031 {
1032         const Lisp_Timeout *t = XTIMEOUT(obj);
1033         write_fmt_string(printcharfun, "#<INTERNAL OBJECT (SXEmacs bug?) (timeout) 0x%lx>",
1034                          (unsigned long)t);
1035 }
1036
1037 static const struct lrecord_description timeout_description[] = {
1038         {XD_LISP_OBJECT, offsetof(Lisp_Timeout, function)},
1039         {XD_LISP_OBJECT, offsetof(Lisp_Timeout, object)},
1040         {XD_END}
1041 };
1042
1043 DEFINE_LRECORD_IMPLEMENTATION("timeout", timeout,
1044                               mark_timeout, print_timeout,
1045                               0, 0, 0, timeout_description, Lisp_Timeout);
1046
1047 /* Generate a timeout and return its ID. */
1048
1049 int
1050 event_stream_generate_wakeup(unsigned int milliseconds,
1051                              unsigned int vanilliseconds,
1052                              Lisp_Object function, Lisp_Object object,
1053                              int async_p)
1054 {
1055 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1056         Lisp_Object op = wrap_object(
1057                 alloc_lcrecord(sizeof(Lisp_Timeout), &lrecord_timeout));
1058 #else  /* !BDWGC */
1059         Lisp_Object op = allocate_managed_lcrecord(Vtimeout_free_list);
1060 #endif  /* BDWGC */
1061         Lisp_Timeout *timeout = XTIMEOUT(op);
1062         EMACS_TIME current_time;
1063         EMACS_TIME interval;
1064
1065         timeout->id = timeout_id_tick++;
1066         timeout->resignal_msecs = vanilliseconds;
1067         timeout->function = function;
1068         timeout->object = object;
1069
1070         EMACS_GET_TIME(current_time);
1071         EMACS_SET_SECS_USECS(interval, milliseconds / 1000,
1072                              1000 * (milliseconds % 1000));
1073         EMACS_ADD_TIME(timeout->next_signal_time, current_time, interval);
1074
1075         if (async_p) {
1076                 timeout->interval_id =
1077                     event_stream_add_async_timeout(timeout->next_signal_time);
1078                 pending_async_timeout_list = noseeum_cons(op,
1079                                                           pending_async_timeout_list);
1080         } else {
1081                 timeout->interval_id =
1082                     event_stream_add_timeout(timeout->next_signal_time);
1083                 pending_timeout_list = noseeum_cons(op, pending_timeout_list);
1084         }
1085         return timeout->id;
1086 }
1087
1088 /* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout
1089    as necessary and return the timeout's ID and function and object slots.
1090
1091    This should be called as a result of receiving notice that a timeout
1092    has fired.  INTERVAL-ID is *not* the timeout's ID, but is the ID that
1093    identifies this particular firing of the timeout.  INTERVAL-ID's and
1094    timeout ID's are in separate number spaces and bear no relation to
1095    each other.  The INTERVAL-ID is all that the event callback routines
1096    work with: they work only with one-shot intervals, not with timeouts
1097    that may fire repeatedly.
1098
1099    NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all.
1100 */
1101
1102 static int
1103 event_stream_resignal_wakeup(int interval_id, int async_p,
1104                              Lisp_Object * function, Lisp_Object * object)
1105 {
1106         Lisp_Object op = Qnil, rest;
1107         Lisp_Timeout *timeout;
1108         Lisp_Object *timeout_list;
1109         struct gcpro gcpro1;
1110         int id;
1111
1112         GCPRO1(op);             /* just in case ...  because it's removed from the list
1113                                    for awhile. */
1114
1115         timeout_list =
1116             async_p ? &pending_async_timeout_list : &pending_timeout_list;
1117
1118         /* Find the timeout on the list of pending ones. */
1119         LIST_LOOP(rest, *timeout_list) {
1120                 timeout = XTIMEOUT(XCAR(rest));
1121                 if (timeout->interval_id == interval_id)
1122                         break;
1123         }
1124
1125         assert(!NILP(rest));
1126         op = XCAR(rest);
1127         timeout = XTIMEOUT(op);
1128         /* We make sure to snarf the data out of the timeout object before
1129            we free it with free_managed_lcrecord(). */
1130         id = timeout->id;
1131         *function = timeout->function;
1132         *object = timeout->object;
1133
1134         /* Remove this one from the list of pending timeouts */
1135         *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1136
1137         /* If this timeout wants to be resignalled, do it now. */
1138         if (timeout->resignal_msecs) {
1139                 EMACS_TIME current_time;
1140                 EMACS_TIME interval;
1141
1142                 /* Determine the time that the next resignalling should occur.
1143                    We do that by adding the interval time to the last signalled
1144                    time until we get a time that's current.
1145
1146                    (This way, it doesn't matter if the timeout was signalled
1147                    exactly when we asked for it, or at some time later.)
1148                  */
1149                 EMACS_GET_TIME(current_time);
1150                 EMACS_SET_SECS_USECS(interval, timeout->resignal_msecs / 1000,
1151                                      1000 * (timeout->resignal_msecs % 1000));
1152                 do {
1153                         EMACS_ADD_TIME(timeout->next_signal_time,
1154                                        timeout->next_signal_time, interval);
1155                 } while (EMACS_TIME_GREATER
1156                          (current_time, timeout->next_signal_time));
1157
1158                 if (async_p) {
1159                         timeout->interval_id =
1160                                 event_stream_add_async_timeout(
1161                                         timeout->next_signal_time);
1162                 } else {
1163                         timeout->interval_id =
1164                                 event_stream_add_timeout(
1165                                         timeout->next_signal_time);
1166                 }
1167                 /* Add back onto the list.  Note that the effect of this
1168                    is to move frequently-hit timeouts to the front of the
1169                    list, which is a good thing. */
1170                 *timeout_list = noseeum_cons(op, *timeout_list);
1171         } else {
1172 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1173                 xfree(op);
1174 #else  /* !BDWGC */
1175                 free_managed_lcrecord(Vtimeout_free_list, op);
1176 #endif  /* BDWGC */
1177         }
1178         UNGCPRO;
1179         return id;
1180 }
1181
1182 void event_stream_disable_wakeup(int id, int async_p)
1183 {
1184         Lisp_Timeout *timeout = 0;
1185         Lisp_Object rest;
1186         Lisp_Object *timeout_list;
1187
1188         if (async_p) {
1189                 timeout_list = &pending_async_timeout_list;
1190         } else {
1191                 timeout_list = &pending_timeout_list;
1192         }
1193         /* Find the timeout on the list of pending ones, if it's still there. */
1194         LIST_LOOP(rest, *timeout_list) {
1195                 timeout = XTIMEOUT(XCAR(rest));
1196                 if (timeout->id == id) {
1197                         break;
1198                 }
1199         }
1200
1201         /* If we found it, remove it from the list and disable the pending
1202            one-shot. */
1203         if (!NILP(rest)) {
1204                 Lisp_Object op = XCAR(rest);
1205                 *timeout_list = delq_no_quit_and_free_cons(op, *timeout_list);
1206                 if (async_p) {
1207                         event_stream_remove_async_timeout(timeout->interval_id);
1208                 } else {
1209                         event_stream_remove_timeout(timeout->interval_id);
1210                 }
1211 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1212                 xfree(op);
1213 #else  /* !BDWGC */
1214                 free_managed_lcrecord(Vtimeout_free_list, op);
1215 #endif  /* BDWGC */
1216         }
1217 }
1218
1219 static int event_stream_wakeup_pending_p(int id, int async_p)
1220 {
1221         Lisp_Timeout *timeout;
1222         Lisp_Object rest;
1223         Lisp_Object timeout_list;
1224         int found = 0;
1225
1226         if (async_p)
1227                 timeout_list = pending_async_timeout_list;
1228         else
1229                 timeout_list = pending_timeout_list;
1230
1231         /* Find the element on the list of pending ones, if it's still there. */
1232         LIST_LOOP(rest, timeout_list) {
1233                 timeout = XTIMEOUT(XCAR(rest));
1234                 if (timeout->id == id) {
1235                         found = 1;
1236                         break;
1237                 }
1238         }
1239
1240         return found;
1241 }
1242 \f
1243 /**** Asynch. timeout functions (see also signal.c) ****/
1244
1245 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1246 extern int poll_for_quit_id;
1247 #endif
1248
1249 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1250 extern int poll_for_sigchld_id;
1251 #endif
1252
1253 void event_stream_deal_with_async_timeout(int interval_id)
1254 {
1255         /* This function can GC */
1256         Lisp_Object humpty, dumpty;
1257 #if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \
1258      || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD))
1259         int id =
1260 #endif
1261             event_stream_resignal_wakeup(interval_id, 1, &humpty, &dumpty);
1262
1263 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)
1264         if (id == poll_for_quit_id) {
1265                 quit_check_signal_happened = 1;
1266                 quit_check_signal_tick_count++;
1267                 return;
1268         }
1269 #endif
1270
1271 #if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)
1272         if (id == poll_for_sigchld_id) {
1273                 kick_status_notify();
1274                 return;
1275         }
1276 #endif
1277
1278         /* call1 GC-protects its arguments */
1279         call1_trapping_errors("Error in asynchronous timeout callback",
1280                               humpty, dumpty);
1281 }
1282 \f
1283 /**** Lisp-level timeout functions. ****/
1284
1285 static unsigned long lisp_number_to_milliseconds(Lisp_Object secs, int allow_0)
1286 {
1287 #if defined(WITH_NUMBER_TYPES)
1288         double fsecs;
1289         CHECK_NUMBER(secs);
1290         fsecs = extract_float(secs);
1291 #else  /* !WITH_NUMBER_TYPES */
1292 #ifdef HAVE_FPFLOAT
1293         double fsecs;
1294         CHECK_INT_OR_FLOAT(secs);
1295         fsecs = XFLOATINT(secs);
1296 #else
1297         long fsecs;
1298         CHECK_INT(secs);
1299         fsecs = XINT(secs);
1300 #endif  /* HAVE_FPFLOAT */
1301 #endif  /* WITH_NUMBER_TYPES */
1302         if (fsecs < 0)
1303                 signal_simple_error("timeout is negative", secs);
1304         if (!allow_0 && fsecs == 0)
1305                 signal_simple_error("timeout is non-positive", secs);
1306         if (fsecs >= (((unsigned int)0xFFFFFFFF) / 1000))
1307                 signal_simple_error
1308                     ("timeout would exceed 32 bits when represented in milliseconds",
1309                      secs);
1310
1311         return (unsigned long)(1000 * fsecs);
1312 }
1313
1314 DEFUN("add-timeout", Fadd_timeout, 3, 4, 0,     /*
1315 Add a timeout, to be signaled after the timeout period has elapsed.
1316 SECS is a number of seconds, expressed as an integer or a float.
1317 FUNCTION will be called after that many seconds have elapsed, with one
1318 argument, the given OBJECT.  If the optional RESIGNAL argument is provided,
1319 then after this timeout expires, `add-timeout' will automatically be called
1320 again with RESIGNAL as the first argument.
1321
1322 This function returns an object which is the id number of this particular
1323 timeout.  You can pass that object to `disable-timeout' to turn off the
1324 timeout before it has been signalled.
1325
1326 NOTE: Id numbers as returned by this function are in a distinct namespace
1327 from those returned by `add-async-timeout'.  This means that the same id
1328 number could refer to a pending synchronous timeout and a different pending
1329 asynchronous timeout, and that you cannot pass an id from `add-timeout'
1330 to `disable-async-timeout', or vice-versa.
1331
1332 The number of seconds may be expressed as a floating-point number, in which
1333 case some fractional part of a second will be used.  Caveat: the usable
1334 timeout granularity will vary from system to system.
1335
1336 Adding a timeout causes a timeout event to be returned by `next-event', and
1337 the function will be invoked by `dispatch-event,' so if emacs is in a tight
1338 loop, the function will not be invoked until the next call to sit-for or
1339 until the return to top-level (the same is true of process filters).
1340
1341 If you need to have a timeout executed even when SXEmacs is in the midst of
1342 running Lisp code, use `add-async-timeout'.
1343
1344 WARNING: if you are thinking of calling add-timeout from inside of a
1345 callback function as a way of resignalling a timeout, think again.  There
1346 is a race condition.  That's why the RESIGNAL argument exists.
1347 */
1348       (secs, function, object, resignal))
1349 {
1350         unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1351         unsigned long msecs2 = (NILP(resignal) ? 0 :
1352                                 lisp_number_to_milliseconds(resignal, 0));
1353         int id;
1354         Lisp_Object lid;
1355         id = event_stream_generate_wakeup(msecs, msecs2, function, object, 0);
1356         lid = make_int(id);
1357         if (id != XINT(lid))
1358                 abort();
1359         return lid;
1360 }
1361
1362 DEFUN("disable-timeout", Fdisable_timeout, 1, 1, 0,     /*
1363 Disable a timeout from signalling any more.
1364 ID should be a timeout id number as returned by `add-timeout'.  If ID
1365 corresponds to a one-shot timeout that has already signalled, nothing
1366 will happen.
1367
1368 It will not work to call this function on an id number returned by
1369 `add-async-timeout'.  Use `disable-async-timeout' for that.
1370 */
1371       (id))
1372 {
1373         CHECK_INT(id);
1374         event_stream_disable_wakeup(XINT(id), 0);
1375         return Qnil;
1376 }
1377
1378 DEFUN("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /*
1379 Add an asynchronous timeout, to be signaled after an interval has elapsed.
1380 SECS is a number of seconds, expressed as an integer or a float.
1381 FUNCTION will be called after that many seconds have elapsed, with one
1382 argument, the given OBJECT.  If the optional RESIGNAL argument is provided,
1383 then after this timeout expires, `add-async-timeout' will automatically be
1384 called again with RESIGNAL as the first argument.
1385
1386 This function returns an object which is the id number of this particular
1387 timeout.  You can pass that object to `disable-async-timeout' to turn off
1388 the timeout before it has been signalled.
1389
1390 NOTE: Id numbers as returned by this function are in a distinct namespace
1391 from those returned by `add-timeout'.  This means that the same id number
1392 could refer to a pending synchronous timeout and a different pending
1393 asynchronous timeout, and that you cannot pass an id from
1394 `add-async-timeout' to `disable-timeout', or vice-versa.
1395
1396 The number of seconds may be expressed as a floating-point number, in which
1397 case some fractional part of a second will be used.  Caveat: the usable
1398 timeout granularity will vary from system to system.
1399
1400 Adding an asynchronous timeout causes the function to be invoked as soon
1401 as the timeout occurs, even if SXEmacs is in the midst of executing some
1402 other code. (This is unlike the synchronous timeouts added with
1403 `add-timeout', where the timeout will only be signalled when SXEmacs is
1404 waiting for events, i.e. the next return to top-level or invocation of
1405 `sit-for' or related functions.) This means that the function that is
1406 called *must* not signal an error or change any global state (e.g. switch
1407 buffers or windows) except when locking code is in place to make sure
1408 that race conditions don't occur in the interaction between the
1409 asynchronous timeout function and other code.
1410
1411 Under most circumstances, you should use `add-timeout' instead, as it is
1412 much safer.  Asynchronous timeouts should only be used when such behavior
1413 is really necessary.
1414
1415 Asynchronous timeouts are blocked and will not occur when `inhibit-quit'
1416 is non-nil.  As soon as `inhibit-quit' becomes nil again, any pending
1417 asynchronous timeouts will get called immediately. (Multiple occurrences
1418 of the same asynchronous timeout are not queued, however.) While the
1419 callback function of an asynchronous timeout is invoked, `inhibit-quit'
1420 is automatically bound to non-nil, and thus other asynchronous timeouts
1421 will be blocked unless the callback function explicitly sets `inhibit-quit'
1422 to nil.
1423
1424 WARNING: if you are thinking of calling `add-async-timeout' from inside of a
1425 callback function as a way of resignalling a timeout, think again.  There
1426 is a race condition.  That's why the RESIGNAL argument exists.
1427 */
1428       (secs, function, object, resignal))
1429 {
1430         unsigned long msecs = lisp_number_to_milliseconds(secs, 0);
1431         unsigned long msecs2 = (NILP(resignal) ? 0 :
1432                                 lisp_number_to_milliseconds(resignal, 0));
1433         int id;
1434         Lisp_Object lid;
1435         id = event_stream_generate_wakeup(msecs, msecs2, function, object, 1);
1436         lid = make_int(id);
1437         if (id != XINT(lid))
1438                 abort();
1439         return lid;
1440 }
1441
1442 DEFUN("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /*
1443 Disable an asynchronous timeout from signalling any more.
1444 ID should be a timeout id number as returned by `add-async-timeout'.  If ID
1445 corresponds to a one-shot timeout that has already signalled, nothing
1446 will happen.
1447
1448 It will not work to call this function on an id number returned by
1449 `add-timeout'.  Use `disable-timeout' for that.
1450 */
1451       (id))
1452 {
1453         CHECK_INT(id);
1454         event_stream_disable_wakeup(XINT(id), 1);
1455         return Qnil;
1456 }
1457 \f
1458 /**********************************************************************/
1459 /*                    enqueuing and dequeuing events                  */
1460 /**********************************************************************/
1461
1462 /* Add an event to the back of the command-event queue: it will be the next
1463    event read after all pending events.   This only works on keyboard,
1464    mouse-click, misc-user, and eval events.
1465  */
1466 static void enqueue_command_event(Lisp_Object event)
1467 {
1468 #ifdef EF_USE_ASYNEQ
1469         eq_enqueue(asyneq, event);
1470 #else
1471         enqueue_event(event, &command_event_queue, &command_event_queue_tail);
1472 #endif
1473 }
1474
1475 static Lisp_Object dequeue_command_event(void)
1476 {
1477 #ifdef EF_USE_ASYNEQ
1478         return eq_dequeue(asyneq);
1479 #else
1480         return dequeue_event(&command_event_queue, &command_event_queue_tail);
1481 #endif
1482 }
1483
1484 /* put the event on the typeahead queue, unless
1485    the event is the quit char, in which case the `QUIT'
1486    which will occur on the next trip through this loop is
1487    all the processing we should do - leaving it on the queue
1488    would cause the quit to be processed twice.
1489    */
1490 static void enqueue_command_event_1(Lisp_Object event_to_copy)
1491 {
1492         /* do not call check_quit() here.  Vquit_flag was set in
1493            next_event_internal. */
1494         if (NILP(Vquit_flag))
1495                 enqueue_command_event(Fcopy_event(event_to_copy, Qnil));
1496 }
1497
1498 void enqueue_magic_eval_event(void (*fun) (Lisp_Object), Lisp_Object object)
1499 {
1500         Lisp_Object event = Fmake_event(Qnil, Qnil);
1501
1502         XEVENT(event)->event_type = magic_eval_event;
1503         /* channel for magic_eval events is nil */
1504         XEVENT(event)->event.magic_eval.internal_function = fun;
1505         XEVENT(event)->event.magic_eval.object = object;
1506         enqueue_command_event(event);
1507 }
1508
1509 DEFUN("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0,       /*
1510 Add an eval event to the back of the eval event queue.
1511 When this event is dispatched, FUNCTION (which should be a function
1512 of one argument) will be called with OBJECT as its argument.
1513 See `next-event' for a description of event types and how events
1514 are received.
1515 */
1516       (function, object))
1517 {
1518         Lisp_Object event = Fmake_event(Qnil, Qnil);
1519
1520         XEVENT(event)->event_type = eval_event;
1521         /* channel for eval events is nil */
1522         XEVENT(event)->event.eval.function = function;
1523         XEVENT(event)->event.eval.object = object;
1524         enqueue_command_event(event);
1525
1526         return event;
1527 }
1528
1529 Lisp_Object
1530 enqueue_misc_user_event(Lisp_Object channel, Lisp_Object function,
1531                         Lisp_Object object)
1532 {
1533         Lisp_Object event = Fmake_event(Qnil, Qnil);
1534
1535         XEVENT(event)->event_type = misc_user_event;
1536         XEVENT(event)->channel = channel;
1537         XEVENT(event)->event.misc.function = function;
1538         XEVENT(event)->event.misc.object = object;
1539         XEVENT(event)->event.misc.button = 0;
1540         XEVENT(event)->event.misc.modifiers = 0;
1541         XEVENT(event)->event.misc.x = -1;
1542         XEVENT(event)->event.misc.y = -1;
1543         enqueue_command_event(event);
1544
1545         return event;
1546 }
1547
1548 Lisp_Object
1549 enqueue_misc_user_event_pos(Lisp_Object channel, Lisp_Object function,
1550                             Lisp_Object object,
1551                             int button, int modifiers, int x, int y)
1552 {
1553         Lisp_Object event = Fmake_event(Qnil, Qnil);
1554
1555         XEVENT(event)->event_type = misc_user_event;
1556         XEVENT(event)->channel = channel;
1557         XEVENT(event)->event.misc.function = function;
1558         XEVENT(event)->event.misc.object = object;
1559         XEVENT(event)->event.misc.button = button;
1560         XEVENT(event)->event.misc.modifiers = modifiers;
1561         XEVENT(event)->event.misc.x = x;
1562         XEVENT(event)->event.misc.y = y;
1563         enqueue_command_event(event);
1564
1565         return event;
1566 }
1567 \f
1568 /**********************************************************************/
1569 /*                       focus-event handling                         */
1570 /**********************************************************************/
1571
1572 /*
1573
1574 Ben's capsule lecture on focus:
1575
1576 In FSFmacs `select-frame' never changes the window-manager frame
1577 focus.  All it does is change the "selected frame".  This is similar
1578 to what happens when we call `select-device' or `select-console'.
1579 Whenever an event comes in (including a keyboard event), its frame is
1580 selected; therefore, evaluating `select-frame' in *scratch* won't
1581 cause any effects because the next received event (in the same frame)
1582 will cause a switch back to the frame displaying *scratch*.
1583
1584 Whenever a focus-change event is received from the window manager, it
1585 generates a `switch-frame' event, which causes the Lisp function
1586 `handle-switch-frame' to get run.  This basically just runs
1587 `select-frame' (see below, however).
1588
1589 In FSFmacs, if you want to have an operation run when a frame is
1590 selected, you supply an event binding for `switch-frame' (and then
1591 maybe call `handle-switch-frame', or something ...).
1592
1593 In SXEmacs, we *do* change the window-manager frame focus as a result
1594 of `select-frame', but not until the next time an event is received,
1595 so that a function that momentarily changes the selected frame won't
1596 cause WM focus flashing. (#### There's something not quite right here;
1597 this is causing the wrong-cursor-focus problems that you occasionally
1598 see.  But the general idea is correct.) This approach is winning for
1599 people who use the explicit-focus model, but is trickier to implement.
1600
1601 We also don't make the `switch-frame' event visible but instead have
1602 `select-frame-hook', which is a better approach.
1603
1604 There is the problem of surrogate minibuffers, where when we enter the
1605 minibuffer, you essentially want to temporarily switch the WM focus to
1606 the frame with the minibuffer, and switch it back when you exit the
1607 minibuffer.
1608
1609 FSFmacs solves this with the crockish `redirect-frame-focus', which
1610 says "for keyboard events received from FRAME, act like they're
1611 coming from FOCUS-FRAME".  I think what this means is that, when
1612 a keyboard event comes in and the event manager is about to select the
1613 event's frame, if that frame has its focus redirected, the redirected-to
1614 frame is selected instead.  That way, if you're in a minibufferless
1615 frame and enter the minibuffer, then all Lisp functions that run see
1616 the selected frame as the minibuffer's frame rather than the minibufferless
1617 frame you came from, so that (e.g.) your typing actually appears in
1618 the minibuffer's frame and things behave sanely.
1619
1620 There's also some weird logic that switches the redirected frame focus
1621 from one frame to another if Lisp code explicitly calls `select-frame'
1622 \(but not if `handle-switch-frame' is called), and saves and restores
1623 the frame focus in window configurations, etc. etc.  All of this logic
1624 is heavily #if 0'd, with lots of comments saying "No, this approach
1625 doesn't seem to work, so I'm trying this ...  is it reasonable?
1626 Well, I'm not sure ..." that are a red flag indicating crockishness.
1627
1628 Because of our way of doing things, we can avoid all this crock.
1629 Keyboard events never cause a select-frame (who cares what frame
1630 they're associated with?  They come from a console, only).  We change
1631 the actual WM focus to a surrogate minibuffer frame, so we don't have
1632 to do any internal redirection.  In order to get the focus back,
1633 I took the approach in minibuf.el of just checking to see if the
1634 frame we moved to is still the selected frame, and move back to the
1635 old one if so.  Conceivably we might have to do the weird "tracking"
1636 that FSFmacs does when `select-frame' is called, but I don't think
1637 so.  If the selected frame moved from the minibuffer frame, then
1638 we just leave it there, figuring that someone knows what they're
1639 doing.  Because we don't have any redirection recorded anywhere,
1640 it's safe to do this, and we don't end up with unwanted redirection.
1641
1642 */
1643
1644 static void run_select_frame_hook(void)
1645 {
1646         run_hook(Qselect_frame_hook);
1647 }
1648
1649 static void run_deselect_frame_hook(void)
1650 {
1651         run_hook(Qdeselect_frame_hook);
1652 }
1653
1654 /* When select-frame is called and focus_follows_mouse is false, we want
1655    to tell the window system that the focus should be changed to point to
1656    the new frame.  However,
1657    sometimes Lisp functions will temporarily change the selected frame
1658    (e.g. to call a function that operates on the selected frame),
1659    and it's annoying if this focus-change happens exactly when
1660    select-frame is called, because then you get some flickering of the
1661    window-manager border and perhaps other undesirable results.  We
1662    really only want to change the focus when we're about to retrieve
1663    an event from the user.  To do this, we keep track of the frame
1664    where the window-manager focus lies on, and just before waiting
1665    for user events, check the currently selected frame and change
1666    the focus as necessary.
1667
1668    On the other hand, if focus_follows_mouse is true, we need to switch the
1669    selected frame back to the frame with window manager focus just before we
1670    execute the next command in Fcommand_loop_1, just as the selected buffer is
1671    reverted after a set-buffer.
1672
1673    Both cases are handled by this function.  It must be called as appropriate
1674    from these two places, depending on the value of focus_follows_mouse. */
1675
1676 void investigate_frame_change(void)
1677 {
1678         Lisp_Object devcons, concons;
1679
1680         /* if the selected frame was changed, change the window-system
1681            focus to the new frame.  We don't do it when select-frame was
1682            called, to avoid flickering and other unwanted side effects when
1683            the frame is just changed temporarily. */
1684         DEVICE_LOOP_NO_BREAK(devcons, concons) {
1685                 struct device *d = XDEVICE(XCAR(devcons));
1686                 Lisp_Object sel_frame = DEVICE_SELECTED_FRAME(d);
1687
1688                 /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL,
1689                    but that can cause us to end up in an infinite loop focusing
1690                    between two frames.  It seems that since the call to `select-frame'
1691                    in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
1692                    value, we need to do so too. */
1693                 if (!NILP(sel_frame) &&
1694                     !EQ(DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d), sel_frame) &&
1695                     !NILP(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)) &&
1696                     !EQ(DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d), sel_frame)) {
1697                         /* At this point, we know that the frame has been changed.  Now, if
1698                          * focus_follows_mouse is not set, we finish off the frame change,
1699                          * so that user events will now come from the new frame.  Otherwise,
1700                          * if focus_follows_mouse is set, no gratuitous frame changing
1701                          * should take place.  Set the focus back to the frame which was
1702                          * originally selected for user input.
1703                          */
1704                         if (!focus_follows_mouse) {
1705                                 /* prevent us from issuing the same request more than once */
1706                                 DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) =
1707                                     sel_frame;
1708                                 MAYBE_DEVMETH(d, focus_on_frame,
1709                                               (XFRAME(sel_frame)));
1710                         } else {
1711                                 Lisp_Object old_frame = Qnil;
1712
1713                                 /* #### Do we really want to check OUGHT ??
1714                                  * It seems to make sense, though I have never seen us
1715                                  * get here and have it be non-nil.
1716                                  */
1717                                 if (FRAMEP
1718                                     (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d)))
1719                                         old_frame =
1720                                             DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS
1721                                             (d);
1722                                 else if (FRAMEP
1723                                          (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d)))
1724                                         old_frame =
1725                                             DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS
1726                                             (d);
1727
1728                                 /* #### Can old_frame ever be NIL?  play it safe.. */
1729                                 if (!NILP(old_frame)) {
1730                                         /* Fselect_frame is not really the right thing: it frobs the
1731                                          * buffer stack.  But there's no easy way to do the right
1732                                          * thing, and this code already had this problem anyway.
1733                                          */
1734                                         Fselect_frame(old_frame);
1735                                 }
1736                         }
1737                 }
1738         }
1739 }
1740
1741 static Lisp_Object cleanup_after_missed_defocusing(Lisp_Object frame)
1742 {
1743         if (FRAMEP(frame) && FRAME_LIVE_P(XFRAME(frame)))
1744                 Fselect_frame(frame);
1745         return Qnil;
1746 }
1747
1748 void emacs_handle_focus_change_preliminary(Lisp_Object frame_inp_and_dev)
1749 {
1750         Lisp_Object frame = Fcar(frame_inp_and_dev);
1751         Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1752         int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1753         struct device *d;
1754
1755         if (!DEVICE_LIVE_P(XDEVICE(device)))
1756                 return;
1757         else
1758                 d = XDEVICE(device);
1759
1760         /* Any received focus-change notifications render invalid any
1761            pending focus-change requests. */
1762         DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) = Qnil;
1763         if (in_p) {
1764                 Lisp_Object focus_frame;
1765
1766                 if (!FRAME_LIVE_P(XFRAME(frame)))
1767                         return;
1768                 else
1769                         focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1770
1771                 /* Mark the minibuffer as changed to make sure it gets updated
1772                    properly if the echo area is active. */
1773                 {
1774                         struct window *w =
1775                             XWINDOW(FRAME_MINIBUF_WINDOW(XFRAME(frame)));
1776                         MARK_WINDOWS_CHANGED(w);
1777                 }
1778
1779                 if (FRAMEP(focus_frame) && FRAME_LIVE_P(XFRAME(focus_frame))
1780                     && !EQ(frame, focus_frame)) {
1781                         /* Oops, we missed a focus-out event. */
1782                         DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1783                         redisplay_redraw_cursor(XFRAME(focus_frame), 1);
1784                 }
1785                 DEVICE_FRAME_WITH_FOCUS_REAL(d) = frame;
1786                 if (!EQ(frame, focus_frame)) {
1787                         redisplay_redraw_cursor(XFRAME(frame), 1);
1788                 }
1789         } else {
1790                 /* We ignore the frame reported in the event.  If it's different
1791                    from where we think the focus was, oh well -- we messed up.
1792                    Nonetheless, we pretend we were right, for sensible behavior. */
1793                 frame = DEVICE_FRAME_WITH_FOCUS_REAL(d);
1794                 if (!NILP(frame)) {
1795                         DEVICE_FRAME_WITH_FOCUS_REAL(d) = Qnil;
1796
1797                         if (FRAME_LIVE_P(XFRAME(frame)))
1798                                 redisplay_redraw_cursor(XFRAME(frame), 1);
1799                 }
1800         }
1801 }
1802
1803 /* Called from the window-system-specific code when we receive a
1804    notification that the focus lies on a particular frame.
1805    Argument is a cons: (frame . (device . in-p)) where in-p is non-nil
1806    for focus-in.
1807  */
1808 void emacs_handle_focus_change_final(Lisp_Object frame_inp_and_dev)
1809 {
1810         Lisp_Object frame = Fcar(frame_inp_and_dev);
1811         Lisp_Object device = Fcar(Fcdr(frame_inp_and_dev));
1812         int in_p = !NILP(Fcdr(Fcdr(frame_inp_and_dev)));
1813         struct device *d;
1814         int count;
1815
1816         if (!DEVICE_LIVE_P(XDEVICE(device)))
1817                 return;
1818         else
1819                 d = XDEVICE(device);
1820
1821         if (in_p) {
1822                 Lisp_Object focus_frame;
1823
1824                 if (!FRAME_LIVE_P(XFRAME(frame)))
1825                         return;
1826                 else
1827                         focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1828
1829                 DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = frame;
1830                 if (FRAMEP(focus_frame) && !EQ(frame, focus_frame)) {
1831                         /* Oops, we missed a focus-out event. */
1832                         Fselect_frame(focus_frame);
1833                         /* Do an unwind-protect in case an error occurs in
1834                            the deselect-frame-hook */
1835                         count = specpdl_depth();
1836                         record_unwind_protect(cleanup_after_missed_defocusing,
1837                                               frame);
1838                         run_deselect_frame_hook();
1839                         unbind_to(count, Qnil);
1840                         /* the cleanup method changed the focus frame to nil, so
1841                            we need to reflect this */
1842                         focus_frame = Qnil;
1843                 } else
1844                         Fselect_frame(frame);
1845                 if (!EQ(frame, focus_frame))
1846                         run_select_frame_hook();
1847         } else {
1848                 /* We ignore the frame reported in the event.  If it's different
1849                    from where we think the focus was, oh well -- we messed up.
1850                    Nonetheless, we pretend we were right, for sensible behavior. */
1851                 frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d);
1852                 if (!NILP(frame)) {
1853                         DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) = Qnil;
1854                         run_deselect_frame_hook();
1855                 }
1856         }
1857 }
1858 \f
1859 /**********************************************************************/
1860 /*                      retrieving the next event                     */
1861 /**********************************************************************/
1862
1863 static int in_single_console;
1864
1865 /* #### These functions don't currently do anything. */
1866 void single_console_state(void)
1867 {
1868         in_single_console = 1;
1869 }
1870
1871 void any_console_state(void)
1872 {
1873         in_single_console = 0;
1874 }
1875
1876 int in_single_console_state(void)
1877 {
1878         return in_single_console;
1879 }
1880
1881 /* the number of keyboard characters read.  callint.c wants this. */
1882 Charcount num_input_chars;
1883
1884 static void next_event_internal(Lisp_Object target_event, int allow_queued)
1885 {
1886         struct gcpro gcpro1;
1887         /* QUIT;   This is incorrect - the caller must do this because some
1888            callers (ie, Fnext_event()) do not want to QUIT. */
1889
1890         assert(NILP(XEVENT_NEXT(target_event)));
1891
1892         GCPRO1(target_event);
1893
1894         /* When focus_follows_mouse is nil, if a frame change took place, we need
1895          * to actually switch window manager focus to the selected window now.
1896          */
1897         if (!focus_follows_mouse)
1898                 investigate_frame_change();
1899
1900         if (allow_queued && !EQ_EMPTY_P()) {
1901                 Lisp_Object event = dequeue_command_event();
1902                 Fcopy_event(event, target_event);
1903                 Fdeallocate_event(event);
1904                 DEBUG_PRINT_EMACS_EVENT("command event queue", target_event);
1905         } else {
1906                 Lisp_Event *e = XEVENT(target_event);
1907
1908                 /* The command_event_queue was empty.  Wait for an event. */
1909                 event_stream_next_event(e);
1910                 /* If this was a timeout, then we need to extract some data
1911                    out of the returned closure and might need to resignal
1912                    it. */
1913                 if (e->event_type == timeout_event) {
1914                         Lisp_Object tristan, isolde;
1915
1916                         e->event.timeout.id_number =
1917                             event_stream_resignal_wakeup(e->event.timeout.
1918                                                          interval_id, 0,
1919                                                          &tristan, &isolde);
1920
1921                         e->event.timeout.function = tristan;
1922                         e->event.timeout.object = isolde;
1923                         /* next_event_internal() doesn't print out timeout events
1924                            because of the extra info we just set. */
1925                         DEBUG_PRINT_EMACS_EVENT("real, timeout", target_event);
1926                 }
1927
1928                 /* If we read a ^G, then set quit-flag but do not discard the ^G.
1929                    The callers of next_event_internal() will do one of two things:
1930
1931                    -- set Vquit_flag to Qnil. (next-event does this.) This will
1932                    cause the ^G to be treated as a normal keystroke.
1933                    -- not change Vquit_flag but attempt to enqueue the ^G, at
1934                    which point it will be discarded.  The next time QUIT is
1935                    called, it will notice that Vquit_flag was set.
1936
1937                  */
1938                 if (e->event_type == key_press_event &&
1939                     event_matches_key_specifier_p
1940                     (e,
1941                      make_char(CONSOLE_QUIT_CHAR(XCONSOLE(EVENT_CHANNEL(e))))))
1942                 {
1943                         Vquit_flag = Qt;
1944                 }
1945         }
1946
1947         UNGCPRO;
1948 }
1949
1950 static void run_pre_idle_hook(void)
1951 {
1952         if (!NILP(Vpre_idle_hook)
1953             && !detect_input_pending())
1954                 safe_run_hook_trapping_errors
1955                     ("Error in `pre-idle-hook' (setting hook to nil)",
1956                      Qpre_idle_hook, 1);
1957 }
1958
1959 static void push_this_command_keys(Lisp_Object event);
1960 static void push_recent_keys(Lisp_Object event);
1961 static void dribble_out_event(Lisp_Object event);
1962 static void execute_internal_event(Lisp_Object event);
1963 static int is_scrollbar_event(Lisp_Object event);
1964
1965 DEFUN("next-event", Fnext_event, 0, 2, 0,       /*
1966 Return the next available event.
1967 Pass this object to `dispatch-event' to handle it.
1968 In most cases, you will want to use `next-command-event', which returns
1969 the next available "user" event (i.e. keypress, button-press,
1970 button-release, or menu selection) instead of this function.
1971
1972 If EVENT is non-nil, it should be an event object and will be filled in
1973 and returned; otherwise a new event object will be created and returned.
1974 If PROMPT is non-nil, it should be a string and will be displayed in the
1975 echo area while this function is waiting for an event.
1976
1977 The next available event will be
1978
1979 -- any events in `unread-command-events' or `unread-command-event'; else
1980 -- the next event in the currently executing keyboard macro, if any; else
1981 -- an event queued by `enqueue-eval-event', if any, or any similar event
1982    queued internally, such as a misc-user event. (For example, when an item
1983    is selected from a menu or from a `question'-type dialog box, the item's
1984    callback is not immediately executed, but instead a misc-user event
1985    is generated and placed onto this queue; when it is dispatched, the
1986    callback is executed.) Else
1987 -- the next available event from the window system or terminal driver.
1988
1989 In the last case, this function will block until an event is available.
1990
1991 The returned event will be one of the following types:
1992
1993 -- a key-press event.
1994 -- a button-press or button-release event.
1995 -- a misc-user-event, meaning the user selected an item on a menu or used
1996    the scrollbar.
1997 -- a process event, meaning that output from a subprocess is available.
1998 -- a timeout event, meaning that a timeout has elapsed.
1999 -- an eval event, which simply causes a function to be executed when the
2000    event is dispatched.  Eval events are generated by `enqueue-eval-event'
2001    or by certain other conditions happening.
2002 -- a magic event, indicating that some window-system-specific event
2003    happened (such as a focus-change notification) that must be handled
2004    synchronously with other events.  `dispatch-event' knows what to do with
2005    these events.
2006 */
2007       (event, prompt))
2008 {
2009         /* This function can call lisp */
2010         /* #### We start out using the selected console before an event
2011            is received, for echoing the partially completed command.
2012            This is most definitely wrong -- there needs to be a separate
2013            echo area for each console! */
2014         struct console *con = XCONSOLE(Vselected_console);
2015         struct command_builder *command_builder =
2016             XCOMMAND_BUILDER(con->command_builder);
2017         int store_this_key = 0;
2018         struct gcpro gcpro1;
2019
2020         GCPRO1(event);
2021         /* DO NOT do QUIT anywhere within this function or the functions it calls.
2022            We want to read the ^G as an event. */
2023
2024 #ifdef LWLIB_MENUBARS_LUCID
2025         /*
2026          * #### Fix the menu code so this isn't necessary.
2027          *
2028          * We cannot allow the lwmenu code to be reentered, because the
2029          * code is not written to be reentrant and will crash.  Therefore
2030          * paths from the menu callbacks back into the menu code have to
2031          * be blocked.  Fnext_event is the normal path into the menu code,
2032          * so we signal an error here.
2033          */
2034         if (in_menu_callback)
2035                 error("Attempt to call next-event inside menu callback");
2036 #endif                          /* LWLIB_MENUBARS_LUCID */
2037
2038         if (NILP(event))
2039                 event = Fmake_event(Qnil, Qnil);
2040         else
2041                 CHECK_LIVE_EVENT(event);
2042
2043         if (!NILP(prompt)) {
2044                 Bytecount len;
2045                 CHECK_STRING(prompt);
2046
2047                 len = XSTRING_LENGTH(prompt);
2048                 if (command_builder->echo_buf_length < len)
2049                         len = command_builder->echo_buf_length - 1;
2050                 memcpy(command_builder->echo_buf, XSTRING_DATA(prompt), len);
2051                 command_builder->echo_buf[len] = 0;
2052                 command_builder->echo_buf_index = len;
2053                 echo_area_message(XFRAME(CONSOLE_SELECTED_FRAME(con)),
2054                                   command_builder->echo_buf,
2055                                   Qnil, 0,
2056                                   command_builder->echo_buf_index, Qcommand);
2057         }
2058
2059       start_over_and_avoid_hosage:
2060         /* If there is something in unread-command-events, simply return it.
2061            But do some error checking to make sure the user hasn't put something
2062            in the unread-command-events that they shouldn't have.
2063            This does not update this-command-keys and recent-keys.
2064          */
2065         if (!NILP(Vunread_command_events)) {
2066                 if (!CONSP(Vunread_command_events)) {
2067                         Vunread_command_events = Qnil;
2068                         signal_error(Qwrong_type_argument,
2069                                      list3(Qconsp, Vunread_command_events,
2070                                            Qunread_command_events));
2071                 } else {
2072                         Lisp_Object e = XCAR(Vunread_command_events);
2073                         Vunread_command_events = XCDR(Vunread_command_events);
2074                         if (!EVENTP(e) || !command_event_p(e))
2075                                 signal_error(Qwrong_type_argument,
2076                                              list3(Qcommand_event_p, e,
2077                                                    Qunread_command_events));
2078                         redisplay();
2079                         if (!EQ(e, event))
2080                                 Fcopy_event(e, event);
2081                         DEBUG_PRINT_EMACS_EVENT("unread-command-events", event);
2082                 }
2083         }
2084
2085         /* Do similar for unread-command-event (obsoleteness support). */
2086         else if (!NILP(Vunread_command_event)) {
2087                 Lisp_Object e = Vunread_command_event;
2088                 Vunread_command_event = Qnil;
2089
2090                 if (!EVENTP(e) || !command_event_p(e)) {
2091                         signal_error(Qwrong_type_argument,
2092                                      list3(Qeventp, e, Qunread_command_event));
2093                 }
2094                 if (!EQ(e, event))
2095                         Fcopy_event(e, event);
2096                 redisplay();
2097                 DEBUG_PRINT_EMACS_EVENT("unread-command-event", event);
2098         }
2099
2100         /* If we're executing a keyboard macro, take the next event from that,
2101            and update this-command-keys and recent-keys.
2102            Note that the unread-command-events take precedence over kbd macros.
2103          */
2104         else {
2105                 if (!NILP(Vexecuting_macro)) {
2106                         redisplay();
2107                         pop_kbd_macro_event(event);     /* This throws past us at
2108                                                            end-of-macro. */
2109                         store_this_key = 1;
2110                         DEBUG_PRINT_EMACS_EVENT("keyboard macro", event);
2111                 }
2112                 /* Otherwise, read a real event, possibly from the
2113                    command_event_queue, and update this-command-keys and
2114                    recent-keys. */
2115                 else {
2116                         run_pre_idle_hook();
2117                         redisplay();
2118                         next_event_internal(event, 1);
2119                         Vquit_flag = Qnil;      /* Read C-g as an event. */
2120                         store_this_key = 1;
2121                 }
2122         }
2123
2124         status_notify();        /* Notice process change */
2125
2126 #ifdef C_ALLOCA
2127         alloca(0);              /* Cause a garbage collection now */
2128         /* Since we can free the most stuff here
2129          *  (since this is typically called from
2130          *  the command-loop top-level). */
2131 #endif                          /* C_ALLOCA */
2132
2133         if (object_dead_p(XEVENT(event)->channel)) {
2134                 /* event_console_or_selected may crash if the channel is dead.
2135                    Best just to eat it and get the next event. */
2136                 goto start_over_and_avoid_hosage;
2137         }
2138
2139         /* OK, now we can stop the selected-console kludge and use the
2140            actual console from the event. */
2141         con = event_console_or_selected(event);
2142         command_builder = XCOMMAND_BUILDER(con->command_builder);
2143
2144         switch (XEVENT_TYPE(event)) {
2145         case button_release_event:
2146         case misc_user_event:
2147                 /* don't echo menu accelerator keys */
2148                 reset_key_echo(command_builder, 1);
2149                 goto EXECUTE_KEY;
2150         case button_press_event:
2151                 /* key or mouse input can trigger prompting */
2152                 goto STORE_AND_EXECUTE_KEY;
2153         case key_press_event:
2154                 /* any key input can trigger autosave */
2155                 break;
2156
2157                 /* just list the other events here */
2158         case empty_event:
2159         case pointer_motion_event:
2160         case process_event:
2161         case timeout_event:
2162         case magic_event:
2163         case magic_eval_event:
2164         case eval_event:
2165 #ifdef EF_USE_ASYNEQ
2166         case eaten_myself_event:
2167         case work_started_event:
2168         case work_finished_event:
2169 #endif  /* EF_USE_ASYNEQ */
2170         case dead_event:
2171         default:
2172                 goto RETURN;
2173         }
2174
2175         maybe_do_auto_save();
2176         num_input_chars++;
2177       STORE_AND_EXECUTE_KEY:
2178         if (store_this_key) {
2179                 echo_key_event(command_builder, event);
2180         }
2181
2182       EXECUTE_KEY:
2183         /* Store the last-input-event.  The semantics of this is that it is
2184            the thing most recently returned by next-command-event.  It need
2185            not have come from the keyboard or a keyboard macro, it may have
2186            come from unread-command-events.  It's always a command-event (a
2187            key, click, or menu selection), never a motion or process event.
2188          */
2189         if (!EVENTP(Vlast_input_event))
2190                 Vlast_input_event = Fmake_event(Qnil, Qnil);
2191         if (XEVENT_TYPE(Vlast_input_event) == dead_event) {
2192                 Vlast_input_event = Fmake_event(Qnil, Qnil);
2193                 error("Someone deallocated last-input-event!");
2194         }
2195         if (!EQ(event, Vlast_input_event))
2196                 Fcopy_event(event, Vlast_input_event);
2197
2198         /* last-input-char and last-input-time are derived from
2199            last-input-event.
2200            Note that last-input-char will never have its high-bit set, in an
2201            effort to sidestep the ambiguity between M-x and oslash.
2202          */
2203         Vlast_input_char = Fevent_to_character(Vlast_input_event,
2204                                                Qnil, Qnil, Qnil);
2205         {
2206                 EMACS_TIME t;
2207                 EMACS_GET_TIME(t);
2208                 if (!CONSP(Vlast_input_time))
2209                         Vlast_input_time = Fcons(Qnil, Qnil);
2210                 XCAR(Vlast_input_time) =
2211                     make_int((EMACS_SECS(t) >> 16) & 0xffff);
2212                 XCDR(Vlast_input_time) =
2213                     make_int((EMACS_SECS(t) >> 0) & 0xffff);
2214                 if (!CONSP(Vlast_command_event_time))
2215                         Vlast_command_event_time = list3(Qnil, Qnil, Qnil);
2216                 XCAR(Vlast_command_event_time) =
2217                     make_int((EMACS_SECS(t) >> 16) & 0xffff);
2218                 XCAR(XCDR(Vlast_command_event_time)) =
2219                     make_int((EMACS_SECS(t) >> 0) & 0xffff);
2220                 XCAR(XCDR(XCDR(Vlast_command_event_time)))
2221                     = make_int(EMACS_USECS(t));
2222         }
2223         /* If this key came from the keyboard or from a keyboard macro, then
2224            it goes into the recent-keys and this-command-keys vectors.
2225            If this key came from the keyboard, and we're defining a keyboard
2226            macro, then it goes into the macro.
2227          */
2228         if (store_this_key) {
2229                 if (!is_scrollbar_event(event)) /* #### not quite right, see
2230                                                    comment in execute_command_event */
2231                         push_this_command_keys(event);
2232                 if (!inhibit_input_event_recording)
2233                         push_recent_keys(event);
2234                 dribble_out_event(event);
2235                 if (!NILP(con->defining_kbd_macro) && NILP(Vexecuting_macro)) {
2236                         if (!EVENTP(command_builder->current_events))
2237                                 finalize_kbd_macro_chars(con);
2238                         store_kbd_macro_event(event);
2239                 }
2240         }
2241         /* If this is the help char and there is a help form, then execute the
2242            help form and swallow this character.  This is the only place where
2243            calling Fnext_event() can cause arbitrary lisp code to run.  Note
2244            that execute_help_form() calls Fnext_command_event(), which calls
2245            this function, as well as Fdispatch_event.
2246          */
2247         if (!NILP(Vhelp_form) &&
2248             event_matches_key_specifier_p(XEVENT(event), Vhelp_char))
2249                 execute_help_form(command_builder, event);
2250
2251       RETURN:
2252         UNGCPRO;
2253         return event;
2254 }
2255
2256 DEFUN("next-command-event", Fnext_command_event, 0, 2, 0,       /*
2257 Return the next available "user" event.
2258 Pass this object to `dispatch-event' to handle it.
2259
2260 If EVENT is non-nil, it should be an event object and will be filled in
2261 and returned; otherwise a new event object will be created and returned.
2262 If PROMPT is non-nil, it should be a string and will be displayed in the
2263 echo area while this function is waiting for an event.
2264
2265 The event returned will be a keyboard, mouse press, or mouse release event.
2266 If there are non-command events available (mouse motion, sub-process output,
2267 etc) then these will be executed (with `dispatch-event') and discarded.  This
2268 function is provided as a convenience; it is roughly equivalent to the lisp code
2269
2270   (while (progn
2271            (next-event event prompt)
2272            (not (or (key-press-event-p event)
2273                     (button-press-event-p event)
2274                     (button-release-event-p event)
2275                     (misc-user-event-p event))))
2276     (dispatch-event event))
2277
2278 but it also makes a provision for displaying keystrokes in the echo area.
2279 */
2280       (event, prompt))
2281 {
2282         /* This function can GC */
2283         struct gcpro gcpro1;
2284         GCPRO1(event);
2285         maybe_echo_keys(XCOMMAND_BUILDER(XCONSOLE(Vselected_console)->command_builder), 0);     /* #### This sucks bigtime */
2286         for (;;) {
2287                 event = Fnext_event(event, prompt);
2288                 if (command_event_p(event))
2289                         break;
2290                 else
2291                         execute_internal_event(event);
2292         }
2293         UNGCPRO;
2294         return event;
2295 }
2296
2297 DEFUN("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0,     /*
2298 Dispatch any pending "magic" events.
2299
2300 This function is useful for forcing the redisplay of native
2301 widgets. Normally these are redisplayed through a native window-system
2302 event encoded as magic event, rather than by the redisplay code.  This
2303 function does not call redisplay or do any of the other things that
2304 `next-event' does.
2305 */
2306       ())
2307 {
2308         /* This function can GC */
2309         Lisp_Object event = Qnil;
2310         struct gcpro gcpro1;
2311         GCPRO1(event);
2312         event = Fmake_event(Qnil, Qnil);
2313
2314         /* Make sure that there will be something in the native event queue
2315            so that externally managed things (e.g. widgets) get some CPU
2316            time. */
2317         event_stream_force_event_pending(selected_frame());
2318
2319         while (event_stream_event_pending_p(0)) {
2320                 QUIT;           /* next_event_internal() does not QUIT. */
2321
2322                 /* We're a generator of the command_event_queue, so we can't be a
2323                    consumer as well.  Also, we have no reason to consult the
2324                    command_event_queue; there are only user and eval-events there,
2325                    and we'd just have to put them back anyway.
2326                  */
2327                 next_event_internal(event, 0);  /* blocks */
2328                 /* See the comment in accept-process-output about Vquit_flag */
2329                 if (XEVENT_TYPE(event) == magic_event ||
2330                     XEVENT_TYPE(event) == timeout_event ||
2331                     XEVENT_TYPE(event) == process_event ||
2332                     XEVENT_TYPE(event) == pointer_motion_event)
2333                         execute_internal_event(event);
2334                 else {
2335                         enqueue_command_event_1(event);
2336                         break;
2337                 }
2338         }
2339
2340         Fdeallocate_event(event);
2341         UNGCPRO;
2342         return Qnil;
2343 }
2344
2345 static void reset_current_events(struct command_builder *command_builder)
2346 {
2347         Lisp_Object event = command_builder->current_events;
2348         reset_command_builder_event_chain(command_builder);
2349         if (EVENTP(event))
2350                 deallocate_event_chain(event);
2351 }
2352
2353 DEFUN("discard-input", Fdiscard_input, 0, 0, 0, /*
2354 Discard any pending "user" events.
2355 Also cancel any kbd macro being defined.
2356 A user event is a key press, button press, button release, or
2357 "misc-user" event (menu selection or scrollbar action).
2358 */
2359       ())
2360 {
2361         /* This throws away user-input on the queue, but doesn't process any
2362            events.  Calling dispatch_event() here leads to a race condition.
2363          */
2364         Lisp_Object event = Fmake_event(Qnil, Qnil);
2365 #ifndef EF_USE_ASYNEQ
2366         Lisp_Object head = Qnil, tail = Qnil;
2367 #endif
2368         Lisp_Object oiq = Vinhibit_quit;
2369         struct gcpro gcpro1, gcpro2;
2370         /* #### not correct here with Vselected_console?  Should
2371            discard-input take a console argument, or maybe map over
2372            all consoles? */
2373         struct console *con = XCONSOLE(Vselected_console);
2374
2375         /* next_event_internal() can cause arbitrary Lisp code to be evalled */
2376         GCPRO2(event, oiq);
2377         Vinhibit_quit = Qt;
2378         /* If a macro was being defined then we have to mark the modeline
2379            has changed to ensure that it gets updated correctly. */
2380         if (!NILP(con->defining_kbd_macro))
2381                 MARK_MODELINE_CHANGED;
2382         con->defining_kbd_macro = Qnil;
2383         reset_current_events(XCOMMAND_BUILDER(con->command_builder));
2384
2385 #ifdef EF_USE_ASYNEQ
2386         /* very raw :| */
2387         WITH_DLLIST_TRAVERSE(
2388                 eq_queue(asyneq),
2389                 sxe_event_t *ev = dllist_item;
2390                 if (command_event_p((Lisp_Object)ev)) {
2391                         dllist_pop_inner(eq_queue(asyneq), _el);
2392                 });
2393 #else
2394         while (!EQ_EMPTY_P() || event_stream_event_pending_p(1)) {
2395                 /* This will take stuff off the command_event_queue, or read it
2396                    from the event_stream, but it will not block.
2397                  */
2398                 next_event_internal(event, 1);
2399                 Vquit_flag = Qnil;      /* Treat C-g as a user event (ignore it).
2400                                            It is vitally important that we reset
2401                                            Vquit_flag here.  Otherwise, if we're
2402                                            reading from a TTY console,
2403                                            maybe_read_quit_event() will notice
2404                                            that C-g has been set and send us
2405                                            another C-g.  That will cause us
2406                                            to get right back here, and read
2407                                            another C-g, ad infinitum ... */
2408
2409                 /* If the event is a user event, ignore it. */
2410                 if (!command_event_p(event)) {
2411                         /* Otherwise, chain the event onto our list of events
2412                            not to ignore, and keep reading until the queue is
2413                            empty.  This does not mean that if a subprocess is
2414                            generating an infinite amount of output, we will
2415                            never terminate (*provided* that the behavior of
2416                            next_event_cb() is correct -- see the comment in
2417                            events.h), because this loop ends as soon as there
2418                            are no more user events on the command_event_queue or
2419                            event_stream.
2420                          */
2421                         enqueue_event(Fcopy_event(event, Qnil), &head, &tail);
2422                 }
2423         }
2424
2425         if (!EQ_EMPTY_P() || EQ_LARGE_P())
2426                 abort();
2427
2428         /* Now tack our chain of events back on to the front of the queue.
2429            Actually, since the queue is now drained, we can just replace it.
2430            The effect of this will be that we have deleted all user events
2431            from the input stream without changing the relative ordering of
2432            any other events.  (Some events may have been taken from the
2433            event_stream and added to the command_event_queue, however.)
2434
2435            At this time, the command_event_queue will contain only eval_events.
2436          */
2437         command_event_queue = head;
2438         command_event_queue_tail = tail;
2439 #endif
2440
2441         Fdeallocate_event(event);
2442         UNGCPRO;
2443
2444         Vinhibit_quit = oiq;
2445         return Qnil;
2446 }
2447 \f
2448 /**********************************************************************/
2449 /*                     pausing until an action occurs                 */
2450 /**********************************************************************/
2451
2452 /* This is used in accept-process-output, sleep-for and sit-for.
2453    Before running any process_events in these routines, we set
2454    recursive_sit_for to Qt, and use this unwind protect to reset it to
2455    Qnil upon exit.  When recursive_sit_for is Qt, calling sit-for will
2456    cause it to return immediately.
2457
2458    All of these routines install timeouts, so we clear the installed
2459    timeout as well.
2460
2461    Note: It's very easy to break the desired behaviors of these
2462    3 routines.  If you make any changes to anything in this area, run
2463    the regression tests at the bottom of the file.  -- dmoore */
2464
2465 static Lisp_Object sit_for_unwind(Lisp_Object timeout_id)
2466 {
2467         if (!NILP(timeout_id))
2468                 Fdisable_timeout(timeout_id);
2469
2470         recursive_sit_for = Qnil;
2471         return Qnil;
2472 }
2473
2474 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
2475  */
2476
2477 DEFUN("accept-process-output", Faccept_process_output, 0, 3, 0, /*
2478 Allow any pending output from subprocesses to be read by Emacs.
2479 It is read into the process' buffers or given to their filter functions.
2480 Non-nil arg PROCESS means do not return until some output has been received
2481 from PROCESS. Nil arg PROCESS means do not return until some output has
2482 been received from any process.
2483
2484 If the second arg is non-nil, it is the maximum number of seconds to wait:
2485 this function will return after that much time even if no input has arrived
2486 from PROCESS.  This argument may be a float, meaning wait some fractional
2487 part of a second.
2488
2489 If the third arg is non-nil, it is a number of milliseconds that is added
2490 to the second arg.  (This exists only for compatibility.)
2491 Return non-nil iff we received any output before the timeout expired.
2492 */
2493       (process, timeout_secs, timeout_msecs))
2494 {
2495         /* This function can GC */
2496         struct gcpro gcpro1, gcpro2;
2497         Lisp_Object event = Qnil;
2498         Lisp_Object result = Qnil;
2499         int timeout_id = -1;
2500         int timeout_enabled = 0;
2501         int done = 0;
2502         struct buffer *old_buffer = current_buffer;
2503         int count;
2504
2505         /* We preserve the current buffer but nothing else.  If a focus
2506            change alters the selected window then the top level event loop
2507            will eventually alter current_buffer to match.  In the mean time
2508            we don't want to mess up whatever called this function. */
2509
2510         if (!NILP(process))
2511                 CHECK_PROCESS(process);
2512
2513         GCPRO2(event, process);
2514
2515         if (!NILP(timeout_secs) || !NILP(timeout_msecs)) {
2516                 unsigned long msecs = 0;
2517                 if (!NILP(timeout_secs))
2518                         msecs = lisp_number_to_milliseconds(timeout_secs, 1);
2519                 if (!NILP(timeout_msecs)) {
2520                         CHECK_NATNUM(timeout_msecs);
2521                         msecs += XINT(timeout_msecs);
2522                 }
2523                 if (msecs) {
2524                         timeout_id =
2525                             event_stream_generate_wakeup(msecs, 0, Qnil, Qnil,
2526                                                          0);
2527                         timeout_enabled = 1;
2528                 }
2529         }
2530
2531         event = Fmake_event(Qnil, Qnil);
2532
2533         count = specpdl_depth();
2534         record_unwind_protect(sit_for_unwind,
2535                               timeout_enabled ? make_int(timeout_id) : Qnil);
2536         recursive_sit_for = Qt;
2537
2538         while (!done &&
2539                ((NILP(process) && timeout_enabled) ||
2540                 (NILP(process) && event_stream_event_pending_p(0)) ||
2541                 (!NILP(process))))
2542                 /* Calling detect_input_pending() is the wrong thing here, because
2543                    that considers the Vunread_command_events and command_event_queue.
2544                    We don't need to look at the command_event_queue because we are
2545                    only interested in process events, which don't go on that.  In
2546                    fact, we can't read from it anyway, because we put stuff on it.
2547
2548                    Note that event_stream->event_pending_p must be called in such
2549                    a way that it says whether any events *of any kind* are ready,
2550                    not just user events, or (accept-process-output nil) will fail
2551                    to dispatch any process events that may be on the queue.  It is
2552                    not clear to me that this is important, because the top-level
2553                    loop will process it, and I don't think that there is ever a
2554                    time when one calls accept-process-output with a nil argument
2555                    and really need the processes to be handled. */
2556         {
2557                 /* If our timeout has arrived, we move along. */
2558                 if (timeout_enabled
2559                     && !event_stream_wakeup_pending_p(timeout_id, 0)) {
2560                         timeout_enabled = 0;
2561                         done = 1;       /* We're  done. */
2562                         continue;       /* Don't call next_event_internal */
2563                 }
2564
2565                 QUIT;           /* next_event_internal() does not QUIT, so check
2566                                    for ^G before reading output from the process
2567                                    - this makes it less likely that the filter
2568                                    will actually be aborted.
2569                                  */
2570
2571                 next_event_internal(event, 0);
2572                 /* If C-g was pressed while we were waiting, Vquit_flag got
2573                    set and next_event_internal() also returns C-g.  When
2574                    we enqueue the C-g below, it will get discarded.  The
2575                    next time through, QUIT will be called and will signal a quit. */
2576                 switch (XEVENT_TYPE(event)) {
2577                 case process_event:
2578                         if (NILP(process) ||
2579                             EQ(XEVENT(event)->event.process.process,
2580                                process)) {
2581                                 done = 1;
2582                                 /* RMS's version always returns nil when
2583                                    proc is nil, and only returns t if
2584                                    input ever arrived on proc. */
2585                                 result = Qt;
2586                         }
2587
2588                         execute_internal_event(event);
2589                         break;
2590
2591                 case timeout_event:
2592                         /* We execute the event even if it's ours, and notice
2593                            that it's happened above. */
2594                 case pointer_motion_event:
2595                 case magic_event:
2596                         execute_internal_event(event);
2597                         break;
2598
2599                 /* just list the other events here */
2600                 case empty_event:
2601                 case key_press_event:
2602                 case button_press_event:
2603                 case button_release_event:
2604                 case misc_user_event:
2605                 case magic_eval_event:
2606                 case eval_event:
2607 #ifdef EF_USE_ASYNEQ
2608                 case eaten_myself_event:
2609                 case work_started_event:
2610                 case work_finished_event:
2611 #endif  /* EF_USE_ASYNEQ */
2612                 case dead_event:
2613                 default:
2614                         enqueue_command_event_1(event);
2615                         break;
2616                 }
2617         }
2618
2619         unbind_to(count, timeout_enabled ? make_int(timeout_id) : Qnil);
2620
2621         Fdeallocate_event(event);
2622         UNGCPRO;
2623         current_buffer = old_buffer;
2624         return result;
2625 }
2626
2627 DEFUN("sleep-for", Fsleep_for, 1, 1, 0, /*
2628 Pause, without updating display, for SECONDS seconds.
2629 SECONDS may be a float, allowing pauses for fractional parts of a second.
2630
2631 It is recommended that you never call sleep-for from inside of a process
2632 filter function or timer event (either synchronous or asynchronous).
2633 */
2634       (seconds))
2635 {
2636         /* This function can GC */
2637         unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2638         int id;
2639         Lisp_Object event = Qnil;
2640         int count;
2641         struct gcpro gcpro1;
2642
2643         GCPRO1(event);
2644
2645         id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2646         event = Fmake_event(Qnil, Qnil);
2647
2648         count = specpdl_depth();
2649         record_unwind_protect(sit_for_unwind, make_int(id));
2650         recursive_sit_for = Qt;
2651
2652         while (1) {
2653                 /* If our timeout has arrived, we move along. */
2654                 if (!event_stream_wakeup_pending_p(id, 0))
2655                         goto DONE_LABEL;
2656
2657                 /* next_event_internal() does not QUIT, so check for ^G before
2658                    reading output from the process - this makes it less likely
2659                    that the filter will actually be aborted.
2660                 */
2661                 QUIT;
2662
2663                 /* We're a generator of the command_event_queue, so we can't be
2664                    a consumer as well.  We don't care about command and
2665                    eval-events anyway.
2666                  */
2667                 next_event_internal(event, 0);  /* blocks */
2668                 /* See the comment in accept-process-output about Vquit_flag */
2669                 switch (XEVENT_TYPE(event)) {
2670                 case timeout_event:
2671                         /* We execute the event even if it's ours, and notice
2672                            that it's happened above. */
2673                 case process_event:
2674                 case pointer_motion_event:
2675                 case magic_event:
2676                         execute_internal_event(event);
2677                         break;
2678
2679                         /* just list the other events here */
2680                 case empty_event:
2681                 case key_press_event:
2682                 case button_press_event:
2683                 case button_release_event:
2684                 case magic_eval_event:
2685                 case eval_event:
2686                 case misc_user_event:
2687 #ifdef EF_USE_ASYNEQ
2688                 case eaten_myself_event:
2689                 case work_started_event:
2690                 case work_finished_event:
2691 #endif  /* EF_USE_ASYNEQ */
2692                 case dead_event:
2693                 default:
2694                         enqueue_command_event_1(event);
2695                         break;
2696                 }
2697         }
2698       DONE_LABEL:
2699         unbind_to(count, make_int(id));
2700         Fdeallocate_event(event);
2701         UNGCPRO;
2702         return Qnil;
2703 }
2704
2705 DEFUN("sit-for", Fsit_for, 1, 2, 0,     /*
2706 Perform redisplay, then wait SECONDS seconds or until user input is available.
2707 SECONDS may be a float, meaning a fractional part of a second.
2708 Optional second arg NODISPLAY non-nil means don't redisplay; just wait.
2709 Redisplay is preempted as always if user input arrives, and does not
2710 happen if input is available before it starts.
2711 Value is t if waited the full time with no input arriving.
2712
2713 If sit-for is called from within a process filter function or timer
2714 event (either synchronous or asynchronous) it will return immediately.
2715 */
2716       (seconds, nodisplay))
2717 {
2718         /* This function can GC */
2719         unsigned long msecs = lisp_number_to_milliseconds(seconds, 1);
2720         Lisp_Object event, result;
2721         struct gcpro gcpro1;
2722         int id;
2723         int count;
2724
2725         /* The unread-command-events count as pending input */
2726         if (!NILP(Vunread_command_events) || !NILP(Vunread_command_event))
2727                 return Qnil;
2728
2729         /* If the command-builder already has user-input on it (not eval events)
2730            then that means we're done too.
2731          */
2732         if (!EQ_EMPTY_P()) {
2733 #if defined(EF_USE_ASYNEQ)
2734                 EQ_TRAVERSE(
2735                         asyneq, event,
2736                         if (command_event_p(event)) {
2737                                 RETURN_FROM_EQ_TRAVERSE(asyneq, Qnil);
2738                         });
2739 #else
2740                 EVENT_CHAIN_LOOP(event, command_event_queue) {
2741                         if (command_event_p(event))
2742                                 return Qnil;
2743                 }
2744 #endif
2745         }
2746
2747         /* If we're in a macro, or noninteractive, or early in temacs, then
2748            don't wait. */
2749         if (noninteractive || !NILP(Vexecuting_macro))
2750                 return Qnil;
2751
2752         /* Recursive call from a filter function or timeout handler. */
2753         if (!NILP(recursive_sit_for)) {
2754                 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2755                         run_pre_idle_hook();
2756                         redisplay();
2757                 }
2758                 return Qnil;
2759         }
2760
2761         /* Otherwise, start reading events from the event_stream.
2762            Do this loop at least once even if (sit-for 0) so that we
2763            redisplay when no input pending.
2764          */
2765         GCPRO1(event);
2766         event = Fmake_event(Qnil, Qnil);
2767
2768         /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
2769            events get processed.  The old (pre-19.12) code special-cased this
2770            and didn't generate a wakeup, but the resulting behavior was less than
2771            ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
2772            the E-Lisp universe. */
2773
2774         id = event_stream_generate_wakeup(msecs, 0, Qnil, Qnil, 0);
2775
2776         count = specpdl_depth();
2777         record_unwind_protect(sit_for_unwind, make_int(id));
2778         recursive_sit_for = Qt;
2779
2780         while (1) {
2781                 /* If there is no user input pending, then redisplay.
2782                  */
2783                 if (!event_stream_event_pending_p(1) && NILP(nodisplay)) {
2784                         run_pre_idle_hook();
2785                         redisplay();
2786                 }
2787
2788                 /* If our timeout has arrived, we move along. */
2789                 if (!event_stream_wakeup_pending_p(id, 0)) {
2790                         result = Qt;
2791                         goto DONE_LABEL;
2792                 }
2793
2794                 /* next_event_internal() does not QUIT, so check for ^G
2795                    before reading output from the process - this makes it
2796                    less likely that the filter will actually be aborted.
2797                 */
2798                 QUIT;
2799
2800                 /* We're a generator of the command_event_queue, so we can't be
2801                    a consumer as well.  In fact, we know there's nothing on the
2802                    command_event_queue that we didn't just put there.
2803                  */
2804                 next_event_internal(event, 0);  /* blocks */
2805                 /* See the comment in accept-process-output about Vquit_flag */
2806
2807                 if (command_event_p(event)) {
2808                         QUIT;   /* If the command was C-g check it here
2809                                    so that we abort out of the sit-for,
2810                                    not the next command.  sleep-for and
2811                                    accept-process-output continue looping
2812                                    so they check QUIT again implicitly. */
2813                         result = Qnil;
2814                         goto DONE_LABEL;
2815                 }
2816
2817                 switch (XEVENT_TYPE(event)) {
2818                 case eval_event:
2819                         /* eval-events get delayed until later. */
2820                         enqueue_command_event(Fcopy_event(event, Qnil));
2821                         break;
2822
2823                 case timeout_event:
2824                         /* We execute the event even if it's ours, and notice
2825                            that it's happened above. */
2826
2827                         /* just list the rest here too */
2828                 case empty_event:
2829                 case key_press_event:
2830                 case button_press_event:
2831                 case button_release_event:
2832                 case pointer_motion_event:
2833                 case process_event:
2834                 case magic_event:
2835                 case magic_eval_event:
2836                 case misc_user_event:
2837 #ifdef EF_USE_ASYNEQ
2838                 case eaten_myself_event:
2839                 case work_started_event:
2840                 case work_finished_event:
2841 #endif  /* EF_USE_ASYNEQ */
2842                 case dead_event:
2843                 default:
2844                         execute_internal_event(event);
2845                         break;
2846                 }
2847         }
2848
2849       DONE_LABEL:
2850         unbind_to(count, make_int(id));
2851
2852         /* Put back the event (if any) that made Fsit_for() exit before the
2853            timeout.  Note that it is being added to the back of the queue, which
2854            would be inappropriate if there were any user events on the queue
2855            already: we would be misordering them.  But we know that there are
2856            no user-events on the queue, or else we would not have reached this
2857            point at all.
2858          */
2859         if (NILP(result))
2860                 enqueue_command_event(event);
2861         else
2862                 Fdeallocate_event(event);
2863
2864         UNGCPRO;
2865         return result;
2866 }
2867
2868 /* This handy little function is used by select-x.c to wait for replies
2869    from processes that aren't really processes (e.g. the X server) */
2870 void wait_delaying_user_input(int (*predicate) (void *arg), void *predicate_arg)
2871 {
2872         /* This function can GC */
2873         Lisp_Object event = Fmake_event(Qnil, Qnil);
2874         struct gcpro gcpro1;
2875         GCPRO1(event);
2876
2877         while (!(*predicate) (predicate_arg)) {
2878                 QUIT;           /* next_event_internal() does not QUIT. */
2879
2880                 /* We're a generator of the command_event_queue, so we can't be a
2881                    consumer as well.  Also, we have no reason to consult the
2882                    command_event_queue; there are only user and eval-events there,
2883                    and we'd just have to put them back anyway.
2884                  */
2885                 next_event_internal(event, 0);
2886                 /* See the comment in accept-process-output about Vquit_flag */
2887                 if (command_event_p(event)
2888                     || (XEVENT_TYPE(event) == eval_event)
2889                     || (XEVENT_TYPE(event) == magic_eval_event))
2890                         enqueue_command_event_1(event);
2891                 else
2892                         execute_internal_event(event);
2893         }
2894         UNGCPRO;
2895 }
2896 \f
2897 /**********************************************************************/
2898 /*                dispatching events; command builder                 */
2899 /**********************************************************************/
2900
2901 static void
2902 execute_internal_event(Lisp_Object event)
2903 {
2904         /* events on dead channels get silently eaten */
2905         if (object_dead_p(XEVENT(event)->channel)) {
2906                 return;
2907         }
2908
2909         /* This function can GC */
2910         switch (XEVENT_TYPE(event)) {
2911         case empty_event:
2912                 return;
2913
2914         case eval_event:
2915                 call1(XEVENT(event)->event.eval.function,
2916                       XEVENT(event)->event.eval.object);
2917                 return;
2918
2919         case magic_eval_event:
2920                 (XEVENT(event)->event.magic_eval.internal_function)
2921                         (XEVENT(event)->event.magic_eval.object);
2922                 return;
2923
2924         case pointer_motion_event:
2925                 if (!NILP(Vmouse_motion_handler))
2926                         call1(Vmouse_motion_handler, event);
2927                 return;
2928
2929         case process_event: {
2930                 Lisp_Object p = XEVENT(event)->event.process.process;
2931                 Charcount readstatus;
2932
2933                 assert(PROCESSP(p));
2934                 while ((readstatus = read_process_output(p)) > 0) ;
2935                 if (readstatus > 0) ;   /* this clauses never gets
2936                                            executed but allows the
2937                                            #ifdefs to work cleanly. */
2938 #ifdef EWOULDBLOCK
2939                 else if (readstatus == -1 && errno == EWOULDBLOCK) ;
2940 #endif                          /* EWOULDBLOCK */
2941 #ifdef EAGAIN
2942                 else if (readstatus == -1 && errno == EAGAIN) ;
2943 #endif                          /* EAGAIN */
2944                 else if ((readstatus == 0 &&
2945                           /* Note that we cannot distinguish between no
2946                              input available now and a closed pipe.
2947                              With luck, a closed pipe will be
2948                              accompanied by subprocess termination and
2949                              SIGCHLD.  */
2950                           (!network_connection_p(p) ||
2951                            /*
2952                              When connected to ToolTalk (i.e.
2953                              connected_via_filedesc_p()), it's not
2954                              possible to reliably determine whether
2955                              there is a message waiting for ToolTalk to
2956                              receive.  ToolTalk expects to have
2957                              tt_message_receive() called exactly once
2958                              every time the file descriptor becomes
2959                              active, so the filter function forces this
2960                              by returning 0.  Emacs must not interpret
2961                              this as a closed pipe. 
2962
2963                              We don't do ToolTalk anymore, but come
2964                              back and revisit this for D-Bus */
2965                            connected_via_filedesc_p(XPROCESS(p))))
2966 #ifdef HAVE_PTYS
2967                          /* On some OSs with ptys, when the process on
2968                             one end of a pty exits, the other end gets
2969                             an error reading with errno = EIO instead of
2970                             getting an EOF (0 bytes read).  Therefore,
2971                             if we get an error reading and errno = EIO,
2972                             just continue, because the child process has
2973                             exited and should clean itself up soon
2974                             (e.g. when we get a SIGCHLD). */
2975                          || (readstatus == -1 && errno == EIO)
2976 #endif
2977                         ) {
2978                         /* Currently, we rely on SIGCHLD to indicate
2979                            that the process has terminated.
2980                            Unfortunately, on some systems the SIGCHLD
2981                            gets missed some of the time.  So we put an
2982                            additional check in status_notify() to see
2983                            whether a process has terminated.  We must
2984                            tell status_notify() to enable that check,
2985                            and we do so now. */
2986                         kick_status_notify();
2987                 } else {
2988                         /* Deactivate network connection */
2989                         Lisp_Object status = Fprocess_status(p);
2990                         if (EQ(status, Qopen)
2991                             /* In case somebody changes the theory of
2992                                whether to return open as opposed to run
2993                                for network connection "processes"... */
2994                             || EQ(status, Qrun))
2995                                 update_process_status(p, Qexit, 256, 0);
2996                         deactivate_process(p);
2997                 }
2998
2999                 /* We must call status_notify here to allow the
3000                    event_stream->unselect_process_cb to be run if appropriate.
3001                    Otherwise, dead fds may be selected for, and we will get a
3002                    continuous stream of process events for them.  Since we don't
3003                    return until all process events have been flushed, we would
3004                    get stuck here, processing events on a process whose status
3005                    was 'exit.  Call this after dispatch-event, or the fds will
3006                    have been closed before we read the last data from them.
3007                    It's safe for the filter to signal an error because
3008                    status_notify() will be called on return to top-level.
3009                 */
3010                 status_notify();
3011                 return;
3012         }
3013
3014         case timeout_event: {
3015                 Lisp_Event *e = XEVENT(event);
3016                 if (!NILP(e->event.timeout.function))
3017                         call1(e->event.timeout.function,
3018                               e->event.timeout.object);
3019                 return;
3020         }
3021
3022         case magic_event:
3023                 event_stream_handle_magic_event(XEVENT(event));
3024                 return;
3025
3026 #ifdef EF_USE_ASYNEQ
3027         case work_started_event:
3028         case work_finished_event:
3029         case eaten_myself_event:
3030                 return;
3031 #endif  /* EF_USE_ASYNEQ */
3032
3033                 /* not sure about the next ones, but they've
3034                  * always been unhandled and so be they ... */
3035         case key_press_event:
3036         case button_press_event:
3037         case button_release_event:
3038         case misc_user_event:
3039                 /* and now the ones i'm quite sure about */
3040         case dead_event:
3041         default:
3042                 abort();
3043         }
3044 }
3045
3046 \f
3047 static void
3048 this_command_keys_replace_suffix(Lisp_Object suffix, Lisp_Object chain)
3049 {
3050         Lisp_Object first_before_suffix =
3051             event_chain_find_previous(Vthis_command_keys, suffix);
3052
3053         if (NILP(first_before_suffix))
3054                 Vthis_command_keys = chain;
3055         else
3056                 XSET_EVENT_NEXT(first_before_suffix, chain);
3057         deallocate_event_chain(suffix);
3058         Vthis_command_keys_tail = event_chain_tail(chain);
3059 }
3060
3061 static void
3062 command_builder_replace_suffix(struct command_builder *builder,
3063                                Lisp_Object suffix, Lisp_Object chain)
3064 {
3065         Lisp_Object first_before_suffix =
3066             event_chain_find_previous(builder->current_events, suffix);
3067
3068         if (NILP(first_before_suffix))
3069                 builder->current_events = chain;
3070         else
3071                 XSET_EVENT_NEXT(first_before_suffix, chain);
3072         deallocate_event_chain(suffix);
3073         builder->most_current_event = event_chain_tail(chain);
3074 }
3075
3076 static Lisp_Object command_builder_find_leaf_1(struct command_builder *builder)
3077 {
3078         Lisp_Object event0 = builder->current_events;
3079
3080         if (NILP(event0))
3081                 return Qnil;
3082
3083         return event_binding(event0, 1);
3084 }
3085
3086 /* See if we can do function-key-map or key-translation-map translation
3087    on the current events in the command builder.  If so, do this, and
3088    return the resulting binding, if any. */
3089
3090 static Lisp_Object
3091 munge_keymap_translate(struct command_builder *builder,
3092                        enum munge_me_out_the_door munge,
3093                        int has_normal_binding_p)
3094 {
3095         Lisp_Object suffix;
3096
3097         EVENT_CHAIN_LOOP(suffix, builder->munge_me[munge].first_mungeable_event) {
3098                 Lisp_Object result =
3099                     munging_key_map_event_binding(suffix, munge);
3100
3101                 if (NILP(result))
3102                         continue;
3103
3104                 if (KEYMAPP(result)) {
3105                         if (NILP(builder->last_non_munged_event)
3106                             && !has_normal_binding_p)
3107                                 builder->last_non_munged_event =
3108                                     builder->most_current_event;
3109                 } else
3110                         builder->last_non_munged_event = Qnil;
3111
3112                 if (!KEYMAPP(result) && !VECTORP(result) && !STRINGP(result)) {
3113                         struct gcpro gcpro1;
3114                         GCPRO1(suffix);
3115                         result = call1(result, Qnil);
3116                         UNGCPRO;
3117                         if (NILP(result))
3118                                 return Qnil;
3119                 }
3120
3121                 if (KEYMAPP(result))
3122                         return result;
3123
3124                 if (VECTORP(result) || STRINGP(result)) {
3125                         Lisp_Object new_chain =
3126                             key_sequence_to_event_chain(result);
3127                         Lisp_Object tempev;
3128                         int n, tckn;
3129
3130                         /* If the first_mungeable_event of the other munger is
3131                            within the events we're munging, then it will point to
3132                            deallocated events afterwards, which is bad -- so make it
3133                            point at the beginning of the munged events. */
3134                         EVENT_CHAIN_LOOP(tempev, suffix) {
3135                                 Lisp_Object *mungeable_event =
3136                                     &builder->munge_me[1 -
3137                                                        munge].
3138                                     first_mungeable_event;
3139                                 if (EQ(tempev, *mungeable_event)) {
3140                                         *mungeable_event = new_chain;
3141                                         break;
3142                                 }
3143                         }
3144
3145                         n = event_chain_count(suffix);
3146                         command_builder_replace_suffix(builder, suffix,
3147                                                        new_chain);
3148                         builder->munge_me[munge].first_mungeable_event = Qnil;
3149                         /* Now hork this-command-keys as well. */
3150
3151                         /* We just assume that the events we just replaced are
3152                            sitting in copied form at the end of this-command-keys.
3153                            If the user did weird things with `dispatch-event' this
3154                            may not be the case, but at least we make sure we won't
3155                            crash. */
3156                         new_chain = copy_event_chain(new_chain);
3157                         tckn = event_chain_count(Vthis_command_keys);
3158                         if (tckn >= n) {
3159                                 this_command_keys_replace_suffix
3160                                     (event_chain_nth
3161                                      (Vthis_command_keys, tckn - n), new_chain);
3162                         }
3163
3164                         result = command_builder_find_leaf_1(builder);
3165                         return result;
3166                 }
3167
3168                 signal_simple_error((munge == MUNGE_ME_FUNCTION_KEY ?
3169                                      "Invalid binding in function-key-map" :
3170                                      "Invalid binding in key-translation-map"),
3171                                     result);
3172         }
3173
3174         return Qnil;
3175 }
3176
3177 /* Compare the current state of the command builder against the local and
3178    global keymaps, and return the binding.  If there is no match, try again,
3179    case-insensitively.  The return value will be one of:
3180       -- nil (there is no binding)
3181       -- a keymap (part of a command has been specified)
3182       -- a command (anything that satisfies `commandp'; this includes
3183                     some symbols, lists, subrs, strings, vectors, and
3184                     compiled-function objects)
3185  */
3186 static Lisp_Object
3187 command_builder_find_leaf(struct command_builder *builder,
3188                           int allow_misc_user_events_p)
3189 {
3190         /* This function can GC */
3191         Lisp_Object result;
3192         Lisp_Object evee = builder->current_events;
3193
3194         if (XEVENT_TYPE(evee) == misc_user_event) {
3195                 if (allow_misc_user_events_p && (NILP(XEVENT_NEXT(evee))))
3196                         return list2(XEVENT(evee)->event.eval.function,
3197                                      XEVENT(evee)->event.eval.object);
3198                 else
3199                         return Qnil;
3200         }
3201
3202         /* if we're currently in a menu accelerator, check there for further
3203            events */
3204         /* #### fuck me!  who wrote this crap?  think "abstraction", baby. */
3205 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3206         if (x_kludge_lw_menu_active()) {
3207                 return command_builder_operate_menu_accelerator(builder);
3208         } else {
3209                 result = Qnil;
3210                 if (EQ(Vmenu_accelerator_enabled, Qmenu_force))
3211                         result = command_builder_find_menu_accelerator(builder);
3212                 if (NILP(result))
3213 #endif
3214                         result = command_builder_find_leaf_1(builder);
3215 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
3216                 if (NILP(result)
3217                     && EQ(Vmenu_accelerator_enabled, Qmenu_fallback))
3218                         result = command_builder_find_menu_accelerator(builder);
3219         }
3220 #endif
3221
3222         /* Check to see if we have a potential function-key-map match. */
3223         if (NILP(result)) {
3224                 result =
3225                     munge_keymap_translate(builder, MUNGE_ME_FUNCTION_KEY, 0);
3226                 regenerate_echo_keys_from_this_command_keys(builder);
3227         }
3228         /* Check to see if we have a potential key-translation-map match. */
3229         {
3230                 Lisp_Object key_translate_result =
3231                     munge_keymap_translate(builder, MUNGE_ME_KEY_TRANSLATION,
3232                                            !NILP(result));
3233                 if (!NILP(key_translate_result)) {
3234                         result = key_translate_result;
3235                         regenerate_echo_keys_from_this_command_keys(builder);
3236                 }
3237         }
3238
3239         if (!NILP(result))
3240                 return result;
3241
3242         /* If key-sequence wasn't bound, we'll try some fallbacks.  */
3243
3244         /* If we didn't find a binding, and the last event in the sequence is
3245            a shifted character, then try again with the lowercase version.  */
3246
3247         if (XEVENT_TYPE(builder->most_current_event) == key_press_event
3248             && !NILP(Vretry_undefined_key_binding_unshifted)) {
3249                 Lisp_Object terminal = builder->most_current_event;
3250                 struct key_data *key = &XEVENT(terminal)->event.key;
3251                 Emchar c = 0;
3252                 if ((key->modifiers & XEMACS_MOD_SHIFT)
3253                     || (CHAR_OR_CHAR_INTP(key->keysym)
3254                         && ((c = XCHAR_OR_CHAR_INT(key->keysym)), c >= 'A'
3255                             && c <= 'Z'))) {
3256                         Lisp_Event terminal_copy = *XEVENT(terminal);
3257
3258                         if (key->modifiers & XEMACS_MOD_SHIFT)
3259                                 key->modifiers &= (~XEMACS_MOD_SHIFT);
3260                         else
3261                                 key->keysym = make_char(c + 'a' - 'A');
3262
3263                         result =
3264                             command_builder_find_leaf(builder,
3265                                                       allow_misc_user_events_p);
3266                         if (!NILP(result))
3267                                 return result;
3268                         /* If there was no match with the lower-case version either,
3269                            then put back the upper-case event for the error
3270                            message.  But make sure that function-key-map didn't
3271                            change things out from under us. */
3272                         if (EQ(terminal, builder->most_current_event))
3273                                 *XEVENT(terminal) = terminal_copy;
3274                 }
3275         }
3276
3277         /* help-char is `auto-bound' in every keymap */
3278         if (!NILP(Vprefix_help_command) &&
3279             event_matches_key_specifier_p(XEVENT(builder->most_current_event),
3280                                           Vhelp_char))
3281                 return Vprefix_help_command;
3282
3283 #ifdef HAVE_XIM
3284         /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
3285         if (XEVENT_TYPE(builder->most_current_event) == key_press_event
3286             && !NILP(Vcomposed_character_default_binding)) {
3287                 Lisp_Object keysym =
3288                     XEVENT(builder->most_current_event)->event.key.keysym;
3289                 if (CHARP(keysym) && !CHAR_ASCII_P(XCHAR(keysym)))
3290                         return Vcomposed_character_default_binding;
3291         }
3292 #endif                          /* HAVE_XIM */
3293
3294         /* If we read extra events attempting to match a function key but end
3295            up failing, then we release those events back to the command loop
3296            and fail on the original lookup.  The released events will then be
3297            reprocessed in the context of the first part having failed. */
3298         if (!NILP(builder->last_non_munged_event)) {
3299                 Lisp_Object event0 = builder->last_non_munged_event;
3300
3301                 /* Put the commands back on the event queue. */
3302 #ifdef EF_USE_ASYNEQ
3303                 eq_enqueue_event_chain(asyneq, XEVENT_NEXT(event0));
3304 #else
3305                 enqueue_event_chain(XEVENT_NEXT(event0),
3306                                     &command_event_queue,
3307                                     &command_event_queue_tail);
3308 #endif
3309                 /* Then remove them from the command builder. */
3310                 XSET_EVENT_NEXT(event0, Qnil);
3311                 builder->most_current_event = event0;
3312                 builder->last_non_munged_event = Qnil;
3313         }
3314
3315         return Qnil;
3316 }
3317
3318 /* Every time a command-event (a key, button, or menu selection) is read by
3319    Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event,
3320    and in Vthis_command_keys.  (Eval-events are not stored there.)
3321
3322    Every time a command is invoked, Vlast_command_event is set to the last
3323    event in the sequence.
3324
3325    This means that Vthis_command_keys is really about "input read since the
3326    last command was executed" rather than about "what keys invoked this
3327    command."  This is a little counterintuitive, but that's the way it
3328    has always worked.
3329
3330    As an extra kink, the function read-key-sequence resets/updates the
3331    last-command-event and this-command-keys.  It doesn't append to the
3332    command-keys as read-char does.  Such are the pitfalls of having to
3333    maintain compatibility with a program for which the only specification
3334    is the code itself.
3335
3336    (We could implement recent_keys_ring and Vthis_command_keys as the same
3337    data structure.)
3338  */
3339
3340 DEFUN("recent-keys", Frecent_keys, 0, 1, 0,     /*
3341 Return a vector of recent keyboard or mouse button events read.
3342 If NUMBER is non-nil, not more than NUMBER events will be returned.
3343 Change number of events stored using `set-recent-keys-ring-size'.
3344
3345 This copies the event objects into a new vector; it is safe to keep and
3346 modify them.
3347 */
3348       (number))
3349 {
3350         struct gcpro gcpro1;
3351         Lisp_Object val = Qnil;
3352         int nwanted;
3353         int start, nkeys, i, j;
3354         GCPRO1(val);
3355
3356         if (NILP(number))
3357                 nwanted = recent_keys_ring_size;
3358         else {
3359                 CHECK_NATNUM(number);
3360                 nwanted = XINT(number);
3361         }
3362
3363         /* Create the keys ring vector, if none present. */
3364         if (NILP(Vrecent_keys_ring)) {
3365                 Vrecent_keys_ring = make_vector(recent_keys_ring_size, Qnil);
3366                 /* And return nothing in particular. */
3367                 RETURN_UNGCPRO(make_vector(0, Qnil));
3368         }
3369
3370         if (NILP(XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index]))
3371                 /* This means the vector has not yet wrapped */
3372         {
3373                 nkeys = recent_keys_ring_index;
3374                 start = 0;
3375         } else {
3376                 nkeys = recent_keys_ring_size;
3377                 start =
3378                     ((recent_keys_ring_index ==
3379                       nkeys) ? 0 : recent_keys_ring_index);
3380         }
3381
3382         if (nwanted < nkeys) {
3383                 start += nkeys - nwanted;
3384                 if (start >= recent_keys_ring_size)
3385                         start -= recent_keys_ring_size;
3386                 nkeys = nwanted;
3387         } else
3388                 nwanted = nkeys;
3389
3390         val = make_vector(nwanted, Qnil);
3391
3392         for (i = 0, j = start; i < nkeys; i++) {
3393                 Lisp_Object e = XVECTOR_DATA(Vrecent_keys_ring)[j];
3394
3395                 if (NILP(e))
3396                         abort();
3397                 XVECTOR_DATA(val)[i] = Fcopy_event(e, Qnil);
3398                 if (++j >= recent_keys_ring_size)
3399                         j = 0;
3400         }
3401         UNGCPRO;
3402         return val;
3403 }
3404
3405 DEFUN("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /*
3406 The maximum number of events `recent-keys' can return.
3407 */
3408       ())
3409 {
3410         return make_int(recent_keys_ring_size);
3411 }
3412
3413 DEFUN("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /*
3414 Set the maximum number of events to be stored internally.
3415 */
3416       (size))
3417 {
3418         Lisp_Object new_vector = Qnil;
3419         int i, j, nkeys, start, min;
3420         struct gcpro gcpro1;
3421
3422         CHECK_INT(size);
3423         if (XINT(size) <= 0)
3424                 error("Recent keys ring size must be positive");
3425         if (XINT(size) == recent_keys_ring_size)
3426                 return size;
3427
3428         GCPRO1(new_vector);
3429         new_vector = make_vector(XINT(size), Qnil);
3430
3431         if (NILP(Vrecent_keys_ring)) {
3432                 Vrecent_keys_ring = new_vector;
3433                 RETURN_UNGCPRO(size);
3434         }
3435
3436         if (NILP(XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index]))
3437                 /* This means the vector has not yet wrapped */
3438         {
3439                 nkeys = recent_keys_ring_index;
3440                 start = 0;
3441         } else {
3442                 nkeys = recent_keys_ring_size;
3443                 start =
3444                     ((recent_keys_ring_index ==
3445                       nkeys) ? 0 : recent_keys_ring_index);
3446         }
3447
3448         if (XINT(size) > nkeys)
3449                 min = nkeys;
3450         else
3451                 min = XINT(size);
3452
3453         for (i = 0, j = start; i < min; i++) {
3454                 XVECTOR_DATA(new_vector)[i] =
3455                     XVECTOR_DATA(Vrecent_keys_ring)[j];
3456                 if (++j >= recent_keys_ring_size)
3457                         j = 0;
3458         }
3459         recent_keys_ring_size = XINT(size);
3460         recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0;
3461
3462         Vrecent_keys_ring = new_vector;
3463
3464         UNGCPRO;
3465         return size;
3466 }
3467
3468 /* Vthis_command_keys having value Qnil means that the next time
3469    push_this_command_keys is called, it should start over.
3470    The times at which the command-keys are reset
3471    (instead of merely being augmented) are pretty counterintuitive.
3472    (More specifically:
3473
3474    -- We do not reset this-command-keys when we finish reading a
3475       command.  This is because some commands (e.g. C-u) act
3476       like command prefixes; they signal this by setting prefix-arg
3477       to non-nil.
3478    -- Therefore, we reset this-command-keys when we finish
3479       executing a command, unless prefix-arg is set.
3480    -- However, if we ever do a non-local exit out of a command
3481       loop (e.g. an error in a command), we need to reset
3482       this-command-keys.  We do this by calling reset_this_command_keys()
3483       from cmdloop.c, whenever an error causes an invocation of the
3484       default error handler, and whenever there's a throw to top-level.)
3485  */
3486
3487 void reset_this_command_keys(Lisp_Object console, int clear_echo_area_p)
3488 {
3489         if (!NILP(console)) {
3490                 /* console is nil if we just deleted the console as a result of C-x 5
3491                    0.  Unfortunately things are currently in a messy situation where
3492                    some stuff is console-local and other stuff isn't, so we need to
3493                    do everything that's not console-local. */
3494                 struct command_builder *command_builder =
3495                     XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
3496
3497                 reset_key_echo(command_builder, clear_echo_area_p);
3498                 reset_current_events(command_builder);
3499         } else
3500                 reset_key_echo(0, clear_echo_area_p);
3501
3502         deallocate_event_chain(Vthis_command_keys);
3503         Vthis_command_keys = Qnil;
3504         Vthis_command_keys_tail = Qnil;
3505 }
3506
3507 static void push_this_command_keys(Lisp_Object event)
3508 {
3509         Lisp_Object new = Fmake_event(Qnil, Qnil);
3510
3511         Fcopy_event(event, new);
3512         enqueue_event(new, &Vthis_command_keys, &Vthis_command_keys_tail);
3513 }
3514
3515 /* The following two functions are used in call-interactively,
3516    for the @ and e specifications.  We used to just use
3517    `current-mouse-event' (i.e. the last mouse event in this-command-keys),
3518    but FSF does it more generally so we follow their lead. */
3519
3520 Lisp_Object extract_this_command_keys_nth_mouse_event(int n)
3521 {
3522         Lisp_Object event;
3523
3524         EVENT_CHAIN_LOOP(event, Vthis_command_keys) {
3525                 if (EVENTP(event)
3526                     && (XEVENT_TYPE(event) == button_press_event
3527                         || XEVENT_TYPE(event) == button_release_event
3528                         || XEVENT_TYPE(event) == misc_user_event)) {
3529                         if (!n) {
3530                                 /* must copy to avoid an abort() in next_event_internal() */
3531                                 if (!NILP(XEVENT_NEXT(event)))
3532                                         return Fcopy_event(event, Qnil);
3533                                 else
3534                                         return event;
3535                         }
3536                         n--;
3537                 }
3538         }
3539
3540         return Qnil;
3541 }
3542
3543 Lisp_Object extract_vector_nth_mouse_event(Lisp_Object vector, int n)
3544 {
3545         int i;
3546         int len = XVECTOR_LENGTH(vector);
3547
3548         for (i = 0; i < len; i++) {
3549                 Lisp_Object event = XVECTOR_DATA(vector)[i];
3550                 if (EVENTP(event)) {
3551                         switch (XEVENT_TYPE(event)) {
3552                         case button_press_event:
3553                         case button_release_event:
3554                         case misc_user_event:
3555                                 if (n == 0)
3556                                         return event;
3557                                 n--;
3558                                 break;
3559
3560                                 /* the rest of 'em cases */
3561                         case empty_event:
3562                         case key_press_event:
3563                         case pointer_motion_event:
3564                         case process_event:
3565                         case timeout_event:
3566                         case magic_event:
3567                         case magic_eval_event:
3568                         case eval_event:
3569 #ifdef EF_USE_ASYNEQ
3570                         case eaten_myself_event:
3571                         case work_started_event:
3572                         case work_finished_event:
3573 #endif  /* EF_USE_ASYNEQ */
3574                         case dead_event:
3575                         default:
3576                                 continue;
3577                         }
3578                 }
3579         }
3580
3581         return Qnil;
3582 }
3583
3584 static void push_recent_keys(Lisp_Object event)
3585 {
3586         Lisp_Object e;
3587
3588         if (NILP(Vrecent_keys_ring))
3589                 Vrecent_keys_ring = make_vector(recent_keys_ring_size, Qnil);
3590
3591         e = XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index];
3592
3593         if (NILP(e)) {
3594                 e = Fmake_event(Qnil, Qnil);
3595                 XVECTOR_DATA(Vrecent_keys_ring)[recent_keys_ring_index] = e;
3596         }
3597         Fcopy_event(event, e);
3598         if (++recent_keys_ring_index == recent_keys_ring_size)
3599                 recent_keys_ring_index = 0;
3600 }
3601
3602 static Lisp_Object
3603 current_events_into_vector(struct command_builder *command_builder)
3604 {
3605         Lisp_Object vector;
3606         Lisp_Object event;
3607         int n = event_chain_count(command_builder->current_events);
3608
3609         /* Copy the vector and the events in it. */
3610         /*  No need to copy the events, since they're already copies, and
3611            nobody other than the command-builder has pointers to them */
3612         vector = make_vector(n, Qnil);
3613         n = 0;
3614         EVENT_CHAIN_LOOP(event, command_builder->current_events)
3615             XVECTOR_DATA(vector)[n++] = event;
3616         reset_command_builder_event_chain(command_builder);
3617         return vector;
3618 }
3619
3620 /*
3621    Given the current state of the command builder and a new command event
3622    that has just been dispatched:
3623
3624    -- add the event to the event chain forming the current command
3625       (doing meta-translation as necessary)
3626    -- return the binding of this event chain; this will be one of:
3627       -- nil (there is no binding)
3628       -- a keymap (part of a command has been specified)
3629       -- a command (anything that satisfies `commandp'; this includes
3630                     some symbols, lists, subrs, strings, vectors, and
3631                     compiled-function objects)
3632  */
3633 static Lisp_Object
3634 lookup_command_event(struct command_builder *command_builder,
3635                      Lisp_Object event, int allow_misc_user_events_p)
3636 {
3637         /* This function can GC */
3638         struct frame *f = selected_frame();
3639         /* Clear output from previous command execution */
3640         if (!EQ(Qcommand, echo_area_status(f))
3641             /* but don't let mouse-up clear what mouse-down just printed */
3642             && (XEVENT(event)->event_type != button_release_event))
3643                 clear_echo_area(f, Qnil, 0);
3644
3645         /* Add the given event to the command builder.
3646            Extra hack: this also updates the recent_keys_ring and Vthis_command_keys
3647            vectors to translate "ESC x" to "M-x" (for any "x" of course).
3648          */
3649         {
3650                 Lisp_Object recent = command_builder->most_current_event;
3651
3652                 if (EVENTP(recent)
3653                     && event_matches_key_specifier_p(XEVENT(recent),
3654                                                      Vmeta_prefix_char)) {
3655                         Lisp_Event *e;
3656                         /* When we see a sequence like "ESC x", pretend we really saw "M-x".
3657                            DoubleThink the recent-keys and this-command-keys as well. */
3658
3659                         /* Modify the previous most-recently-pushed event on the command
3660                            builder to be a copy of this one with the meta-bit set instead of
3661                            pushing a new event.
3662                          */
3663                         Fcopy_event(event, recent);
3664                         e = XEVENT(recent);
3665                         if (e->event_type == key_press_event)
3666                                 e->event.key.modifiers |= XEMACS_MOD_META;
3667                         else if (e->event_type == button_press_event
3668                                  || e->event_type == button_release_event)
3669                                 e->event.button.modifiers |= XEMACS_MOD_META;
3670                         else
3671                                 abort();
3672
3673                         {
3674                                 int tckn =
3675                                     event_chain_count(Vthis_command_keys);
3676                                 if (tckn >= 2)
3677                                         /* ??? very strange if it's < 2. */
3678                                         this_command_keys_replace_suffix
3679                                             (event_chain_nth
3680                                              (Vthis_command_keys, tckn - 2),
3681                                              Fcopy_event(recent, Qnil));
3682                         }
3683
3684                         regenerate_echo_keys_from_this_command_keys
3685                             (command_builder);
3686                 } else {
3687                         event = Fcopy_event(event, Fmake_event(Qnil, Qnil));
3688
3689                         command_builder_append_event(command_builder, event);
3690                 }
3691         }
3692
3693         {
3694                 Lisp_Object leaf = command_builder_find_leaf(command_builder,
3695                                                              allow_misc_user_events_p);
3696                 struct gcpro gcpro1;
3697                 GCPRO1(leaf);
3698
3699                 if (KEYMAPP(leaf)) {
3700 #if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
3701                         if (!x_kludge_lw_menu_active())
3702 #else
3703                         if (1)
3704 #endif
3705                         {
3706                                 Lisp_Object prompt = Fkeymap_prompt(leaf, Qt);
3707                                 if (STRINGP(prompt)) {
3708                                         /* Append keymap prompt to key echo buffer */
3709                                         int buf_index =
3710                                             command_builder->echo_buf_index;
3711                                         Bytecount len = XSTRING_LENGTH(prompt);
3712
3713                                         if (len + buf_index + 1 <=
3714                                             command_builder->echo_buf_length) {
3715                                                 Bufbyte *echo =
3716                                                     command_builder->echo_buf +
3717                                                     buf_index;
3718                                                 memcpy(echo,
3719                                                        XSTRING_DATA(prompt),
3720                                                        len);
3721                                                 echo[len] = 0;
3722                                         }
3723                                         maybe_echo_keys(command_builder, 1);
3724                                 } else
3725                                         maybe_echo_keys(command_builder, 0);
3726                         } else if (!NILP(Vquit_flag)) {
3727                                 Lisp_Object quit_event =
3728                                     Fmake_event(Qnil, Qnil);
3729                                 Lisp_Event *e = XEVENT(quit_event);
3730                                 /* if quit happened during menu acceleration,
3731                                    pretend we read it */
3732                                 Lisp_Object tmp = Fselected_console();
3733                                 struct console *con = XCONSOLE(tmp);
3734                                 int ch = CONSOLE_QUIT_CHAR(con);
3735
3736                                 character_to_event(ch, e, con, 1, 1);
3737                                 e->channel = make_console(con);
3738
3739                                 enqueue_command_event(quit_event);
3740                                 Vquit_flag = Qnil;
3741                         }
3742                 } else if (!NILP(leaf)) {
3743                         if (EQ(Qcommand, echo_area_status(f))
3744                             && command_builder->echo_buf_index > 0) {
3745                                 /* If we had been echoing keys, echo the last
3746                                    one (without the trailing dash) and redisplay
3747                                    before executing the command. */
3748                                 command_builder->echo_buf[command_builder->
3749                                                           echo_buf_index] = 0;
3750                                 maybe_echo_keys(command_builder, 1);
3751                                 Fsit_for(Qzero, Qt);
3752                         }
3753                 }
3754                 RETURN_UNGCPRO(leaf);
3755         }
3756 }
3757
3758 static int is_scrollbar_event(Lisp_Object event)
3759 {
3760 #ifdef HAVE_SCROLLBARS
3761         Lisp_Object fun;
3762
3763         if (!EVENTP(event))
3764                 return 0;
3765         if (XEVENT(event)->event_type != misc_user_event)
3766                 return 0;
3767         fun = XEVENT(event)->event.misc.function;
3768
3769         return (EQ(fun, Qscrollbar_line_up) ||
3770                 EQ(fun, Qscrollbar_line_down) ||
3771                 EQ(fun, Qscrollbar_page_up) ||
3772                 EQ(fun, Qscrollbar_page_down) ||
3773                 EQ(fun, Qscrollbar_to_top) ||
3774                 EQ(fun, Qscrollbar_to_bottom) ||
3775                 EQ(fun, Qscrollbar_vertical_drag) ||
3776                 EQ(fun, Qscrollbar_char_left) ||
3777                 EQ(fun, Qscrollbar_char_right) ||
3778                 EQ(fun, Qscrollbar_page_left) ||
3779                 EQ(fun, Qscrollbar_page_right) ||
3780                 EQ(fun, Qscrollbar_to_left) ||
3781                 EQ(fun, Qscrollbar_to_right) ||
3782                 EQ(fun, Qscrollbar_horizontal_drag));
3783 #else
3784         return 0;
3785 #endif                          /* HAVE_SCROLLBARS */
3786 }
3787
3788 static void
3789 execute_command_event(struct command_builder *cmd_builder, Lisp_Object event)
3790 {
3791         /* This function can GC */
3792         struct console *con = XCONSOLE(cmd_builder->console);
3793         struct gcpro gcpro1;
3794
3795         GCPRO1(event);          /* event may be freshly created */
3796
3797         /* #### This call to is_scrollbar_event() isn't quite right, but
3798            fixing properly it requires more work than can go into 21.4.
3799            (We really need to split out menu, scrollbar, dialog, and other
3800            types of events from misc-user, and put the remaining ones in a
3801            new `user-eval' type that behaves like an eval event but is a
3802            user event and thus has all of its semantics -- e.g. being
3803            delayed during `accept-process-output' and similar wait states.)
3804
3805            The real issue here is that "user events" and "command events"
3806            are not the same thing, but are very much confused in
3807            event-stream.c.  User events are, essentially, any event that
3808            should be delayed by accept-process-output, should terminate a
3809            sit-for, etc. -- basically, any event that needs to be processed
3810            synchronously with key and mouse events.  Command events are
3811            those that participate in command building; scrollbar events
3812            clearly don't belong because they should be transparent in a
3813            sequence like C-x @ h <scrollbar-drag> x, which used to cause a
3814            crash before checks similar to the is_scrollbar_event() call were
3815            added.  Do other events belong with scrollbar events?  I'm not
3816            sure; we need to categorize all misc-user events and see what
3817            their semantics are.
3818
3819            (You might ask, why do scrollbar events need to be user events?
3820            That's a good question.  The answer seems to be that they can
3821            change point, and having this happen asynchronously would be a
3822            very bad idea.  According to the "proper" functioning of
3823            scrollbars, this should not happen, but SXEmacs does not allow
3824            point to go outside of the window.)
3825
3826            Scrollbar events and similar non-command events should obviously
3827            not be recorded in this-command-keys, so we need to check for
3828            this in next-event.
3829
3830            #### We call reset_current_events() twice in this function --
3831            #### here, and later as a result of reset_this_command_keys().
3832            #### This is almost certainly wrong; need to figure out what's
3833            #### correct.
3834
3835            #### We need to figure out what's really correct w.r.t. scrollbar
3836            #### events.  With these new fixes in, it actually works to do
3837            #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up
3838            #### (starts over at 5).  We really need to be special-casing
3839            #### scrollbar events at a lower level, and not really passing
3840            #### them through the command builder at all.  (e.g. do scrollbar
3841            #### events belong in macros???  doubtful; probably only the
3842            #### point movement, if any, belongs, special-cased as a
3843            #### pseudo-issued M-x goto-char command).  #### Need more work
3844            #### here.  Do this when separating out scrollbar events.
3845          */
3846
3847         if (!is_scrollbar_event(event))
3848                 reset_current_events(cmd_builder);
3849
3850         switch (XEVENT(event)->event_type) {
3851         case key_press_event:
3852                 Vcurrent_mouse_event = Qnil;
3853                 break;
3854         case button_press_event:
3855         case button_release_event:
3856         case misc_user_event:
3857                 Vcurrent_mouse_event = Fcopy_event(event, Qnil);
3858                 break;
3859
3860                 /* just list the other cases here */
3861         case empty_event:
3862         case pointer_motion_event:
3863         case process_event:
3864         case timeout_event:
3865         case magic_event:
3866         case magic_eval_event:
3867         case eval_event:
3868 #ifdef EF_USE_ASYNEQ
3869         case eaten_myself_event:
3870         case work_started_event:
3871         case work_finished_event:
3872 #endif  /* EF_USE_ASYNEQ */
3873         case dead_event:
3874         default:
3875                 break;
3876         }
3877
3878         /* Store the last-command-event.  The semantics of this is that it
3879            is the last event most recently involved in command-lookup. */
3880         if (!EVENTP(Vlast_command_event))
3881                 Vlast_command_event = Fmake_event(Qnil, Qnil);
3882         if (XEVENT(Vlast_command_event)->event_type == dead_event) {
3883                 Vlast_command_event = Fmake_event(Qnil, Qnil);
3884                 error("Someone deallocated the last-command-event!");
3885         }
3886
3887         if (!EQ(event, Vlast_command_event))
3888                 Fcopy_event(event, Vlast_command_event);
3889
3890         /* Note that last-command-char will never have its high-bit set, in
3891            an effort to sidestep the ambiguity between M-x and oslash. */
3892         Vlast_command_char = Fevent_to_character(Vlast_command_event,
3893                                                  Qnil, Qnil, Qnil);
3894
3895         /* Actually call the command, with all sorts of hair to preserve or clear
3896            the echo-area and region as appropriate and call the pre- and post-
3897            command-hooks. */
3898         {
3899                 int old_kbd_macro = con->kbd_macro_end;
3900                 Lisp_Object tmp = Fselected_window(Qnil);
3901                 struct window *w = XWINDOW(tmp);
3902
3903                 /* We're executing a new command, so the old value is irrelevant. */
3904                 zmacs_region_stays = 0;
3905
3906                 /* If the previous command tried to force a specific window-start,
3907                    reset the flag in case this command moves point far away from
3908                    that position.  Also, reset the window's buffer's change
3909                    information so that we don't trigger an incremental update. */
3910                 if (w->force_start) {
3911                         w->force_start = 0;
3912                         buffer_reset_changes(XBUFFER(w->buffer));
3913                 }
3914
3915                 pre_command_hook();
3916
3917                 if (XEVENT(event)->event_type == misc_user_event) {
3918                         call1(XEVENT(event)->event.eval.function,
3919                               XEVENT(event)->event.eval.object);
3920                 } else {
3921                         Fcommand_execute(Vthis_command, Qnil, Qnil);
3922                 }
3923
3924                 post_command_hook();
3925
3926                 /* Console might have been deleted by command */
3927                 if (CONSOLE_LIVE_P(con) && !NILP(con->prefix_arg)) {
3928                         /* Commands that set the prefix arg don't update
3929                            last-command, don't reset the echoing state, and
3930                            don't go into keyboard macros unless followed by
3931                            another command.  Also don't quit here.  */
3932                         int speccount = specpdl_depth();
3933                         specbind(Qinhibit_quit, Qt);
3934                         maybe_echo_keys(cmd_builder, 0);
3935                         unbind_to(speccount, Qnil);
3936
3937                         /* If we're recording a keyboard macro, and the last
3938                            command executed set a prefix argument, then
3939                            decrement the pointer to the "last character really
3940                            in the macro" to be just before this command.  This
3941                            is so that the ^U in "^U ^X )" doesn't go onto the
3942                            end of macro. */
3943                         if (!NILP(con->defining_kbd_macro))
3944                                 con->kbd_macro_end = old_kbd_macro;
3945                 } else {
3946                         /* Start a new command next time */
3947                         Vlast_command = Vthis_command;
3948                         Vlast_command_properties = Vthis_command_properties;
3949                         Vthis_command_properties = Qnil;
3950
3951                         /* Emacs 18 doesn't unconditionally clear the echoed
3952                            keystrokes, so we don't either */
3953                         /* who cares about RMSmacs 18? */
3954                         if (!is_scrollbar_event(event))
3955                                 reset_this_command_keys(CONSOLE_LIVE_P(con) ?
3956                                                         make_console(con)
3957                                                         : Qnil, 0);
3958                 }
3959         }
3960         UNGCPRO;
3961 }
3962
3963 /* Run the pre command hook. */
3964
3965 static void pre_command_hook(void)
3966 {
3967         last_point_position = BUF_PT(current_buffer);
3968         XSETBUFFER(last_point_position_buffer, current_buffer);
3969         /* This function can GC */
3970         safe_run_hook_trapping_errors
3971             ("Error in `pre-command-hook' (setting hook to nil)",
3972              Qpre_command_hook, 1);
3973
3974         /* This is a kludge, but necessary; see simple.el */
3975         call0(Qhandle_pre_motion_command);
3976 }
3977
3978 /* Run the post command hook. */
3979
3980 static void post_command_hook(void)
3981 {
3982         /* This function can GC */
3983         /* Turn off region highlighting unless this command requested that
3984            it be left on, or we're in the minibuffer.  We don't turn it off
3985            when we're in the minibuffer so that things like M-x write-region
3986            still work!
3987
3988            This could be done via a function on the post-command-hook, but
3989            we don't want the user to accidentally remove it.
3990          */
3991
3992         Lisp_Object win = Fselected_window(Qnil);
3993
3994         /* If the last command deleted the frame, `win' might be nil.
3995            It seems safest to do nothing in this case. */
3996         /* Note: Someone added the following comment and put #if 0's around
3997            this code, not realizing that doing this invites a crash in the
3998            line after. */
3999         /* #### This doesn't really fix the problem,
4000            if delete-frame is called by some hook */
4001         if (NILP(win))
4002                 return;
4003
4004         /* This is a kludge, but necessary; see simple.el */
4005         call0(Qhandle_post_motion_command);
4006
4007         if (!zmacs_region_stays && (!MINI_WINDOW_P(XWINDOW(win))
4008                                     || EQ(zmacs_region_buffer(),
4009                                           WINDOW_BUFFER(XWINDOW(win)))))
4010                 zmacs_deactivate_region();
4011         else
4012                 zmacs_update_region();
4013
4014         safe_run_hook_trapping_errors
4015             ("Error in `post-command-hook' (setting hook to nil)",
4016              Qpost_command_hook, 1);
4017
4018         /* #### Kludge!!! This is necessary to make sure that things
4019            are properly positioned even if post-command-hook moves point.
4020            #### There should be a cleaner way of handling this. */
4021         call0(Qauto_show_make_point_visible);
4022 }
4023 \f
4024 DEFUN("dispatch-event", Fdispatch_event, 1, 1, 0,       /*
4025 Given an event object EVENT as returned by `next-event', execute it.
4026
4027 Key-press, button-press, and button-release events get accumulated
4028 until a complete key sequence (see `read-key-sequence') is reached,
4029 at which point the sequence is looked up in the current keymaps and
4030 acted upon.
4031
4032 Mouse motion events cause the low-level handling function stored in
4033 `mouse-motion-handler' to be called. (There are very few circumstances
4034 under which you should change this handler.  Use `mode-motion-hook'
4035 instead.)
4036
4037 Menu, timeout, and eval events cause the associated function or handler
4038 to be called.
4039
4040 Process events cause the subprocess's output to be read and acted upon
4041 appropriately (see `start-process').
4042
4043 Magic events are handled as necessary.
4044 */
4045       (event))
4046 {
4047         /* This function can GC */
4048         struct command_builder *command_builder;
4049         Lisp_Event *ev;
4050         Lisp_Object console;
4051         Lisp_Object channel;
4052
4053         CHECK_LIVE_EVENT(event);
4054         ev = XEVENT(event);
4055
4056         /* events on dead channels get silently eaten */
4057         channel = EVENT_CHANNEL(ev);
4058         if (object_dead_p(channel))
4059                 return Qnil;
4060
4061         /* Some events don't have channels (e.g. eval events). */
4062         console = CDFW_CONSOLE(channel);
4063         if (NILP(console))
4064                 console = Vselected_console;
4065         else if (!EQ(console, Vselected_console))
4066                 Fselect_console(console);
4067
4068         command_builder = XCOMMAND_BUILDER(XCONSOLE(console)->command_builder);
4069         switch (XEVENT(event)->event_type) {
4070         case button_press_event:
4071         case button_release_event:
4072         case key_press_event: {
4073                 Lisp_Object leaf =
4074                         lookup_command_event(command_builder, event, 1);
4075
4076                 if (KEYMAPP(leaf))
4077                         /* Incomplete key sequence */
4078                         break;
4079                 if (NILP(leaf)) {
4080                         /* At this point, we know that the sequence is
4081                            not bound to a command.  Normally, we beep
4082                            and print a message informing the user of
4083                            this.  But we do not beep or print a message
4084                            when:
4085
4086                            o  the last event in this sequence is a
4087                            mouse-up event; or
4088                            o  the last event in this sequence is a
4089                            mouse-down event and there is a binding
4090                            for the mouse-up version.
4091
4092                            That is, if the sequence ``C-x button1'' is
4093                            typed, and is not bound to a command, but the
4094                            sequence ``C-x button1up'' is bound to a
4095                            command, we do not complain about the ``C-x
4096                            button1'' sequence.  If neither ``C-x
4097                            button1'' nor ``C-x button1up'' is bound to a
4098                            command, then we complain about the ``C-x
4099                            button1'' sequence, but later will *not*
4100                            complain about the ``C-x button1up''
4101                            sequence, which would be redundant.
4102
4103                            This is pretty hairy, but I think it's the
4104                            most intuitive behavior.
4105                         */
4106                         Lisp_Object terminal =
4107                                 command_builder->most_current_event;
4108
4109                         if (XEVENT_TYPE(terminal) == button_press_event) {
4110                                 int no_bitching;
4111                                 /* Temporarily pretend the last event
4112                                    was an "up" instead of a "down", and
4113                                    look up its binding. */
4114                                 XEVENT_TYPE(terminal) =
4115                                         button_release_event;
4116                                 /* If the "up" version is bound, don't
4117                                    complain. */
4118                                 no_bitching
4119                                         =
4120                                         !NILP(command_builder_find_leaf
4121                                               (command_builder, 0));
4122                                 /* Undo the temporary changes we just made. */
4123                                 XEVENT_TYPE(terminal) =
4124                                         button_press_event;
4125                                 if (no_bitching) {
4126                                         /* Pretend this press was not
4127                                            seen (treat as a prefix) */
4128                                         if (EQ
4129                                             (command_builder->
4130                                              current_events,
4131                                              terminal)) {
4132                                                 reset_current_events
4133                                                         (command_builder);
4134                                         } else {
4135                                                 Lisp_Object eve;
4136
4137                                                 EVENT_CHAIN_LOOP(eve,
4138                                                                  command_builder->
4139                                                                  current_events)
4140                                                         if (EQ
4141                                                             (XEVENT_NEXT
4142                                                              (eve),
4143                                                              terminal))
4144                                                                 break;
4145
4146                                                 Fdeallocate_event
4147                                                         (command_builder->
4148                                                          most_current_event);
4149                                                 XSET_EVENT_NEXT(eve,
4150                                                                 Qnil);
4151                                                 command_builder->
4152                                                         most_current_event =
4153                                                         eve;
4154                                         }
4155                                         maybe_echo_keys(command_builder,
4156                                                         1);
4157                                         break;
4158                                 }
4159                         }
4160
4161                         /* Complain that the typed sequence is not
4162                            defined, if this is the kind of sequence that
4163                            warrants a complaint. */
4164                         XCONSOLE(console)->defining_kbd_macro = Qnil;
4165                         XCONSOLE(console)->prefix_arg = Qnil;
4166                         /* Don't complain about undefined button-release
4167                            events */
4168                         if (XEVENT_TYPE(terminal) !=
4169                             button_release_event) {
4170                                 Lisp_Object keys =
4171                                         current_events_into_vector
4172                                         (command_builder);
4173                                 struct gcpro gcpro1;
4174
4175                                 /* Run the pre-command-hook before
4176                                    barfing about an undefined key. */
4177                                 Vthis_command = Qnil;
4178                                 GCPRO1(keys);
4179                                 pre_command_hook();
4180                                 UNGCPRO;
4181                                 /* The post-command-hook doesn't run. */
4182                                 Fsignal(Qundefined_keystroke_sequence,
4183                                         list1(keys));
4184                         }
4185                         /* Reset the command builder for reading the
4186                            next sequence. */
4187                         reset_this_command_keys(console, 1);
4188                 } else {        /* key sequence is bound to a command */
4189
4190                         int magic_undo = 0;
4191                         int magic_undo_count = 20;
4192
4193                         Vthis_command = leaf;
4194
4195                         /* Don't push an undo boundary if the command
4196                            set the prefix arg, or if we are executing a
4197                            keyboard macro, or if in the minibuffer.  If
4198                            the command we are about to execute is
4199                            self-insert, it's tricky: up to 20
4200                            consecutive self-inserts may be done without
4201                            an undo boundary.  This counter is reset as
4202                            soon as a command other than
4203                            self-insert-command is executed.
4204
4205                            Programmers can also use the
4206                            `self-insert-defer-undo' property to install
4207                            that behavior on functions other than
4208                            `self-insert-command', or to change the magic
4209                            number 20 to something else.  #### DOCUMENT
4210                            THIS!  */
4211
4212                         if (SYMBOLP(leaf)) {
4213                                 Lisp_Object prop =
4214                                         Fget(leaf, Qself_insert_defer_undo,
4215                                              Qnil);
4216                                 if (NATNUMP(prop))
4217                                         magic_undo =
4218                                                 1, magic_undo_count =
4219                                                 XINT(prop);
4220                                 else if (!NILP(prop))
4221                                         magic_undo = 1;
4222                                 else if (EQ(leaf, Qself_insert_command))
4223                                         magic_undo = 1;
4224                         }
4225
4226                         if (!magic_undo)
4227                                 command_builder->self_insert_countdown =
4228                                         0;
4229                         if (NILP(XCONSOLE(console)->prefix_arg)
4230                             && NILP(Vexecuting_macro)
4231                             && command_builder->self_insert_countdown ==
4232                             0)
4233                                 Fundo_boundary();
4234
4235                         if (magic_undo) {
4236                                 if (--command_builder->
4237                                     self_insert_countdown < 0)
4238                                         command_builder->
4239                                                 self_insert_countdown =
4240                                                 magic_undo_count;
4241                         }
4242                         execute_command_event
4243                                 (command_builder,
4244                                  internal_equal(event,
4245                                                 command_builder->
4246                                                 most_current_event, 0)
4247                                  ? event
4248                                  /* Use the translated event that was most
4249                                     recently seen.  This way,
4250                                     last-command-event becomes f1 instead of
4251                                     the P from ESC O P.  But we must copy
4252                                     it, else we'll lose when the
4253                                     command-builder events are
4254                                     deallocated. */
4255                                  : Fcopy_event(command_builder->
4256                                                most_current_event, Qnil));
4257                 }
4258                 break;
4259         }
4260         case misc_user_event: {
4261                 /* Jamie said:
4262
4263                    We could just always use the menu item entry,
4264                    whatever it is, but this might break some Lisp code
4265                    that expects `this-command' to always contain a
4266                    symbol.  So only store it if this is a simple
4267                    `call-interactively' sort of menu item.
4268
4269                    But this is bogus.  `this-command' could be a string
4270                    or vector anyway (for keyboard macros).  There's even
4271                    one instance (in pending-del.el) of `this-command'
4272                    getting set to a cons (a lambda expression).  So in
4273                    the `eval' case I'll just convert it into a lambda
4274                    expression.
4275                 */
4276                 if (EQ
4277                     (XEVENT(event)->event.eval.function,
4278                      Qcall_interactively)
4279                     && SYMBOLP(XEVENT(event)->event.eval.object)) {
4280                         Vthis_command =
4281                                 XEVENT(event)->event.eval.object;
4282                 } else if (EQ(XEVENT(event)->event.eval.function, Qeval)) {
4283                         Vthis_command =
4284                                 Fcons(Qlambda,
4285                                       Fcons(Qnil,
4286                                             XEVENT(event)->event.eval.
4287                                             object));
4288                 } else if (SYMBOLP(XEVENT(event)->event.eval.function)) {
4289                         /* A scrollbar command or the like. */
4290                         Vthis_command =
4291                                 XEVENT(event)->event.eval.function;
4292                 } else {
4293                         /* Huh? */
4294                         Vthis_command = Qnil;
4295                 }
4296
4297                 /* clear the echo area */
4298                 reset_key_echo(command_builder, 1);
4299
4300                 command_builder->self_insert_countdown = 0;
4301                 if (NILP(XCONSOLE(console)->prefix_arg)
4302                     && NILP(Vexecuting_macro)
4303                     && !EQ(minibuf_window, Fselected_window(Qnil)))
4304                         Fundo_boundary();
4305                 execute_command_event(command_builder, event);
4306                 break;
4307         }
4308 #ifdef EF_USE_ASYNEQ
4309         case eaten_myself_event:
4310                 /* try to find the worker in the workers dllist and pop it */
4311                 /* raw :( */
4312                 /* since this affects garbage collection, we better lock that
4313                    mutex, too */
4314                 lock_allocator();
4315                 WITH_DLLIST_TRAVERSE(
4316                         workers,
4317                         if (ev->event.eaten_myself.worker == dllist_item) {
4318                                 dllist_pop_inner(workers, _el);
4319                                 break;
4320                         });
4321                 unlock_allocator();
4322                 fini_worker(ev->event.eaten_myself.worker);
4323                 EQUEUE_DEBUG_WORKER("Successfully eaten 0x%lx\n",
4324                                     (long unsigned int)
4325                                     ev->event.eaten_myself.worker);
4326                 break;
4327         case work_started_event: {
4328                 Lisp_Object ljob = ev->event.work_started.job;
4329                 worker_job_t job = XWORKER_JOB(ljob);
4330                 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4331                 if (hdl && work_started(hdl))
4332                         work_started(hdl)(job);
4333                 break;
4334         }
4335         case work_finished_event: {
4336                 Lisp_Object ljob = ev->event.work_finished.job;
4337                 worker_job_t job = XWORKER_JOB(ljob);
4338                 work_handler_t hdl = XWORKER_JOB_HANDLER(ljob);
4339                 if (hdl && work_finished(hdl))
4340                         work_finished(hdl)(job);
4341                 break;
4342         }
4343 #endif
4344
4345                 /* and the rest */
4346         case empty_event:
4347         case pointer_motion_event:
4348         case process_event:
4349         case timeout_event:
4350         case magic_event:
4351         case magic_eval_event:
4352         case eval_event:
4353         case dead_event:
4354         default:
4355                 execute_internal_event(event);
4356                 break;
4357         }
4358         return Qnil;
4359 }
4360
4361 DEFUN("read-key-sequence", Fread_key_sequence, 1, 3, 0, /*
4362 Read a sequence of keystrokes or mouse clicks.
4363 Returns a vector of the event objects read.  The vector and the event
4364 objects it contains are freshly created (and so will not be side-effected
4365 by subsequent calls to this function).
4366
4367 The sequence read is sufficient to specify a non-prefix command starting
4368 from the current local and global keymaps.  A C-g typed while in this
4369 function is treated like any other character, and `quit-flag' is not set.
4370
4371 First arg PROMPT is a prompt string.  If nil, do not prompt specially.
4372
4373 Second optional arg CONTINUE-ECHO non-nil means this key echoes as a
4374 continuation of the previous key.
4375
4376 Third optional arg DONT-DOWNCASE-LAST non-nil means do not convert the
4377 last event to lower case.  (Normally any upper case event is converted
4378 to lower case if the original event is undefined and the lower case
4379 equivalent is defined.) This argument is provided mostly for FSF
4380 compatibility; the equivalent effect can be achieved more generally by
4381 binding `retry-undefined-key-binding-unshifted' to nil around the call
4382 to `read-key-sequence'.
4383
4384 If the user selects a menu item while we are prompting for a key-sequence,
4385 the returned value will be a vector of a single menu-selection event.
4386 An error will be signalled if you pass this value to `lookup-key' or a
4387 related function.
4388
4389 `read-key-sequence' checks `function-key-map' for function key
4390 sequences, where they wouldn't conflict with ordinary bindings.
4391 See `function-key-map' for more details.
4392 */
4393       (prompt, continue_echo, dont_downcase_last))
4394 {
4395         /* This function can GC */
4396         struct console *con = XCONSOLE(Vselected_console);      /* #### correct?
4397                                                                    Probably not -- see
4398                                                                    comment in
4399                                                                    next-event */
4400         struct command_builder *command_builder;
4401         Lisp_Object result;
4402         Lisp_Object event = Fmake_event(Qnil, Qnil);
4403         int speccount = specpdl_depth();
4404         struct gcpro gcpro1;
4405         GCPRO1(event);
4406
4407         record_unwind_protect(Fset_buffer, Fcurrent_buffer());
4408         if (!NILP(prompt))
4409                 CHECK_STRING(prompt);
4410         /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */
4411         QUIT;
4412
4413         if (NILP(continue_echo))
4414                 reset_this_command_keys(make_console(con), 1);
4415
4416         specbind(Qinhibit_quit, Qt);
4417
4418         if (!NILP(dont_downcase_last))
4419                 specbind(Qretry_undefined_key_binding_unshifted, Qnil);
4420
4421         for (;;) {
4422                 Fnext_event(event, prompt);
4423                 /* restore the selected-console damage */
4424                 con = event_console_or_selected(event);
4425                 command_builder = XCOMMAND_BUILDER(con->command_builder);
4426                 if (!command_event_p(event))
4427                         execute_internal_event(event);
4428                 else {
4429                         if (XEVENT(event)->event_type == misc_user_event)
4430                                 reset_current_events(command_builder);
4431                         result =
4432                             lookup_command_event(command_builder, event, 1);
4433                         if (!KEYMAPP(result)) {
4434                                 result =
4435                                     current_events_into_vector(command_builder);
4436                                 reset_key_echo(command_builder, 0);
4437                                 break;
4438                         }
4439                         prompt = Qnil;
4440                 }
4441         }
4442
4443         Vquit_flag = Qnil;      /* In case we read a ^G; do not call
4444                                    check_quit() here */
4445         Fdeallocate_event(event);
4446         RETURN_UNGCPRO(unbind_to(speccount, result));
4447 }
4448
4449 DEFUN("this-command-keys", Fthis_command_keys, 0, 0, 0, /*
4450 Return a vector of the keyboard or mouse button events that were used
4451 to invoke this command.  This copies the vector and the events; it is safe
4452 to keep and modify them.
4453 */
4454       ())
4455 {
4456         Lisp_Object event;
4457         Lisp_Object result;
4458         int len;
4459
4460         if (NILP(Vthis_command_keys))
4461                 return make_vector(0, Qnil);
4462
4463         len = event_chain_count(Vthis_command_keys);
4464
4465         result = make_vector(len, Qnil);
4466         len = 0;
4467         EVENT_CHAIN_LOOP(event, Vthis_command_keys)
4468             XVECTOR_DATA(result)[len++] = Fcopy_event(event, Qnil);
4469         return result;
4470 }
4471
4472 DEFUN("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0,       /*
4473 Used for complicated reasons in `universal-argument-other-key'.
4474
4475 `universal-argument-other-key' rereads the event just typed.
4476 It then gets translated through `function-key-map'.
4477 The translated event gets included in the echo area and in
4478 the value of `this-command-keys' in addition to the raw original event.
4479 That is not right.
4480
4481 Calling this function directs the translated event to replace
4482 the original event, so that only one version of the event actually
4483 appears in the echo area and in the value of `this-command-keys'.
4484 */
4485       ())
4486 {
4487         /* #### I don't understand this at all, so currently it does nothing.
4488            If there is ever a problem, maybe someone should investigate. */
4489         return Qnil;
4490 }
4491 \f
4492 static void dribble_out_event(Lisp_Object event)
4493 {
4494         if (NILP(Vdribble_file))
4495                 return;
4496
4497         if (XEVENT(event)->event_type == key_press_event &&
4498             !XEVENT(event)->event.key.modifiers) {
4499                 Lisp_Object keysym = XEVENT(event)->event.key.keysym;
4500                 if (CHARP(XEVENT(event)->event.key.keysym)) {
4501                         Emchar ch = XCHAR(keysym);
4502                         Bufbyte str[MAX_EMCHAR_LEN];
4503                         Bytecount len = set_charptr_emchar(str, ch);
4504                         Lstream_write(XLSTREAM(Vdribble_file), str, len);
4505                 } else if (string_char_length(XSYMBOL(keysym)->name) == 1)
4506                         /* one-char key events are printed with just the key name */
4507                         Fprinc(keysym, Vdribble_file);
4508                 else if (EQ(keysym, Qreturn))
4509                         Lstream_putc(XLSTREAM(Vdribble_file), '\n');
4510                 else if (EQ(keysym, Qspace))
4511                         Lstream_putc(XLSTREAM(Vdribble_file), ' ');
4512                 else
4513                         Fprinc(event, Vdribble_file);
4514         } else
4515                 Fprinc(event, Vdribble_file);
4516         Lstream_flush(XLSTREAM(Vdribble_file));
4517 }
4518
4519 DEFUN("open-dribble-file", Fopen_dribble_file, 1, 1, "FOpen dribble file: ",    /*
4520 Start writing all keyboard characters to a dribble file called FILENAME.
4521 If FILENAME is nil, close any open dribble file.
4522 */
4523       (filename))
4524 {
4525         /* This function can GC */
4526         /* XEmacs change: always close existing dribble file. */
4527         /* FSFmacs uses FILE *'s here.  With lstreams, that's unnecessary. */
4528         if (!NILP(Vdribble_file)) {
4529                 Lstream_close(XLSTREAM(Vdribble_file));
4530                 Vdribble_file = Qnil;
4531         }
4532         if (!NILP(filename)) {
4533                 int fd;
4534
4535                 filename = Fexpand_file_name(filename, Qnil);
4536                 fd = open((char *)XSTRING_DATA(filename),
4537                           O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
4538                           CREAT_MODE);
4539                 if (fd < 0)
4540                         error("Unable to create dribble file");
4541                 Vdribble_file =
4542                     make_filedesc_output_stream(fd, 0, 0, LSTR_CLOSING);
4543 #ifdef MULE
4544                 Vdribble_file =
4545                     make_encoding_output_stream(XLSTREAM(Vdribble_file),
4546                                                 Fget_coding_system
4547                                                 (Qescape_quoted));
4548 #endif
4549         }
4550         return Qnil;
4551 }
4552 \f
4553 DEFUN("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0,     /*
4554 Return the current event timestamp of the window system associated with CONSOLE.
4555 CONSOLE defaults to the selected console if omitted.
4556 */
4557       (console))
4558 {
4559         struct console *c = decode_console(console);
4560         int tiempo = event_stream_current_event_timestamp(c);
4561
4562         /* This junk is so that timestamps don't get to be negative, but contain
4563            as many bits as this particular emacs will allow.
4564          */
4565         return make_int(EMACS_INT_MAX & tiempo);
4566 }
4567
4568 \f
4569 /* generalised asynchronous worker queue */
4570 #if defined(EF_USE_ASYNEQ)
4571 void
4572 asyneq_handle_event(event_queue_t eq)
4573 {
4574         if (!eq_queue_empty_p(eq)) {
4575                 Lisp_Object eqev = eq_dequeue(eq);
4576                 Fdispatch_event(eqev);
4577         }
4578 }
4579
4580 void
4581 asyneq_handle_non_command_event(event_queue_t eq)
4582 {
4583         Lisp_Object eqev = Qnil;
4584
4585         WITH_DLLIST_TRAVERSE(
4586                 eq_queue(eq),
4587                 if (!command_event_p((Lisp_Object)dllist_item)) {
4588                         eqev = (Lisp_Object)dllist_pop_inner(eq_queue(eq), _el);
4589                         break;
4590                 });
4591
4592         if (!NILP(eqev))
4593                 execute_internal_event(eqev);
4594 }
4595 #endif
4596 \f
4597 /************************************************************************/
4598 /*                            initialization                            */
4599 /************************************************************************/
4600
4601 void syms_of_event_stream(void)
4602 {
4603         INIT_LRECORD_IMPLEMENTATION(command_builder);
4604         INIT_LRECORD_IMPLEMENTATION(timeout);
4605
4606         defsymbol(&Qdisabled, "disabled");
4607         defsymbol(&Qcommand_event_p, "command-event-p");
4608
4609         DEFERROR_STANDARD(Qundefined_keystroke_sequence, Qinvalid_argument);
4610
4611         DEFSUBR(Frecent_keys);
4612         DEFSUBR(Frecent_keys_ring_size);
4613         DEFSUBR(Fset_recent_keys_ring_size);
4614         DEFSUBR(Finput_pending_p);
4615         DEFSUBR(Fenqueue_eval_event);
4616         DEFSUBR(Fnext_event);
4617         DEFSUBR(Fnext_command_event);
4618         DEFSUBR(Fdiscard_input);
4619         DEFSUBR(Fsit_for);
4620         DEFSUBR(Fsleep_for);
4621         DEFSUBR(Faccept_process_output);
4622         DEFSUBR(Fadd_timeout);
4623         DEFSUBR(Fdisable_timeout);
4624         DEFSUBR(Fadd_async_timeout);
4625         DEFSUBR(Fdisable_async_timeout);
4626         DEFSUBR(Fdispatch_event);
4627         DEFSUBR(Fdispatch_non_command_events);
4628         DEFSUBR(Fread_key_sequence);
4629         DEFSUBR(Fthis_command_keys);
4630         DEFSUBR(Freset_this_command_lengths);
4631         DEFSUBR(Fopen_dribble_file);
4632         DEFSUBR(Fcurrent_event_timestamp);
4633
4634         defsymbol(&Qpre_command_hook, "pre-command-hook");
4635         defsymbol(&Qpost_command_hook, "post-command-hook");
4636         defsymbol(&Qunread_command_events, "unread-command-events");
4637         defsymbol(&Qunread_command_event, "unread-command-event");
4638         defsymbol(&Qpre_idle_hook, "pre-idle-hook");
4639         defsymbol(&Qhandle_pre_motion_command, "handle-pre-motion-command");
4640         defsymbol(&Qhandle_post_motion_command, "handle-post-motion-command");
4641         defsymbol(&Qretry_undefined_key_binding_unshifted,
4642                   "retry-undefined-key-binding-unshifted");
4643         defsymbol(&Qauto_show_make_point_visible,
4644                   "auto-show-make-point-visible");
4645
4646         defsymbol(&Qself_insert_defer_undo, "self-insert-defer-undo");
4647         defsymbol(&Qcancel_mode_internal, "cancel-mode-internal");
4648 }
4649
4650 void reinit_vars_of_event_stream(void)
4651 {
4652         recent_keys_ring_index = 0;
4653         recent_keys_ring_size = 100;
4654         num_input_chars = 0;
4655 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
4656         Vtimeout_free_list = make_lcrecord_list(sizeof(Lisp_Timeout),
4657                                                 &lrecord_timeout);
4658         staticpro_nodump(&Vtimeout_free_list);
4659 #endif  /* !BDWGC */
4660         the_low_level_timeout_blocktype =
4661                 Blocktype_new(struct low_level_timeout_blocktype);
4662         something_happened = 0;
4663         recursive_sit_for = Qnil;
4664
4665 #if defined(EF_USE_ASYNEQ)
4666         /* the main event queue */
4667         asyneq = make_event_queue();
4668         XSETEVENT_QUEUE(Vasyneq, asyneq);
4669         staticpro_nodump(&Vasyneq);
4670 #endif  /* EF_USE_ASYNEQ */
4671 }
4672
4673 void vars_of_event_stream(void)
4674 {
4675         reinit_vars_of_event_stream();
4676         Vrecent_keys_ring = Qnil;
4677         staticpro(&Vrecent_keys_ring);
4678
4679         Vthis_command_keys = Qnil;
4680         staticpro(&Vthis_command_keys);
4681         Vthis_command_keys_tail = Qnil;
4682         dump_add_root_object(&Vthis_command_keys_tail);
4683
4684 #ifndef EF_USE_ASYNEQ
4685         command_event_queue = Qnil;
4686         staticpro(&command_event_queue);
4687         command_event_queue_tail = Qnil;
4688         dump_add_root_object(&command_event_queue_tail);
4689 #endif
4690
4691         Vlast_selected_frame = Qnil;
4692         staticpro(&Vlast_selected_frame);
4693
4694         pending_timeout_list = Qnil;
4695         staticpro(&pending_timeout_list);
4696
4697         pending_async_timeout_list = Qnil;
4698         staticpro(&pending_async_timeout_list);
4699
4700         last_point_position_buffer = Qnil;
4701         staticpro(&last_point_position_buffer);
4702
4703         DEFVAR_LISP("echo-keystrokes", &Vecho_keystrokes        /*
4704 *Nonzero means echo unfinished commands after this many seconds of pause.
4705                                                                  */ );
4706         Vecho_keystrokes = make_int(1);
4707
4708         DEFVAR_INT("auto-save-interval", &auto_save_interval    /*
4709 *Number of keyboard input characters between auto-saves.
4710 Zero means disable autosaving due to number of characters typed.
4711 See also the variable `auto-save-timeout'.
4712                                                                  */ );
4713         auto_save_interval = 300;
4714
4715         DEFVAR_LISP("pre-command-hook", &Vpre_command_hook      /*
4716 Function or functions to run before every command.
4717 This may examine the `this-command' variable to find out what command
4718 is about to be run, or may change it to cause a different command to run.
4719 Function on this hook must be careful to avoid signalling errors!
4720                                                                  */ );
4721         Vpre_command_hook = Qnil;
4722
4723         DEFVAR_LISP("post-command-hook", &Vpost_command_hook    /*
4724 Function or functions to run after every command.
4725 This may examine the `this-command' variable to find out what command
4726 was just executed.
4727                                                                  */ );
4728         Vpost_command_hook = Qnil;
4729
4730         DEFVAR_LISP("pre-idle-hook", &Vpre_idle_hook    /*
4731 Normal hook run when SXEmacs it about to be idle.
4732 This occurs whenever it is going to block, waiting for an event.
4733 This generally happens as a result of a call to `next-event',
4734 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
4735 or `x-get-selection'.
4736
4737 Errors running the hook are caught and ignored.
4738                                                          */ );
4739         Vpre_idle_hook = Qnil;
4740
4741         DEFVAR_BOOL("focus-follows-mouse", &focus_follows_mouse /*
4742 *Variable to control SXEmacs behavior with respect to focus changing.
4743 If this variable is set to t, then SXEmacs will not gratuitously change
4744 the keyboard focus.  SXEmacs cannot in general detect when this mode is
4745 used by the window manager, so it is up to the user to set it.
4746                                                                  */ );
4747         focus_follows_mouse = 0;
4748
4749         DEFVAR_LISP("last-command-event", &Vlast_command_event  /*
4750 Last keyboard or mouse button event that was part of a command.  This
4751 variable is off limits: you may not set its value or modify the event that
4752 is its value, as it is destructively modified by `read-key-sequence'.  If
4753 you want to keep a pointer to this value, you must use `copy-event'.
4754                                                                  */ );
4755         Vlast_command_event = Qnil;
4756
4757         DEFVAR_LISP("last-command-char", &Vlast_command_char    /*
4758 If the value of `last-command-event' is a keyboard event, then
4759 this is the nearest ASCII equivalent to it.  This is the value that
4760 `self-insert-command' will put in the buffer.  Remember that there is
4761 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4762 of keyboard events is much larger, so writing code that examines this
4763 variable to determine what key has been typed is bad practice, unless
4764 you are certain that it will be one of a small set of characters.
4765                                                                  */ );
4766         Vlast_command_char = Qnil;
4767
4768         DEFVAR_LISP("last-input-event", &Vlast_input_event      /*
4769 Last keyboard or mouse button event received.  This variable is off
4770 limits: you may not set its value or modify the event that is its value, as
4771 it is destructively modified by `next-event'.  If you want to keep a pointer
4772 to this value, you must use `copy-event'.
4773                                                                  */ );
4774         Vlast_input_event = Qnil;
4775
4776         DEFVAR_LISP("current-mouse-event", &Vcurrent_mouse_event        /*
4777 The mouse-button event which invoked this command, or nil.
4778 This is usually what `(interactive "e")' returns.
4779                                                                          */ );
4780         Vcurrent_mouse_event = Qnil;
4781
4782         DEFVAR_LISP("last-input-char", &Vlast_input_char        /*
4783 If the value of `last-input-event' is a keyboard event, then
4784 this is the nearest ASCII equivalent to it.  Remember that there is
4785 NOT a 1:1 mapping between keyboard events and ASCII characters: the set
4786 of keyboard events is much larger, so writing code that examines this
4787 variable to determine what key has been typed is bad practice, unless
4788 you are certain that it will be one of a small set of characters.
4789                                                                  */ );
4790         Vlast_input_char = Qnil;
4791
4792         DEFVAR_LISP("last-input-time", &Vlast_input_time        /*
4793 The time (in seconds since Jan 1, 1970) of the last-command-event,
4794 represented as a cons of two 16-bit integers.  This is destructively
4795 modified, so copy it if you want to keep it.
4796                                                                  */ );
4797         Vlast_input_time = Qnil;
4798
4799         DEFVAR_LISP("last-command-event-time", &Vlast_command_event_time        /*
4800 The time (in seconds since Jan 1, 1970) of the last-command-event,
4801 represented as a list of three integers.  The first integer contains
4802 the most significant 16 bits of the number of seconds, and the second
4803 integer contains the least significant 16 bits.  The third integer
4804 contains the remainder number of microseconds, if the current system
4805 supports microsecond clock resolution.  This list is destructively
4806 modified, so copy it if you want to keep it.
4807                                                                                  */ );
4808         Vlast_command_event_time = Qnil;
4809
4810         DEFVAR_LISP("unread-command-events", &Vunread_command_events    /*
4811 List of event objects to be read as next command input events.
4812 This can be used to simulate the receipt of events from the user.
4813 Normally this is nil.
4814 Events are removed from the front of this list.
4815                                                                          */ );
4816         Vunread_command_events = Qnil;
4817
4818         DEFVAR_LISP("unread-command-event", &Vunread_command_event      /*
4819 Obsolete.  Use `unread-command-events' instead.
4820                                                                          */ );
4821         Vunread_command_event = Qnil;
4822
4823         DEFVAR_LISP("last-command", &Vlast_command      /*
4824 The last command executed.  Normally a symbol with a function definition,
4825 but can be whatever was found in the keymap, or whatever the variable
4826 `this-command' was set to by that command.
4827                                                          */ );
4828         Vlast_command = Qnil;
4829
4830         DEFVAR_LISP("this-command", &Vthis_command      /*
4831 The command now being executed.
4832 The command can set this variable; whatever is put here
4833 will be in `last-command' during the following command.
4834                                                          */ );
4835         Vthis_command = Qnil;
4836
4837         DEFVAR_LISP("last-command-properties", &Vlast_command_properties        /*
4838 Value of `this-command-properties' for the last command.
4839 Used by commands to help synchronize consecutive commands, in preference
4840 to looking at `last-command' directly.
4841                                                                                  */ );
4842         Vlast_command_properties = Qnil;
4843
4844         DEFVAR_LISP("this-command-properties", &Vthis_command_properties        /*
4845 Properties set by the current command.
4846 At the beginning of each command, the current value of this variable is
4847 copied to `last-command-properties', and then it is set to nil.  Use `putf'
4848 to add properties to this variable.  Commands should use this to communicate
4849 with pre/post-command hooks, subsequent commands, wrapping commands, etc.
4850 in preference to looking at and/or setting `this-command'.
4851                                                                                  */ );
4852         Vthis_command_properties = Qnil;
4853
4854         DEFVAR_LISP("help-char", &Vhelp_char    /*
4855 Character to recognize as meaning Help.
4856 When it is read, do `(eval help-form)', and display result if it's a string.
4857 If the value of `help-form' is nil, this char can be read normally.
4858 This can be any form recognized as a single key specifier.
4859 The help-char cannot be a negative number in SXEmacs.
4860                                                  */ );
4861         Vhelp_char = make_char(8);      /* C-h */
4862
4863         DEFVAR_LISP("help-form", &Vhelp_form    /*
4864 Form to execute when character help-char is read.
4865 If the form returns a string, that string is displayed.
4866 If `help-form' is nil, the help char is not recognized.
4867                                                  */ );
4868         Vhelp_form = Qnil;
4869
4870         DEFVAR_LISP("prefix-help-command", &Vprefix_help_command        /*
4871 Command to run when `help-char' character follows a prefix key.
4872 This command is used only when there is no actual binding
4873 for that character after that prefix key.
4874                                                                          */ );
4875         Vprefix_help_command = Qnil;
4876
4877         DEFVAR_CONST_LISP("keyboard-translate-table", &Vkeyboard_translate_table        /*
4878 sh table used as translate table for keyboard input.
4879 e `keyboard-translate' to portably add entries to this table.
4880 ch key-press event is looked up in this table as follows:
4881
4882 -- If an entry maps a symbol to a symbol, then a key-press event whose
4883    keysym is the former symbol (with any modifiers at all) gets its
4884    keysym changed and its modifiers left alone.  This is useful for
4885    dealing with non-standard X keyboards, such as the grievous damage
4886    that Sun has inflicted upon the world.
4887
4888 -- If an entry maps a symbol to a character, then a key-press event
4889    whose keysym is the former symbol (with any modifiers at all) gets
4890    changed into a key-press event matching the latter character, and the
4891    resulting modifiers are the union of the original and new modifiers.
4892
4893 -- If an entry maps a character to a character, then a key-press event
4894    matching the former character gets converted to a key-press event
4895    matching the latter character.  This is useful on ASCII terminals
4896    for (e.g.) making C-\\ look like C-s, to get around flow-control
4897    problems.
4898
4899 -- If an entry maps a character to a symbol, then a key-press event
4900    matching the character gets converted to a key-press event whose
4901    keysym is the given symbol and which has no modifiers.
4902
4903 re's an example: This makes typing parens and braces easier by rerouting
4904 eir positions to eliminate the need to use the Shift key.
4905
4906 (keyboard-translate ?[ ?()
4907 (keyboard-translate ?] ?))
4908 (keyboard-translate ?{ ?[)
4909 (keyboard-translate ?} ?])
4910 (keyboard-translate 'f11 ?{)
4911 (keyboard-translate 'f12 ?})
4912                                                                                          */ );
4913
4914         DEFVAR_LISP("retry-undefined-key-binding-unshifted", &Vretry_undefined_key_binding_unshifted    /*
4915 If a key-sequence which ends with a shifted keystroke is undefined
4916 and this variable is non-nil then the command lookup is retried again
4917 with the last key unshifted.  (e.g. C-X C-F would be retried as C-X C-f.)
4918 If lookup still fails, a normal error is signalled.  In general,
4919 you should *bind* this, not set it.
4920                                                                                                          */ );
4921         Vretry_undefined_key_binding_unshifted = Qt;
4922
4923         DEFVAR_BOOL("modifier-keys-are-sticky", &modifier_keys_are_sticky       /*
4924 *Non-nil makes modifier keys sticky.
4925 This means that you can release the modifier key before pressing down
4926 the key that you wish to be modified.  Although this is non-standard
4927 behavior, it is recommended because it reduces the strain on your hand,
4928 thus reducing the incidence of the dreaded Emacs-pinky syndrome.
4929
4930 Modifier keys are sticky within the inverval specified by
4931 `modifier-keys-sticky-time'.
4932                     */ );
4933         modifier_keys_are_sticky = 0;
4934
4935         DEFVAR_LISP("modifier-keys-sticky-time", 
4936                     &Vmodifier_keys_sticky_time /*
4937 *Modifier keys are sticky within this many milliseconds.
4938 If you don't want modifier keys sticking to be bounded, set this to
4939 non-integer value.
4940
4941 This variable has no effect when `modifier-keys-are-sticky' is nil.
4942 Currently only implemented under X Window System.
4943                                                 */ );
4944         Vmodifier_keys_sticky_time = make_int(500);
4945
4946 #ifdef HAVE_XIM
4947         DEFVAR_LISP("composed-character-default-binding", 
4948                     &Vcomposed_character_default_binding        /*
4949 The default keybinding to use for key events from composed input.
4950 Window systems frequently have ways to allow the user to compose
4951 single characters in a language using multiple keystrokes.
4952 SXEmacs sees these as single character keypress events.
4953                                                                 */ );
4954         Vcomposed_character_default_binding = Qself_insert_command;
4955 #endif                          /* HAVE_XIM */
4956
4957         Vcontrolling_terminal = Qnil;
4958         staticpro(&Vcontrolling_terminal);
4959
4960         Vdribble_file = Qnil;
4961         staticpro(&Vdribble_file);
4962
4963 #ifdef DEBUG_SXEMACS
4964         DEFVAR_INT("debug-emacs-events", &debug_emacs_events    /*
4965 o, display debug information about Emacs events that SXEmacs sees.
4966 n is displayed on stderr.
4967
4968  event, the source of the event is displayed in parentheses,
4969  of the following:
4970
4971 real event from the window system or
4972 rminal driver, as far as SXEmacs can tell.
4973
4974  macro) An event generated from a keyboard macro.
4975
4976 ommand-events) An event taken from `unread-command-events'.
4977
4978 ommand-event) An event taken from `unread-command-event'.
4979
4980 event queue) An event taken from an internal queue.
4981              Events end up on this queue when
4982              `enqueue-eval-event' is called or when
4983              user or eval events are received while
4984              SXEmacs is blocking (e.g. in `sit-for',
4985              `sleep-for', or `accept-process-output',
4986              or while waiting for the reply to an
4987              X selection).
4988
4989 rd-translate-table) The result of an event translated 
4990                     through keyboard-translate-table.  Note 
4991                     that in this case, two events are 
4992                     printed even though only one is really
4993                     generated.
4994
4995 A faked C-g resulting when SXEmacs receives
4996 a SIGINT (e.g. C-c was pressed in SXEmacs'
4997 controlling terminal or the signal was
4998 explicitly sent to the SXEmacs process).
4999                                                                 */ );
5000         debug_emacs_events = 0;
5001 #endif
5002
5003         DEFVAR_BOOL("inhibit-input-event-recording",
5004                     &inhibit_input_event_recording      /*
5005 Non-nil inhibits recording of input-events to recent-keys ring.
5006                                                         */ );
5007         inhibit_input_event_recording = 0;
5008 }
5009
5010 void complex_vars_of_event_stream(void)
5011 {
5012         Vkeyboard_translate_table =
5013             make_lisp_hash_table(100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
5014 }
5015
5016 void init_event_stream(void)
5017 {
5018         if (initialized) {
5019 #ifdef HAVE_UNIXOID_EVENT_LOOP
5020                 init_event_unixoid();
5021 #endif
5022 #ifdef HAVE_X_WINDOWS
5023                 if (!strcmp(display_use, "x"))
5024                         init_event_Xt_late();
5025                 else
5026 #endif
5027 #ifdef HAVE_GTK
5028                 if (!strcmp(display_use, "gtk"))
5029                         init_event_gtk_late();
5030                 else
5031 #endif
5032                 {
5033                         /* For TTY's, use the Xt event loop if we can; it allows
5034                            us to later open an X connection. */
5035 #if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
5036                         init_event_Xt_late();
5037 #elif defined (HAVE_TTY)
5038                         init_event_tty_late();
5039 #endif
5040                 }
5041                 init_interrupts_late();
5042         }
5043 }
5044 \f
5045 /*
5046 useful testcases for v18/v19 compatibility:
5047
5048 (defun foo ()
5049  (interactive)
5050  (setq unread-command-event (character-to-event ?A (allocate-event)))
5051  (setq x (list (read-char)
5052 ;         (read-key-sequence "") ; try it with and without this
5053           last-command-char last-input-char
5054           (recent-keys) (this-command-keys))))
5055 (global-set-key "\^Q" 'foo)
5056
5057 without the read-key-sequence:
5058   ^Q            ==>  (?A ?\^Q ?A [... ^Q] [^Q])
5059   ^U^U^Q        ==>  (?A ?\^Q ?A [... ^U ^U ^Q] [^U ^U ^Q])
5060   ^U^U^U^G^Q    ==>  (?A ?\^Q ?A [... ^U ^U ^U ^G ^Q] [^Q])
5061
5062 with the read-key-sequence:
5063   ^Qb           ==>  (?A [b] ?\^Q ?b [... ^Q b] [b])
5064   ^U^U^Qb       ==>  (?A [b] ?\^Q ?b [... ^U ^U ^Q b] [b])
5065   ^U^U^U^G^Qb   ==>  (?A [b] ?\^Q ?b [... ^U ^U ^U ^G ^Q b] [b])
5066
5067 ;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag)
5068
5069 ;(setq x (list (read-char) quit-flag))^J^G
5070 ;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G
5071 ;for BOTH, x should get set to (7 t), but no result should be printed.
5072 ;; #### According to the doc of quit-flag, second test should return
5073 ;; (?\^G nil).  Accidentaly SXEmacs returns correct value.  However,
5074 ;; XEmacs 21.1.12 and 21.2.36 both fails on first test.
5075
5076 ;also do this: make two frames, one viewing "*scratch*", the other "foo".
5077 ;in *scratch*, type (sit-for 20)^J
5078 ;wait a couple of seconds, move cursor to foo, type "a"
5079 ;a should be inserted in foo.  Cursor highlighting should not change in
5080 ;the meantime.
5081
5082 ;do it with sleep-for.  move cursor into foo, then back into *scratch*
5083 ;before typing.
5084 ;repeat also with (accept-process-output nil 20)
5085
5086 ;make sure ^G aborts sit-for, sleep-for and accept-process-output:
5087
5088  (defun tst ()
5089   (list (condition-case c
5090             (sleep-for 20)
5091           (quit c))
5092         (read-char)))
5093
5094  (tst)^Ja^G    ==>  ((quit) ?a) with no signal
5095  (tst)^J^Ga    ==>  ((quit) ?a) with no signal
5096  (tst)^Jabc^G  ==>  ((quit) ?a) with no signal, and "bc" inserted in buffer
5097
5098 ; with sit-for only do the 2nd test.
5099 ; Do all 3 tests with (accept-process-output nil 20)
5100
5101 Do this:
5102   (setq enable-recursive-minibuffers t
5103       minibuffer-max-depth nil)
5104  ESC ESC ESC ESC        - there are now two minibuffers active
5105  C-g C-g C-g            - there should be active 0, not 1
5106 Similarly:
5107  C-x C-f ~ / ?          - wait for "Making completion list..." to display
5108  C-g                    - wait for "Quit" to display
5109  C-g                    - minibuffer should not be active
5110 however C-g before "Quit" is displayed should leave minibuffer active.
5111
5112 ;do it all in both v18 and v19 and make sure all results are the same.
5113 ;all of these cases matter a lot, but some in quite subtle ways.
5114 */
5115
5116 /*
5117 Additional test cases for accept-process-output, sleep-for, sit-for.
5118 Be sure you do all of the above checking for C-g and focus, too!
5119
5120 ; Make sure that timer handlers are run during, not after sit-for:
5121 (defun timer-check ()
5122   (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
5123   (sit-for 5)
5124   (message "after sit-for"))
5125
5126 ; The first message should appear after 2 seconds, and the final message
5127 ; 3 seconds after that.
5128 ; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
5129
5130 ; Make sure that process filters are run during, not after sit-for.
5131 (defun fubar ()
5132   (message "sit-for = %s" (sit-for 30)))
5133 (add-hook 'post-command-hook 'fubar)
5134
5135 ; Now type M-x shell RET
5136 ; wait for the shell prompt then send: ls RET
5137 ; the output of ls should fill immediately, and not wait 30 seconds.
5138
5139 ; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
5140
5141 ; Make sure that recursive invocations return immediately:
5142 (defmacro test-diff-time (start end)
5143   `(+ (* (- (car ,end) (car ,start)) 65536.0)
5144       (- (cadr ,end) (cadr ,start))
5145       (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
5146
5147 (defun testee (ignore)
5148   (sit-for 10))
5149
5150 (defun test-them ()
5151   (let ((start (current-time))
5152         end)
5153     (add-timeout 2 'testee nil)
5154     (sit-for 5)
5155     (add-timeout 2 'testee nil)
5156     (sleep-for 5)
5157     (add-timeout 2 'testee nil)
5158     (accept-process-output nil 5)
5159     (setq end (current-time))
5160     (test-diff-time start end)))
5161
5162 (test-them) should sit for 15 seconds.
5163 Repeat with testee set to sleep-for and accept-process-output.
5164 These should each delay 36 seconds.
5165
5166 */